⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 jq17.htm

📁 对于学习很有帮助
💻 HTM
字号:
🔍 
<html>

<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>用Delphi开发windows95屏幕保护预览程序</title>
</head>

<body stylesrc="API扩展Delphi函数.htm" bgcolor="#EEEEFF">

<p align="center">　<font color="#0000c0"></p>

<h2 align="center">用Delphi 开 发windows95 屏 幕 保 护 预 览 程 序 </font></h2> 
 
<h3 align="center">北 京 上 地 信 息 中 路3# 包 伟 </h3> 
 
<p><font color="#ffffff">----</font> 大 家 都 知 道windows 屏 幕 保 护 程 序  
的 作 用, 而 且 新 的 屏 幕 保 护 程 序 越 来 越 漂<br> 
亮. 如 果 在win95 的 桌 面 右 键 菜 单 选 属 性, 就 弹 出 显 示 器 设  
置 界 面, 有 一 个 标 签 是<br> 
设 置 屏 幕 保 护 程 序 的. </p> 
 
<p><font color="#ffffff">----</font> 在 该 页 的 画 面 上, 有 一 个 显 示 器  
图 案, 如 果 你 选 择win95 所 带 的 屏 幕 保 护 程 序,<br> 
这 个 屏 幕 保 护 程 序 就 会 在 这 个 小' 显 示 器' 上 自 动 运 行,  
你 可 以 直 接 看 到 运 行<br> 
效 果. 这 功 能 大 大 方 便 了 屏 幕 保 护 程 序 的 选 择, 这 就 是win95  
对 屏 幕 保 护 程 序 的<br> 
新 增 接 口: 预 览 功 能. </p> 
 
<p><font color="#ffffff">----</font> 目 前 大 多 数 新 推 出 的 屏 幕 保 护  
程 序 都 支 持 这 个 接 口. </p> 
 
<p><font color="#ffffff">----</font> 屏 幕 保 护 程 序 从 它 的 诞 生 那 时  
起, 在 同 一 时 刻 只 能 运 行 一 个, 不 能 多 个 同<br> 
时 运 行, 然 而 预 览 接 口 的 推 出, 使 同 时 预 览 多 个 屏 幕 保  
护 程 序 成 为 可 能, 本 文<br> 
将 向 读 者 介 绍 如 何 用Delphi 开 发 这 样 一 个 程 序. </p> 
 
<p><font color="#ffffff">----</font> 1. 屏 幕 保 护 预 览 接 口 </p> 
 
<p><font color="#ffffff">----</font> 屏 幕 保 护 预 览 接 口 的 使 用 很 简  
单, 这 是 通 过 传 给 屏 幕 保 护 程 序 的 命 令 行<br> 
参 数 来 实 现 的, 该 命 令 行 参 数 格 式 为: </p> 
 
<p><font color="#ffffff">----</font> screensaver.exe /p ##### </p> 
 
<p><font color="#ffffff">----</font> 其 中##### 为 一 个 有 效 的 窗 口 句 柄  
的10 进 制 表 示. </p> 
 
<p><font color="#ffffff">----</font> 这 个 窗 口 我 们 可 以 称 之 为 预 览  
窗 口. </p> 
 
<p><font color="#ffffff">----</font> 实 际 上, 支 持 预 览 接 口 的 屏 幕 保  
护 程 序 将 自 己 的 窗 口 创 建 为 预 览 窗 口 的<br> 
子 窗 口 来 实 现 预 览 功 能 的. </p> 
 
<p><font color="#ffffff">----</font> 2. 画 面 布 局 </p> 
 
<p><font color="#ffffff">----</font> 我 们 这 个 程 序 的 窗 口 分 为 3 部 分,  
为 倒' 品' 字 形, 上 左 部 分 列 出 所 有 可 用 的 屏<br> 
幕 保 护 程 序, 上 右 部 分 列 出 所 有 预 览 的 屏 幕 保 护 程 序,  
下 面 当 然 是 预 览 窗 口<br> 
了. </p> 
 
<p><font color="#ffffff">----</font> 用Delphi 实 现 时, 首 先 在Form 里 放2 个TPanel  
组 件, Panel1 对 齐 方 式 为 顶 部 对 齐,Panel2 为<br> 
撑 满 用 户 区, 再 在Panel1 中 放1 个TFileListBox 组 件 和 一 个TListBox  
组 件,FileListBox1 左 对 齐,<br> 
ListBox1 撑 满 用 户 区. </p> 
 
<p><font color="#ffffff">----</font> 这 样, FileListBox1 为 屏 幕 保 护 列 表,  
ListBox1 为 预 览 列 表, Panel2 为 预 览 窗 口. </p> 
 
<p><font color="#ffffff">----</font> 3. 列 出 屏 幕 保 护 程 序. </p> 
 
<p><font color="#ffffff">----</font> 将FileListBox1 的Mask 属 性 设 为'*.scr', 这  
是 屏 幕 保 护 程 序 的 扩 展 名. </p> 
 
<p><font color="#ffffff">----</font> 在FormCreate 方 法 中 将FileListBox1.directory  
设 为windows 系 统 目 录GetSystemDirectory; </p> 
 
<p><font color="#ffffff">----</font> 4. 预 览 屏 幕 保 护 程 序. </p> 
 
<p><font color="#ffffff">----</font> 在FileListBox1DblClick 方 法 中 运 行 该 屏  
幕 保 护 程 序, 并 将Panel2 的 窗 口 句 柄 传 给 它. </p> 
 
<p><font color="#ffffff">----</font> WinExec(pchar(FileListBox1.FileName + ' /p ' +  
inttostr(Panel2.handle)), SW_Show); </p> 
 
<p><font color="#ffffff">----</font> 运 行 程 序, 怎 么 样? COOL! </p> 
 
<p><font color="#ffffff">----</font> 5. 增 加 一 些 新 特 性: 隐 藏/ 显 示/ 关  
闭. </p> 
 
<p><font color="#ffffff">----</font> 增 加2 个 函 数: 用 于 更 新ListBox1. </p> 
 
<pre>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;</pre> 
 
<p><font color="#ffffff">----</font> 增 加 一 个 弹 出 菜 单Popupmenu1, 3 个 菜  
单 项, 'Show, Hide, Close', 将ListBox1.popupmemu 指 向<br> 
Popupmenu1. </p> 
 
<p><font color="#ffffff">----</font> Hide 的 处 理 函 数 是: </p> 
 
<pre>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;</pre> 
 
<p><font color="#ffffff">----</font> 本 程 序 在Delphi 3.0 下 调 试 通 过, 应  
该 能 用Delphi 1.0 / 2.0 编 译. </p> 
 
<p><font color="#ffffff">----</font> 完 整 程 序 如 下: </p> 
 
<pre>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.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.</pre> 
</body> 
</html>

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -