Delphi image intercept programming example (8)

(7) Create a new FORM3, saved as Capture3.PAS. Setting up the four properties of the properties Bordericons Set to BSNONE.Borderstyle Set to FSSTAYONTOP. A private variable: fdragging: boolean; two public variables: FRECT, FBMP: Tbitmap;

Unit Capture3;

Interface

Uses Windows, Messages, Sysutils, Variants, Classes, Graphics, Controls, Forms, Dialogs

type TForm3 = 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 FormActivate (Sender: TObject); procedure FormDestroy (Sender: TObject); procedure FormPaint (Sender: TObject) PRIVATE FDRAGGING: Boolean; PUBLIC FRECT: TRECT; FBMP: TBITMAP;

Var Form3: TFORM3;

IMPLEMentation

{$ R * .dfm}

// Create a new custom cursor Cursor_2, put in the Capture3.RES resource // file. It is a white rectangular border of 32 * 32 to indicate the scope of the graph .procedure TFORM3.FormCreate (Sender: TOBJECT); VAR ADC: hdc; const crbox = -19; begin screen.cursors [crBox]: = loadingcursor (hinstance, 'cursor_2'); cursor: = crbox; fbmp: = tbitmap.create; fbmp.width: = Screen.Width; FBMP Height: = screen.height; adc: = getdc (0); bitblt (fbmp.canvas.handle, 0,0, screen.width, screen.Height, ADC, 0, 0, srcopy); ReleaseDC (0, ADC) ); Setbounds (0, 0, screen.width, screen.height); end;

procedure TForm3.FormMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if mbLeft = Button then begin fDragging: = true; SetRect (fRect, X, Y, X 32, Y 32); Canvas.DrawFocusRect (FRECT); END;

procedure TForm3.FormMouseMove (Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if fDragging then begin Canvas.DrawFocusRect (fRect); fRect.Left: = X; fRect.Top: = Y; fRect.Right: = X 32; fRect.Bottom: = Y 32; Canvas.DrawFocusRect (fRect); end; end; procedure TForm3.FormMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin ModalResult: = mrok; end;

Procedure tForm3.MMACACTIVATE (Sender: Tobject); const crhand = -18; begin screen.cursors [crhand]: = loading, pchar ('cursor_1'); cursor: = cr Hand;

Procedure TFORM3.FORMDESTROY (Sender: TOBJECT); begin fbmp.free; screen.cursor: = crdefault;

Procedure TFORM3.FORMPAINT (Sender: TOBJECT); Begin Canvas.draw (0, 0, FBMP); END;

End.