(VI) Area capture form
Create a new Form1, save as Capture1.pas. Set the four properties of the attribute BorderIcons to false.
BorderStyle is set to bsNone, Cursor is set to crCross, FormStyle is set to fsStayOnTop.
Add a private variable: fDragging:Boolean; two public variables: fRect:TRect,fBmp:TBitmap;
The function of Form1: Created when grabbing the area, disappears after grabbing the picture.
unit Capture1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TForm1 = class(TForm)
PRocedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(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);
Private
fDragging:Boolean;
public
fRect:TRect;
fBmp:TBitmap;
end;
var
Form1: TForm1;
Implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var aDC:HDC; // Handle of device description table
Begin
fBmp := TBitmap.Create ;
fBmp.Width := Screen.Width ;
fBmp.Height:= Screen.Height;
aDC := GetDC(0); //Get the handle of the device description table of a window, and the 0 parameter returns the handle of the device description table of the screen window
BitBlt(fBmp.Canvas.Handle,0,0,Screen.Width,Screen.Height,aDC,0,0,srcCopy);
ReleaseDC(0,aDC,);
SetBounds(0,0,Screen.Width,Screen.Height);
end;
procedure TForm1.FormDestroy(Sender: TObject);
Begin
fBmp.Free ;
end;
procedure TForm1.FormPaint(Sender: TObject);
Begin
Canvas.Draw(0,0,fBmp); //Draw the graph to Canvas
end;
//If you press the left mouse button, use SetRect to set the rectangle fRect so that it is just a point.
//Draw this rectangle with DrawFocusRect
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Begin
if Button=mbLeft then begin
fDragging:=true;
SetRect(fRect,x,y,x,y);
Canvas.DrawFocusRect(fRect);
end;
end;
//When the mouse is moving, determine whether it is in the drawing (press the left mouse button), and DrawFocusRect resets the rectangle
// Make the lower right corner the current mouse position, and draw a rectangle when calling DrawFocusRect
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
Begin
if fDragging then begin
Canvas.DrawFocusRect(fRect);
fRect.Right := X ;
fRect.Bottom:= Y ;
Canvas.DrawFocusRect(fRect);
end;
end;
//Judge whether it is in the drawing (press the left mouse button), when the mouse pops up,
//DrawFocusRect reset the rectangle. Close the form
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Begin
if fDragging then begin
Canvas.DrawFocusRect(fRect);
fDragging:=false;
end;
ModalResult:=mrOK; //Close the form
end;
end.