(1)新建工程,设置主界面form1的BoardStyle为bsNone,FormStyle为fsStayOnTop,WindowState为wsMaximized。
(2)在form1中放置Image1,设置其AutoSize为True。
(3)在form1的OnCreate事件中截取全屏,并将截到的图片放置在image1中。
procedure TForm1.FormCreate(Sender: TObject);
var
bmp: TBitMap;
begin
bmp:= TBitMap.Create;
GetScreen(bmp);
image1.Picture:= TPicture(bmp);
end;
其中,截取全屏的过程GetScreen(var bmp: TBitMap)定义如下:
procedure GetScreen(var bmp: TBitMap); //截取全屏
var
DC: HDC;
MyCanvas: TCanvas;
MyRect: TRect;
begin
DC:= GetWindowDC(0);
MyCanvas:= TCanvas.Create;
try
MyCanvas.Handle:= DC;
MyRect:= Rect(0, 0, Screen.Width, Screen.Height);
bmp:= TBitMap.Create;
bmp.PixelFormat:= pf24bit;
bmp.Width:= MyRect.Right;
bmp.Height:= MyRect.Bottom;
bmp.Canvas.CopyRect(MyRect, MyCanvas, MyRect);
finally
MyCanvas.Handle:= 0;
MyCanvas.Free;
releaseDC(0, DC);
end;
end;
(4)在image1的OnMouseDown事件里获取区域的初始值,并分别用全局变量pt,Endpt,rect_保存初始点,终止点和区域。
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Dragging_:= true;
pt:= Point(X, Y);
Endpt:= pt;
rect_.left:= pt.x;
rect_.top:= pt.y;
rect_.right:= pt.x;
rect_.bottom:= pt.y;
Canvas.DrawFocusRect(rect_);
end;
(5)随着鼠标的移动,改变选定区域的大小。
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if (Dragging_) then
begin
Endpt:= Point(X, Y);
H:= abs(pt.y - Endpt.y);
W:= abs(pt.x - Endpt.x);
Canvas.DrawFocusRect(rect_);
if (pt.x < Endpt.x) and(pt.y < Endpt.y) then
begin
rect_.Left:= pt.x;
rect_.top:= pt.y;
end
else if (pt.x < Endpt.x) and(pt.y > Endpt.y) then
begin
rect_.Left:= pt.x;
rect_.top:= Endpt.y;
end
else if(pt.x > Endpt.x) and(pt.y > Endpt.y) then
begin
rect_.Left:= Endpt.x;
rect_.top:= Endpt.y;
end
else if(pt.x > Endpt.x) and(pt.y < Endpt.y) then
begin
rect_.Left:= Endpt.x;
rect_.top:= pt.y;
end;
rect_.right:= rect_.left + W;
rect_.bottom:= rect_.top + H;
Canvas.DrawFocusRect(rect_);
end;
end;
(6)松开鼠标时,将选中区域保存在bmp图片中,并将其复制到剪贴板。
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
bmp: TBitMap;
MyRect: TRect;
begin
if (Dragging_) then
begin
Dragging_:= false;
Endpt:= Point(X, Y);
Canvas.DrawFocusRect(rect_);
bmp:= TBitMap.Create;
bmp.Width:= Rect_.Right - Rect_.Left;
bmp.Height:= Rect_.Bottom - Rect_.Top;
MyRect:= Rect(0, 0, bmp.Width, bmp.Height);
bmp.Canvas.CopyRect(MyRect, Canvas, Rect_);
ClipBoard.Assign(bmp);
end;
end;
(7)控制只用当按下esc键时,才能退出程序(G_CanClose为全局变量)。
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if (Key = #27) then
begin
G_CanClose:= true;
Close;
end
else
Key:= #0;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose:= G_CanClose;
end;