• 首页
  • 小学语文
  • 中学语文
  • 中学英语
  • 免费论文
  • 教学随笔
  • 学生作文
  • 综合考试
  • 试题教案
  • 育儿话题
  • 教学资源
  • 编程技术
  • 博客
  • 用Delphi开发屏幕保护预览程序

    日期:2004-11-10  地址:  作者:
    用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开发屏幕保护预览程序 文章的评论    [查看网友评论]

    验证码:
    匿名发表: