本例效果圖:
代碼文件:unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TForm1 = class(TForm)
procedure FormPaint(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(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);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses GDIPOBJ, GDIPAPI;
var
img: TGPImage;
pts: array[0..2] of TGPPoint;
flag: Integer = -1;
procedure TForm1.FormCreate(Sender: TObject);
var
w,h: Integer;
begin
img := TGPImage.Create('C:\temp\test.jpg');
w := img.GetWidth;
h := img.GetHeight;
pts[0] := MakePoint((ClientWidth - w) div 2 + w, (ClientHeight - h) div 2);
pts[1] := MakePoint((ClientWidth - w) div 2, (ClientHeight - h) div 2);
pts[2] := MakePoint((ClientWidth - w) div 2 + w, (ClientHeight - h) div 2 + h);
DoubleBuffered := True;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
img.Free;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
i: Integer;
begin
for i := 0 to Length(pts) do
if PtInRect(Bounds(pts[i].X-3, pts[i].Y-3, 6, 6), Point(X, Y)) then
begin
flag := i;
Exit;
end;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if flag = -1 then Exit;
pts[flag] := MakePoint(X, Y);
Repaint;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
flag := -1;
end;
procedure TForm1.FormPaint(Sender: TObject);
var
g: TGPGraphics;
p: TGPPen;
i: Integer;
begin
g := TGPGraphics.Create(Self.Canvas.Handle);
p := TGPPen.Create(aclRed);
{第一點: 右上角; 第二點: 左上角; 第三點: 右下角; 第四點將根據平行四邊形計算; 只能是三個點.}
g.DrawImage(img, PGPPoint(@pts), Length(pts));
for i := 0 to Length(pts)-1 do g.DrawRectangle(p, pts[i].X-3, pts[i].Y-3, 6, 6);
p.Free;
g.Free;
end;
end.
窗體文件:object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 206
ClientWidth = 307
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
