荔园在线

荔园之美,在春之萌芽,在夏之绽放,在秋之收获,在冬之沉淀

[回到开始] [上一篇][下一篇]


发信人: georgehill (佐治·希尔【多情网虫无情网】), 信区: Program
标  题: 用Delphi开发windows95屏幕保护预览程序
发信站: BBS 荔园晨风站 (Sun Mar 12 02:14:45 2000), 转信

资料整理·中国程序员网站


用Delphi开发windows95屏幕保护预览程序(包 伟)


---- 大 家 都 知 道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), 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.FileList
Box1DblClick(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.
 --
        那你可不可以教我,
        有什么办法可以不去喜欢一个人呢?

                -- Bye 赤明莉香 --
 我是来自大富翁的小美!^_^

※ 来源:·BBS 荔园晨风站 bbs.szu.edu.cn·[FROM: 192.168.1.115]


[回到开始] [上一篇][下一篇]

荔园在线首页 友情链接:深圳大学 深大招生 荔园晨风BBS S-Term软件 网络书店