This example effect chart:
Code files:Unit Unit1;
Interface
Uses
Windows, Messages, sysutils, 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 (Sender:tobject; 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: = ' shear area ';
checkbox1.checked: = True;
DoubleBuffered: = True;
End
Procedure Tform1.formpaint (Sender:tobject);
Var
G:tgpgraphics;
B:tgpsolidbrush;
Rgn:tgpregion;
str:string;
Font:tgpfont;
RECTF:TGPRECTF;
I:integer;
Begin
RECTF: = makerect (0.0, 0, clientwidth+10, clientheight);
str: = ';
For I: = 0 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); {Cut artboards with area}
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
End
Procedure Tform1.formmousemove (Sender:tobject; Shift:tshiftstate; X
Y:integer);
Begin
If not flag then Exit;
Offsetrect (RT, x-x1, Y-y1);
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
End.