用Delphi開發螢幕保護預覽程序

作者：Eve Cole 更新時間：2025-02-15 18:12:02

用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.