In this example:
Code File:
Unit unit1; interfaceuses windows, messages, extensions, variants, classes, graphics, controls, forms, dialogs, stdctrls; Type tform1 = Class (tform) checkbox1: tcheckbox; Procedure formcreate (Sender: tobject); Procedure formpaint (Sender: tobject); Procedure formmousedown (Sender: tobject; button: tmousebutton; shift: tshiftstate; X, Y: integer); Procedure formmousemove; shift: tshiftstate; X, Y: integer); Procedure formmouseup (Sender: tobject; button: tmousebutton; shift: tshiftstate; X, Y: integer); Procedure checkbox1click (Sender: tobject); end; var form1: tform1; implementation {$ R *. DFM} uses gdipobj, gdipapi; var RT: trect; flag: Boolean; X1, Y1: integer; Procedure tform1.formcreate (Sender: tobject); Begin self. color: = clwhite; RT: = clientrect; inflaterect (RT,-clientwidth Div 3,-clientheight Div 3); checkbox1.caption: = 'cut region'; checkbox1.checked: = true; doublebuffered: = true; end; Procedure tform1.formpaint (Sender: tobject); var G: tgpgraphics; B: tgpsolidbrush; RGN: tgpregion; STR: string; Font: tgpfont; rectf: tgprectf: integer; begin rectf: = makerect (0.0, 0, clientwidth + 10, clientheight); STR: = ''; for I: = 0 to 800 do STR: = STR + inttostr (random (2); G: = tgpgraphics. create (canvas. handle); B: = tgpsolidbrush. create (aclblue); RGN: = tgpregion. create (makerect (RT); If checkbox1.checked then G. setclip (RGN); {use area to cut the canvas} Font: = tgpfont. create (canvas. handle); G. drawstring (STR,-1, Font, rectf, nil, B); RGN. free; font. free; B. free; G. free; end; Procedure tform1.formmousedown (Sender: tobject; button: tmousebutton; shift: tshiftstate; X, Y: integer); begin if ptinrect (RT, point (x, y )) then begin X1: = x; Y1: = y; flag: = true; end; Procedure tform1.formmousemove (Sender: tobject; shift: tshiftstate; X, Y: integer ); begin if not flag then exit; offsetrect (RT, X-x1); X1: = x; Y1: = y; repaint; end; Procedure tform1.formmouseup (Sender: tobject; button: tmousebutton; shift: tshiftstate; X, Y: integer); begin flag: = false; end; Procedure tform1.checkbox1click (Sender: tobject); begin repaint; end.
Form file:
Object form1: tform1 left = 0 Top = 0 caption = 'form1' clientheight = 184 clientwidth = 243 color = clbtnface font. charset = default_charset font. color = clwindowtext font. height =-11 font. name = 'tahoma 'font. style = [] oldcreateorder = false position = podesktopcenter oncreate = formcreate onmousedown = formmousedown onmousemove = formmousemove onmouseup = formmouseup onpaint = formpaint pixelsperinch = 96 textheight = 13 object checkbox1: tcheckbox left = 170 Top = 159 width = 65 Height = 17 caption = 'checkbox1' taborder = 0 onclick = checkbox1click endend