Re-learning gdi+[87]: tgpimage (7)

This example effect chart:

Code files:Unit Unit1;
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
Procedure recttopoints;
End
Var
Form1:tform1;
Implementation
{$R *.DFM}
Uses Gdipobj, GDIPAPI;
Var
Img:tgpimage;
Flag:integer =-1;
Clickimg:boolean;
Rt:trect;
PTS:ARRAY[0..7] of Tpoint;
X1,y1:integer;
{Gets eight points from the rectangle because it is used repeatedly, so it is extracted as a separate process}
Procedure tform1.recttopoints;
Begin
PTS[0]: = Rt. TopLeft;
PTS[1]: = Point (Rt. Left, Rt. Top + (Rt. Bottom-rt. Top) Div 2);
PTS[2]: = Point (Rt. Left, Rt. Bottom);
PTS[3]: = Point (Rt. Left + (Rt. Right-rt. left) Div 2, Rt. Bottom);;
PTS[4]: = Rt. BottomRight;
PTS[5]: = Point (Rt. Right, Rt. Top + (Rt. Bottom-rt. Top) Div 2);;
PTS[6]: = Point (Rt. Right, Rt. top);;
PTS[7]: = Point (Rt. Left + (Rt. Right-rt. left) Div 2, Rt. top);
End
Procedure Tform1.formcreate (Sender:tobject);
Const
Imgpath = ' c:\temp\test.png ';
Var
W,h:integer;
Begin
If not fileexists (Imgpath) then Exit;
IMG: = tgpimage.create (Imgpath);
W: = img. getwidth;
H: = img. GetHeight;
Rt. Left: = (clientwidth-w) div 2;
Rt. Top: = (clientheight-h) div 2;
Rt. Right: = Rt. Left + W;
Rt. Bottom: = Rt. Top + H;
recttopoints;
DoubleBuffered: = True;
End
Procedure Tform1.formdestroy (Sender:tobject);
Begin
Img. Free;
End
Procedure Tform1.formpaint (Sender:tobject);
Var
G:tgpgraphics;
P:tgppen;
I:integer;
Begin
G: = Tgpgraphics.create (Canvas.handle);
P: = tgppen.create (aclred);
G.drawimage (IMG, makerect (RT));
If Clickimg Then
For I: = 0 to Length (pts)-1 do
G.drawrectangle (P, Makerect (pts[i). X-3, Pts[i]. Y-3, 6, 6));
P.free;
G.free;
End
Procedure Tform1.formmousedown (Sender:tobject; Button:tmousebutton;
Shift:tshiftstate; X, Y:integer);
Var
I:integer;
Begin
Flag: =-1;
For I: = 0 to Length (pts)-1 do
If PtInRect (Bounds (pts[i). X-3, Pts[i]. Y-3, 6, 6), point (X, Y)) then
Begin
Flag: = i;
break;
End
If flag =-1 Then
Begin
Clickimg: = PtInRect (RT, point (X,y));
Repaint;
End ELSE begin
X1: = X;
Y1: = Y;
End
End
Procedure Tform1.formmousemove (Sender:tobject; Shift:tshiftstate; X
Y:integer);
Begin
If flag =-1 then Exit;
Case Flag of
0:begin Inc (Rt. Left, x-x1); INC (Rt. Top, y-y1) end;
1:begin Inc (Rt. Left, x-x1) end;
2:begin Inc (Rt. Left, x-x1); INC (Rt. Bottom, y-y1) end;
3:begin Inc (Rt. Bottom, y-y1) end;
4:begin Inc (Rt. Right, x-x1); INC (Rt. Bottom, y-y1) end;
5:begin Inc (Rt. Right, x-x1) end;
6:begin Inc (Rt. Right, x-x1); INC (Rt. Top, y-y1) end;
7:begin Inc (Rt. Top, y-y1) end;
End
X1: = X;
Y1: = Y;
recttopoints;
Repaint;
End
Procedure Tform1.formmouseup (Sender:tobject; Button:tmousebutton;
Shift:tshiftstate; X, Y:integer);
Begin
Flag: =-1;
End
End.

Form file:object Form1: TForm1
　Left = 0
　Top = 0
　Caption = 'Form1'
　ClientHeight = 246
　ClientWidth = 346
　Color = clBtnFace
　Font.Charset = DEFAULT_CHARSET
　Font.Color = clWindowText
　Font.Height = -11
　Font.Name = 'Tahoma'
　Font.Style = []
　OldCreateOrder = False
　Position = poDesktopCenter
　OnCreate = FormCreate
　OnDestroy = FormDestroy
　OnMouseDown = FormMouseDown
　OnMouseMove = FormMouseMove
　OnMouseUp = FormMouseUp
　OnPaint = FormPaint
　PixelsPerInch = 96
　TextHeight = 13
end