再学 GDI+[56]: 路径 - Warp

通过路径的 Warp 方法可以让路径在一个范围内(四个点决定的范围)变换;

第一个参数可以是 3 个点或 4 个点的数组, 如果是 3 个的数组, 那么第 4 个点将自动跟随一个平行四边形;

第二个参数用来指定点数组的个数, 本例就是通过这个参数控制了点的个数;

第三个参数是一个矩形, 这个矩形应该是路径的外接矩形, 之后的参数都是可选的;

第四个参数也是一个矩阵变换, 因由专门的 例子 , 这里没有尝试;

第五个参数是 TWarpMode(WarpModePerspective, WarpModeBilinear) , 默认前者;

第六个参数可以指定 Flatten 变换, 前面有 例子 , 这里也没有尝试.

---

本例效果图:

---

代码文件:

---

unit Unit1;



interface



uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, ComCtrls, StdCtrls;



type

  TForm1 = class(TForm)

    CheckBox1: TCheckBox;

    procedure FormCreate(Sender: TObject);

    procedure FormPaint(Sender: TObject);

    procedure CheckBox1Click(Sender: TObject);

    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);

    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);

    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

  end;



var

  Form1: TForm1;



implementation



{$R *.dfm}



uses GDIPOBJ, GDIPAPI;



var

  ptfs: array[0..3] of TGPPointF;

  ptCount: Integer = 4;

  pti: Integer;

  R: TRect;

  flag: Boolean;



procedure TForm1.FormCreate(Sender: TObject);

begin

  CheckBox1.Caption := '只用 3 个点控制';

  R := Rect(20, 20, ClientWidth-20, ClientHeight - 40);

  ptfs[0] := MakePoint(R.Left*1.0, R.Top);

  ptfs[1] := MakePoint(R.Right*1.0, R.Top);

  ptfs[2] := MakePoint(R.Left*1.0, R.Bottom);

  ptfs[3] := MakePoint(R.Right*1.0, R.Bottom);

end;



procedure TForm1.FormPaint(Sender: TObject);

var

  g: TGPGraphics;

  p: TGPPen;

  b: TGPBrush;

  path: TGPGraphicsPath;

  fontFamily: TGPFontFamily;

  StringFormat: TGPStringFormat;

  rectf: TGPRectF;

  i: Integer;

begin

  g := TGPGraphics.Create(Canvas.Handle);

  p := TGPPen.Create(aclRed, 1);

  b := TGPHatchBrush.Create(HatchStyleShingle, aclDarkCyan);



  path := TGPGraphicsPath.Create;

  path.AddEllipse(MakeRect(R));

  fontFamily := TGPFontFamily.Create('Arial Black');



  StringFormat := TGPStringFormat.Create;

  StringFormat.SetAlignment(StringAlignmentCenter);

  StringFormat.SetLineAlignment(StringAlignmentCenter);



  path.GetBounds(rectf);

  path.AddString('Delphi', -1, fontFamily, FontStyleRegular, 48, rectf, StringFormat);



  path.Warp(PGPPointF(@ptfs), Length(ptfs), rectf);

  g.FillPath(b, path);



  for i := 0 to ptCount - 1 do

    g.DrawRectangle(p, MakeRect(ptfs[i].X-3, ptfs[i].Y-3, 6, 6));



  StringFormat.Free;

  fontFamily.Free;

  path.Free;

  b.Free;

  p.Free;

  g.Free;

end;



procedure TForm1.CheckBox1Click(Sender: TObject);

begin

  ptCount := 4;

  if CheckBox1.Checked then ptCount := 3;

  Repaint;

end;



procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

var

  i: Integer;

begin

  for i := 0 to 3 do

    if PtInRect(Bounds(Trunc(ptfs[i].X-3), Trunc(ptfs[i].Y-3), 6, 6), Point(X, Y)) then

    begin

      pti := i;

      flag := True;

      Exit;

    end;

end;



procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,

  Y: Integer);

begin

  if flag then

  begin

    ptfs[pti].X := X;

    ptfs[pti].Y := Y;

    Repaint;

  end;

end;



procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

  flag := False;

end;



end.


 
   

窗体文件:

---

object Form1: TForm1

  Left = 0

  Top = 0

  Caption = 'Form1'

  ClientHeight = 220

  ClientWidth = 264

  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 = 151

    Top = 195

    Width = 129

    Height = 17

    Caption = 'CheckBox1'

    TabOrder = 0

    OnClick = CheckBox1Click

  end

end