Delphi screen capture

(1) create a project and set boardstyle of form1 to bsnone, formstyle to fsstayontop, and windowstate to wsmaximized.

(2) Place image1 in form1 and set its autosize to true.

(3) capture the full screen in the oncreate event of form1 and place the captured image in image1.

Procedure tform1.formcreate (Sender: tobject );
VaR
BMP: tbitmap;
Begin
BMP: = tbitmap. Create;
Getscreen (BMP );
Image1.picture: = tpicture (BMP );
End;
Getscreen (var bmp: tbitmap) is defined as follows:

Procedure getscreen (var bmp: tbitmap); // capture full screen
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) obtain the initial value of the region in the onmousedown event of image1, and save the initial vertex, end vertex, and Region with the global variables PT, endpt, and rect _ respectively.

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) As the mouse moves, the size of the selected area is changed.

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) When you release the mouse, save the selected area in the BMP image and copy it to the clipboard.

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) only when the ESC key is pressed can the program exit (g_canclose is a global variable ).

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;