WinAPI: GetPath - 获取路径中的点

本例效果图:

---

代码文件:

---

unit Unit1;



interface



uses

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

  Dialogs, StdCtrls, ExtCtrls;



type

  TForm1 = class(TForm)

    Memo1: TMemo;

    procedure FormPaint(Sender: TObject);

  end;



var

  Form1: TForm1;



implementation



{$R *.dfm}



procedure TForm1.FormPaint(Sender: TObject);

type

  TPArr = array[0..0] of TPoint;

  TTArr = array[0..0] of Byte;

var

  pts: ^TPArr;

  types: ^TTArr;  {上面四行只是为了记录数据位置的起始点, 直接用指针也可以, 但用数组方便}

  count: Integer;

  i,x,y: Integer;

begin

  Canvas.Font.Size := 150;

  Canvas.Font.Style := [fsBold];

  SetBkMode(Canvas.Handle, TRANSPARENT);



  {路径}

  BeginPath(Canvas.Handle);

  Canvas.TextOut(2, 0, '万');

  EndPath(Canvas.Handle);



  Canvas.Pen.Color := clWhite;



  {GetPath 最后一个参数是 0, 可以先获取点总数}

  count := GetPath(Canvas.Handle, pts^, types^, 0);



  {分配内存}

  GetMem(pts, count*SizeOf(TPoint));

  GetMem(types, count);



  {获取点序列, 同时也获取了点类型序列}

  count := GetPath(Canvas.Handle, pts^, types^, count);

  Text := '路径中点的总数是: ' + IntToStr(count);



  {路径描边}

  StrokePath(Canvas.Handle);



  Memo1.Clear;

  Canvas.Brush.Color := clRed;



  {显示和绘制点序列}

  for i := 0 to count - 1 do

  begin

    x := pts^[i].X;

    y := pts^[i].Y;

    Memo1.Lines.Add(Format('x:%d;' + #9 + 'y:%d', [x, y]));

    Canvas.FillRect(Rect(x-1,y-1,x+1,y+1));

  end;



  {释放内存}

  FreeMem(pts);

  FreeMem(types);

end;



end.


 
   

窗体文件:

---

object Form1: TForm1

  Left = 329

  Top = 269

  Caption = 'Form1'

  ClientHeight = 235

  ClientWidth = 331

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'Tahoma'

  Font.Style = []

  OldCreateOrder = False

  Position = poDesigned

  OnPaint = FormPaint

  PixelsPerInch = 96

  TextHeight = 13

  object Memo1: TMemo

    Left = 216

    Top = 0

    Width = 115

    Height = 235

    Align = alRight

    Lines.Strings = (

      'Memo1')

    ScrollBars = ssBoth

    TabOrder = 0

    ExplicitHeight = 264

  end

end