用Delphi开发屏幕保护预览程序

2019-11-18 19:00:31

字体：大中小

来源：转载

供稿：网友

用Delphi开发屏幕保护预览程序
整理编辑：China asp

---- 大家都知道windows 屏幕保护程序的作用, 而且新的屏幕保护程序越来越漂亮. 如果在win95 的桌面右键菜单选属性, 就弹出显示器设置界面, 有一个标签是设置屏幕保护程序的.

---- 在该页的画面上, 有一个显示器图案, 如果你选择win95 所带的屏幕保护程序, 这个屏幕保护程序就会在这个小' 显示器' 上自动运行, 你可以直接看到运行效果. 这功能大大方便了屏幕保护程序的选择, 这就是win95 对屏幕保护程序的新增接口: 预览功能.

---- 目前大多数新推出的屏幕保护程序都支持这个接口.

---- 屏幕保护程序从它的诞生那时起, 在同一时刻只能运行一个, 不能多个同时运行, 然而预览接口的推出, 使同时预览多个屏幕保护程序成为可能, 本文将向读者介绍如何用Delphi 开发这样一个程序.

---- 1. 屏幕保护预览接口
---- 屏幕保护预览接口的使用很简单, 这是通过传给屏幕保护程序的命令行参数来实现的, 该命令行参数格式为:

---- screensaver.exe /p #####

---- 其中##### 为一个有效的窗口句柄的10 进制表示.

---- 这个窗口我们可以称之为预览窗口.

---- 实际上, 支持预览接口的屏幕保护程序将自己的窗口创建为预览窗口的子窗口来实现预览功能的.

---- 2. 画面布局
---- 我们这个程序的窗口分为 3 部分, 为倒' 品' 字形, 上左部分列出所有可用的屏幕保护程序, 上右部分列出所有预览的屏幕保护程序, 下面当然是预览窗口了.

---- 用Delphi 实现时, 首先在Form 里放2 个TPanel 组件, Panel1 对齐方式为顶部对齐,Panel2 为撑满用户区, 再在Panel1 中放1 个TFileListBox 组件和一个TListBox 组件,FileListBox1 左对齐, ListBox1 撑满用户区.

---- 这样, FileListBox1 为屏幕保护列表, ListBox1 为预览列表, Panel2 为预览窗口.

---- 3. 列出屏幕保护程序.
---- 将FileListBox1 的Mask 属性设为'*.scr', 这是屏幕保护程序的扩展名.

---- 在FormCreate 方法中将FileListBox1.directory 设为windows 系统目录GetSystemDirectory;

---- 4. 预览屏幕保护程序.
---- 在FileListBox1DblClick 方法中运行该屏幕保护程序, 并将Panel2 的窗口句柄传给它.
---- WinExec(pchar(FileListBox1.FileName + ' /p ' + inttostr(Panel2.handle)), SW_Show);

---- 运行程序, 怎么样? COOL!

---- 5. 增加一些新特性: 隐藏/ 显示/ 关闭.
---- 增加2 个函数: 用于更新ListBox1.
function EnumPRoc(
h : HWND ;// handle of child window
l : integer// application-defined value
): boolean;stdcall;
var
buf : array[0..255] of char;
begin
GetWindowText(h, buf, sizeof(buf)- 1);
if iswindowvisible(h) then
Form1.ListBox1.items.add(' ' +strpas(buf) + ' : ' + inttostr(h))
else
Form1.ListBox1.items.add('-' +strpas(buf) + ' : ' + inttostr(h));
Result := true;
end;

procedure TForm1.Fresh1;
begin
ListBox1.clear;
enumChildwindows(Panel2.handle,
TFNWndEnumProc(@enumproc), 0);
end;

---- 增加一个弹出菜单Popupmenu1, 3 个菜单项, 'Show, Hide, Close', 将ListBox1.popupmemu 指向Popupmenu1.
---- Hide 的处理函数是:
procedure TForm1.Hide1Click(Sender: TObject);
var
h : integer;
s : string;
begin
if ListBox1.itemindex = -1 then exit;
s := Listbox1.items[ListBox1.itemindex];
h := strtoint(copy(s, pos(':', s) + 1, length(s)));
ShowWindow(h, SW_HIDE);
Fresh1;
end;

Show 的处理函数是:
procedure TForm1.Show1Click(Sender: TObject);
var
h : integer;
s : string;
begin
if ListBox1.itemindex = -1 then exit;
s := Listbox1.items[ListBox1.itemindex];
h := strtoint(copy(s, pos(':', s) + 1, length(s)));
ShowWindow(h, SW_SHOW);
Fresh1;
end;

Close 的处理函数是:
procedure TForm1.Close1Click(Sender: TObject);
var
h : integer;
s : string;
begin
if ListBox1.itemindex = -1 then exit;
s := Listbox1.items[ListBox1.itemindex];
h := strtoint(copy(s, pos(':', s) + 1, length(s)));
PostMessage(h, WM_QUIT, 0, 0);
Fresh1;
end;

---- 本程序在Delphi 3.0 下调试通过, 应该能用Delphi 1.0 / 2.0 编译.

---- 完整程序如下:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, FileCtrl, ExtCtrls, Menus;

type
TForm1 = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
FileListBox1: TFileListBox;
ListBox1: TListBox;
PopupMenu1: TPopupMenu;
Hide1: TMenuItem;
Show1: TMenuItem;
Close1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FileListBox1DblClick(Sender: TObject);
procedure Hide1Click(Sender: TObject);
procedure Show1Click(Sender: TObject);
procedure Close1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure Fresh1;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}
function EnumProc(
h : HWND ;// handle of child window
l : integer// application-defined value
): boolean;stdcall;
var buf : array[0..255] of char;
begin
GetWindowText(h, buf, sizeof(buf)- 1);
if iswindowvisible(h) then
Form1.ListBox1.items.add(' ' +strpas(buf) + ' : ' + inttostr(h))
else
Form1.ListBox1.items.add('-' +strpas(buf) + ' : ' + inttostr(h));
Result := true;
end;

procedure TForm1.Fresh1;
begin
ListBox1.clear;
enumChildwindows(Panel2.handle, TFNWndEnumProc(@enumproc), 0);
end;

procedure TForm1.FormCreate(Sender: TObject);
var buf : array[0..256] of char;
begin
GetSystemDirectory(buf, sizeof(buf) - 1);
FileListBox1.directory := strpas(buf);
ListBox1.popupmenu := Popupmenu1;
end;

procedure TForm1.FileListBox1DblClick(Sender: TObject);
begin
WinExec(pchar(FileListBox1.FileName + ' /p ' + inttostr(Panel2.handle)), SW_Show);
Fresh1;
end;

procedure TForm1.Hide1Click(Sender: TObject);
var
h : integer;
s : string;
begin
if ListBox1.itemindex = -1 then exit;
s := Listbox1.items[ListBox1.itemindex];
h := strtoint(copy(s, pos(':', s) + 1, length(s)));
ShowWindow(h, SW_HIDE);
Fresh1;
end;

procedure TForm1.Show1Click(Sender: TObject);
var
h : integer;
s : string;
begin
if ListBox1.itemindex = -1 then exit;
s := Listbox1.items[ListBox1.itemindex];
h := strtoint(copy(s, pos(':', s) + 1, length(s)));
ShowWindow(h, SW_SHOW);
Fresh1;
end;

procedure TForm1.Close1Click(Sender: TObject);
var
h : integer;
s : string;
begin
if ListBox1.itemindex = -1 then exit;
s := Listbox1.items[ListBox1.itemindex];
h := strtoint(copy(s, pos(':', s) + 1, length(s)));
PostMessage(h, WM_QUIT, 0, 0);
Fresh1;
end;

end.

Copyright © 上海聚声计算机系统工程有限责任公司 1999-2000, All Rights Reserved

上一篇："Delphi之完全汉语"终结版

下一篇：通用Delphi数据库输入控件DBPanel的实现

学习交流

索泰发布一款GTX 1070 Mini迷你版本:小机

索泰发布一款GTX 1070 Mini迷你版本:小机箱大爱...

热门图片

猜你喜欢的新闻

猜你喜欢的关注