截取，涂鸦当前屏幕？(300分)

可否具休点？

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, HyTimer;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
HyTimer1: TTimer;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure HyTimer1Timer(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
Back: TBitmap;
Forth: TBitmap;
FCurPoint: TPoint;
FStep: Integer;
FIsRestore: Boolean;
procedure StepDraw;
public
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

{ TForm1 }

procedure CopyScreenToBmp(ABmp: TBitmap);
var
ACanvas: TCanvas;
DC: HDC;
begin
DC := GetDC(0);
try
ACanvas := TCanvas.Create;
try
ACanvas.Handle := DC;
//把整个屏幕复制到BITMAP中
ABmp.Width := Screen.Width;
ABmp.Height := Screen.Height;
ABmp.Canvas.CopyRect(Rect(0, 0, Screen.Width, Screen.Height),
ACanvas,
Rect(0, 0, Screen.Width, Screen.Height));
finally
ACanvas.Free;
end;
finally
ReleaseDC(0, DC);
end;
end;

procedure RestoreScreen(ABmp: TBitmap);
var
ACanvas: TCanvas;
DC: HDC;
begin
if ABmp.Width = 0 then Exit;
DC := GetDC(0);
try
ACanvas := TCanvas.Create;
try
ACanvas.Handle := DC;
ACanvas.CopyRect(Rect(0, 0, Screen.Width, Screen.Height),
ABmp.Canvas,
Rect(0, 0, ABmp.Width, ABmp.Height));
finally
ACanvas.Free;
end;
finally
ReleaseDC(0, DC);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
CopyScreenToBmp(Back);
HyTimer1.Enabled := True;
FCurPoint.x := 0;
FCurPoint.y := 0;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
RestoreScreen(Back);
HyTimer1.Enabled := False;
FCurPoint.x := 0;
FCurPoint.y := 0;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
S: TFileStream;
begin
Back := TBitmap.Create;
Forth := TBitmap.Create;
S := TFileStream.Create('865781b.bmp', fmOpenRead);
try
Forth.LoadFromStream(S);
finally
S.Free;
end;
FStep := 40;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
Back.Free;
Forth.Free;
end;

procedure TForm1.HyTimer1Timer(Sender: TObject);
begin
StepDraw;
end;

procedure TForm1.StepDraw;
var
ACanvas: TCanvas;
DC: HDC;
ARect: TRect;
begin
DC := GetDC(0);
try
ACanvas := TCanvas.Create;
try
ACanvas.Handle := DC;
ARect := Rect(FCurPoint.x, FCurPoint.y,
FCurPoint.x + FStep, FCurPoint.y + FStep);
if FIsRestore then
ACanvas.CopyRect(ARect, Back.Canvas, ARect)
else
ACanvas.CopyRect(ARect, Forth.Canvas, ARect);
FCurPoint.x := FCurPoint.x + FStep;
if FCurPoint.x >= Screen.Width then
begin
FCurPoint.x := 0;
FCurPoint.y := FCurPoint.y + FStep;
if FCurPoint.y >= Screen.Height then
begin
FCurPoint.y := 0;
//还可重新调一幅图片;
end;
end;
finally
ACanvas.Free;
end;
finally
ReleaseDC(0, DC);
end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
FIsRestore := not FIsRestore;
FCurPoint.x := 0;
FCurPoint.y := 0;
end;

end.

thanks to thx1180:
这是“定时抓图”的源程序？
不太看得明白，这个可以一笔笔擦吗？
另外，我觉得，用多图层的方法可以更好的解快擦写问题。
但如何建呢？

这是为你作的测试程序，思路是先保存背景并调入一幅前景图，

然后根据FIsRestore的值决定是往屏幕上一块块画前景还是恢复背景。

FCurPoint保存当前位置，FStep为画块的宽和高，定时器的作用是每次

画一块。

试一试就知道效果啦。：）

电脑报上有这个源码的。
你可以在窗体上放一个image，将窗体透明，在image上涂鸦不成问题吧。

虽然没用多层，但thx1180的是可行的，我不拖了。分发给先来的任豆豆和答得最全
的thx1180。Thanks All。