用Delphi编写桌面涂鸦程序

软件世界

韩宇斌

通过这个实例的学习，使得你在屏幕上随心所欲涂鸦的梦想变为现实，同时你还能领悟一些“摧残”桌面类游戏的原理。准备好，让我们开始吧！

一、编程思路

在屏幕上涂鸦就是把当前屏幕当作一块画布在其上任意涂抹，当程序退出时要恢复原状。一般有两种实现方法：一是获得当前屏幕的句柄然后用Canvas直接在屏幕上涂抹；二是制作一个覆盖整个屏幕的透明的窗体然后在窗体上涂鸦。我对二者比较后发现，前者虽然代码少实现方便但是程序结束后屏幕上留有“残迹”，而后者则相对安全些。所以，我们一般选择第二种方法。

二、透明窗体的实现

方法1：这种方法是把当前屏幕的“东东”作为一幅位图复制到自己的窗体上，给你一种透明的感觉，实际上只是屏幕的COPY版，然后你在窗体上涂抹。程序结束时，窗体关闭，形象点说就是“蒙在屏幕上的画布揭掉了”，自然是一切如初恢复原状。限于篇幅，这种实现方法我在这里就不详细罗列代码了。
方法2：该方法和方法1一样也是在当前屏幕上蒙了一块画布，不过略有不同的是这张画布是真正透明的而不是COPY版。具体的实现步骤如下：
新建一个工程后，把Form1的WindowState属性和BorderStyle属性分别设为wsMaximized和bsNone，然后添加如下代码：
procedure TForm1.FormCreate(Sender: TObject);
begin
Brush.Style:= bsClear;//把填充的值设为bsClear(不填充)
end;
到此窗体的透明就已经实现了，怎么样，简单吧！接下来就等着你大笔一挥了。

三、源代码

下面我将用方法2实现的程序源代码罗列出来，希望你能慢慢体会！画线时需要将鼠标左键按下并拖动。
unit paint;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
CurColor:TColor; //当前画笔的颜色
IntDrawWidth:integer;//当前刷子的宽度
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var
temp:integer;
begin
Brush.Style:= bsClear;
//屏蔽系统功能键
SystemParametersInfo(Spi_screensaverrunning,1,@temp,0);
//初始化线条
CurColor:=RGB(random(255),random(255),random(255);
Canvas.Pen.Color:=CurColor; //初始化画笔的颜色
IntDrawWidth:=random(30)+10; //防止线条太细所以+10
Canvas.Pen.Width:=IntDrawWidth; //初始化画笔的宽度
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
begin
if Button=mbLeft then
begin
Canvas.MoveTo(x,y);
Canvas.Ellipse(x-5,y-5,x+5,y+5); //在鼠标当前的位置画一个圆可以预览线条的模式
end;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
begin
//当鼠标左键按下并移动时画线
if ssLeft in Shift then Canvas.LineTo(x,y);
end;
//当鼠标按键抬起时设置下一次画线的线条
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
begin
CurColor:=RGB(random(255),random(255),random(255));
Canvas.Pen.Color:=CurColor;
IntDrawWidth:=random(30)+10;
Canvas.Pen.Width:=IntDrawWidth;
end;
//按下ESC键时程序的退出
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);
var
Temp:integer;
begin
if Key=vk_Escape then
begin
if MessageDlg('确实不想画了吗？', mtConfirmation,[mbYes, mbNo], 0) = mrYes then
begin
//恢复功能键
SystemParametersInfo(spi_screensaverrunning,0,@temp,0);
application.Terminate
end;
end;
end;
end
插图（图1）是程序的效果示例。