怎样用Delphi写屏幕保护程序?最好给一源程序(例子)(100分)

  • 主题发起人 主题发起人 xie1979
  • 开始时间 开始时间
http://vclxx.org/ 上有示例程序,自己去找吧
 
这是葵花宝典上的文章:

屏幕保护程序无非是扩展名换成了.SCR的可执行程序,它接受两种命令行参数:
-s 运行命令参数
-c 配置命令参数
Windows通过向程序发-s命令行参数来启动程序。
要注意的是:程序的窗口是无边框和标题;窗口大小应与屏幕大小一样;还要注意
窗口的事件的处理。
 

用Delphi 开 发windows95 屏 幕 保 护 预 览 程 序
北 京 上 地 信 息 中 路3# 包 伟
---- 大 家 都 知 道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.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.
//////////////////////////////////////////////////
实际上Windows的屏幕保护程序也是一个可执行文件,只不过扩展名是 .SCR而不是.EXE。但是它也应满足一定的要求,以便提供给控制面板合适的接口。使得用户可以在显示器的“属性”中选择和配置它。通常它应满足以下要求:
1、包含有关于自己的设置;
2、提供关于自己的描述;
3、能够区分是激活状态还是配置状态;
4、不允许自己的拷贝同时运行;
5、当键盘或鼠标有动作时退出程序。
其中,“设置”与普通程序一样,只是要注意,只有在控制面板中配置它时“设置”窗口才会被激活。下面我们主要讨论剩下的四个问题。
一、首先,建立屏幕保护的主窗口。
在Delphi的菜单上或工具条上选择"New Form"建立一个"Blank Form"在Object Inspector中将它的属性配置为:
BorderIcon []
biSystemMenu False
biMinimize False
biMaximize False
BorderStyle bsNone
Color clBlack
FormStyle fsStayOnTop
name Sav_Form
Visible False
从System控件板中选择一个"Timer"控件,设置它的属性为:
Enabled Ture
Interval 2000
Name Timer1
Tag 0
在本例中保护屏幕上显示照片,所以要在窗口上再加一个Image将它的AuotoSize设为Ture,Visible设为False,双击装入你想显示的图片,
本例采用《计算机世界》1998年49期中介绍的方法,使BMP图片以垂直交错的方法显示,代码如下:(详情见《计算机世界》1998年49期“Delphi中的图形显示技巧”)
private
{ Private declarations }
procedure ShowPic()

.....
procedure TSav_Form.ShowPic(Sender: TObject)

var
newbmp:TBitmap

i,j,bmpheight,bmpwidth:integer

begin
newbmp:= TBitmap.Create

newbmp.Width:=image1.Width

newbmp.Height:=image1.Height

bmpheight:=image1.Height

bmpwidth:=image1.Width

i:=0

while i< =bmpheight do
begin
j:=i

while(j >0)do
begin
newbmp.Canvas.CopyRect(Rect(0,j-1,bmpwidth,j),image1.
Canvas,Rect(0,bmpheight-i+j-1,bmpwidth,bmpheight-i+j))

newbmp.Canvas.CopyRect(Rect(0,bmpheight-j,bmpwidth,
bmpheight-j+1),image1.Canvas,Rect(0,i-j,bmpwidth,i-j+1))

j:=j-2

end

Sav_Form.Canvas.Draw(20,10,newbmp)

i:=i+2

end

newbmp.free

end

当然,你也可以采用别的方法显示,或者将屏幕设计成做你想做的任何模样,只要在定时器的响应时间中调用你的函数就行了。本例,在定时器的OnTimer消息处理程序中调用ShowPic()

type
......
procedure Timer1Timer(Sender: TObject)


procedure TSav_Form.Timer1Timer(Sender: TObject)

begin
ShowPic

end

剩下的工做就是让设计好的Sav_Form能覆盖整个屏幕,并隐藏鼠标。点击Sav_Form在Object Inspector中选择Events标签,双击OnActive消息为它加上消息处理函数FormActivate(Sender: TObject);添加代码如下:
trype
procedure FormActivate(Sender: TObject)

procedure TSav_Form.FormActivate(Sender: TObject)

begin
WindowsState:=wsMaximized
//覆盖屏幕;
ShowCursor(false)
//隐藏光标;
end

二、监测键盘和鼠标
保护屏幕作好后,就要监测键盘和鼠标。方法是为Application.OnMessage事件建立一个句柄,检测中断屏幕保护的条件是否满足。在Sav_Form的Private中加入以下代码:
procedure Detect(var Msg:TMsg;var Handled:boolean)

在implementation中加入以下代码:
procedure TSav_Form.Detect(var Msg:TMsg

var Handled:boolean)

Var
Done:boolean

begin
Done:=false

if (Msg.message=WM_KEYDOWN or
Msg.message=WM_MOUSEMOVE) then
done:=true

if done then
begin
close

end

end

---- 在为窗口的OnShow事件加上处理函数。在函数中加上以下代码:
procedure TSav_Form.FormShow(Sender: TObject)

begin
Application.OnMessage:=Detect

// ShowCursor(false)

end

三、提供关于自己的描述
你可以用Delphi中的{$D text} 定义出现在“显示”“属性”中显示的你的屏幕保护程序的名称,$D参数直接将text插入可执行文件入口的描述模块(Description Module) 为了让控制面板认识你的描述,必须加入"SCRNSAVE"。选择项目文件在{$R *.RES}后加入以下代码:
{$D SCRNSAVE My Screen Saver}"My Screen Saver"将显示在控制面板中的“显示”“属性”中。
四、激活状态和设置状态,以及屏蔽多拷贝的运行
Windows在两种条件下运行屏幕保护程序,1、当屏幕保护的时间设置到时则激活;
2、当屏幕保护被设置时激活。为了区分这两种状态Windows在命令后加了参数,
"/s"表示是激活状态,"/c"表示是设置状态。因此,我们的屏幕保护程序也必须
区分参数以便做不同的处理。
屏幕保护程序和其他程序不同的是,它不允许自己的拷贝同时运行。
hPrevInst是一个Delphi定义的全局变量,它指向当前程序前一个拷贝,
如果该变量为0,则表示当前程序是唯一的实例。我们可以利用这个变量屏蔽多拷贝的运行。
以下的代码实现了区分激活状态和设置状态,以及屏蔽多拷贝的运行的功能。(该代码在项目文件中)
begin
if hPrevInst = 0 then
begin //如果当前实例是唯一实例
if (ParamCount > 0) and
(UpperCase(ParamStr(1)) = '/S') then
begin
//如果是激活状态
Application.Initialize

Application.CreateForm(TScrnFrm, ScrnFrm)

end else
begin
//可以在这里加入你的配置代码
end

Application.Run

end

end.
五、安装
---- 最后,将程序编译、链接后拷贝到Windows目录下,
将程序的扩展名改为.SCR即可在控制面板中选择"My Screen Saver"了。
以上代码均在Delphi4.0中编译通过
 
呵呵,来晚了
就是那个hubdog上面的东西啦
 
接受答案了.
 
后退
顶部