Direct2D (2) : 基本图形命令测试

代码：

---

unit Unit1;



interface



uses

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

  Dialogs, StdCtrls, ExtCtrls, ComCtrls, TypInfo, Direct2D;



type

  TForm1 = class(TForm)

    ListBox1: TListBox;

    Panel1: TPanel;

    GroupBox1: TGroupBox;

    CheckBox1: TCheckBox;

    Edit1: TEdit;

    UpDown1: TUpDown;

    ColorBox1: TColorBox;

    GroupBox2: TGroupBox;

    CheckBox2: TCheckBox;

    ColorBox2: TColorBox;

    PaintBox1: TPaintBox;

    procedure FormCreate(Sender: TObject);

    procedure PaintBox1Paint(Sender: TObject);

    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

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

    procedure ListBox1Click(Sender: TObject);

  end;



var

  Form1: TForm1;



implementation



{$R *.dfm}



type

  TEnumDraw = (eEllipse,eLine,eRectangle,eRoundRect,eFrameRect,ePie,eArc,eChord,ePolyLine,ePolygon,ePolyBezier);

  TPointArr4 = array[0..3] of TPoint;

var

  ptss: array[TEnumDraw] of TPointArr4; //点数组的数组

  ppts: ^TPointArr4; //某个图形需要的点数组的指针

  ppt: PPoint;       //某个点的指针

  enum: TEnumDraw;   //表示当前选择的要绘制的图形类型

  flag: Boolean;     //判断鼠标是否按在操控点上



{初始化数据}

procedure TForm1.FormCreate(Sender: TObject);

var

  e: TEnumDraw;

begin

  {初始化点数组}

  ptss[eEllipse][0] := Point(100,50);

  ptss[eEllipse][1] := Point(200,150);

  ptss[eEllipse][2] := Point(MaxInt,MaxInt);

  ptss[eEllipse][3] := Point(MaxInt,MaxInt);

  ptss[eRectangle] := ptss[eEllipse];

  ptss[eLine] := ptss[eEllipse];

  ptss[eRoundRect] := ptss[eEllipse];

  ptss[eFrameRect] := ptss[eEllipse];



  ptss[ePie][0] := Point(100,50);

  ptss[ePie][1] := Point(200,150);

  ptss[ePie][2] := Point(150,50);

  ptss[ePie][3] := Point(100,150);

  ptss[eArc] := ptss[ePie];

  ptss[eChord] := ptss[ePie];



  ptss[ePolyLine][0] := Point(100,50);

  ptss[ePolyLine][1] := Point(200,50);

  ptss[ePolyLine][2] := Point(200,150);

  ptss[ePolyLine][3] := Point(100,150);

  ptss[ePolygon] := ptss[ePolyLine];

  ptss[ePolyBezier] := ptss[ePolyLine];



  {填充 ListBox1}

  for e := Low(TEnumDraw) to High(TEnumDraw) do

  begin

    ListBox1.Items.Add(GetEnumName(TypeInfo(TEnumDraw), ord(e)));

  end;

  ListBox1.ItemIndex := 0;



  {初始化控件}

  Panel1.Caption := '';

  UpDown1.Associate := Edit1;

  Edit1.NumbersOnly := True;

  Edit1.Alignment := taCenter;

  UpDown1.Associate := Edit1;

  UpDown1.Min := 1;

  CheckBox1.Checked := True;

  CheckBox2.Checked := True;

  ColorBox1.Selected := clBlue;

  ColorBox2.Selected := clLime;

  {事件共享}

  CheckBox1.OnClick := ListBox1.OnClick;

  CheckBox2.OnClick := ListBox1.OnClick;

  ColorBox1.OnChange := ListBox1.OnClick;

  ColorBox2.OnChange := ListBox1.OnClick;

  Edit1.OnChange := ListBox1.OnClick;

end;



procedure TForm1.ListBox1Click(Sender: TObject);

begin

  enum := TEnumDraw(ListBox1.ItemIndex);

  ppts := @ptss[enum];

  PaintBox1.Invalidate;

end;



procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

  flag := PaintBox1.Cursor = crCross;

end;



procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

var

  i: Integer;

begin

  if flag then

  begin

    ppt^ := Point(X, Y);

    PaintBox1.Invalidate;

    Exit;

  end;



  {判断鼠标是否在控制点上}

  for i := 0 to Length(ppts^) - 1 do

  begin

    if (ppts^[i].X <> MaxInt) and PtInRect(Rect(ppts^[i].X-4, ppts^[i].Y-4, ppts^[i].X+4, ppts^[i].Y+4), Point(X,Y)) then

    begin

      PaintBox1.Cursor := crCross;

      ppt := @ppts^[i]; //哪个控制点

      Exit;

    end else

      PaintBox1.Cursor := crDefault;

  end;

end;



procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

  flag := False;

end;



{绘制}

procedure TForm1.PaintBox1Paint(Sender: TObject);

var

  pts: TPointArr4;

  pt: TPoint;

begin

  with TDirect2DCanvas.Create(PaintBox1.Canvas, PaintBox1.ClientRect) do

  begin

    BeginDraw;

    Pen.Color := ColorBox1.Selected;

    Pen.Width := StrToIntDef(Edit1.Text, 1);

    Brush.Color := ColorBox2.Selected;



    if not CheckBox1.Checked then Pen.Width := 0;

    if not CheckBox2.Checked then Brush.Style := bsClear;



    {绘制图形}

    pts := ppts^;

    case enum of

      eEllipse   : Ellipse(Rect(pts[0], pts[1]));

      eLine      : begin MoveTo(pts[0].X, pts[0].Y); LineTo(pts[1].X, pts[1].Y); end;

      eRectangle : Rectangle(Rect(pts[0], pts[1]));

      eRoundRect : RoundRect(Rect(pts[0], pts[1]), 25, 25);

      eFrameRect : FrameRect(Rect(pts[0], pts[1]));

      ePie       : Pie(pts[0].X, pts[0].Y, pts[1].X, pts[1].Y, pts[2].X, pts[2].Y, pts[3].X, pts[3].Y);

      eArc       : Arc(pts[0].X, pts[0].Y, pts[1].X, pts[1].Y, pts[2].X, pts[2].Y, pts[3].X, pts[3].Y);

      eChord     : Chord(pts[0].X, pts[0].Y, pts[1].X, pts[1].Y, pts[2].X, pts[2].Y, pts[3].X, pts[3].Y);

      ePolyLine  : Polyline(pts);

      ePolygon   : Polygon(pts);

      ePolyBezier: PolyBezier(pts);

    end;



    {绘制控制点}

    Brush.Style := bsSolid;

    Brush.Color := clRed;

    for pt in pts do if pt.X <> MaxInt then FillRect(Rect(pt.X-4, pt.Y-4, pt.X+4, pt.Y+4));

    EndDraw;

    Free;

  end;

end;



end.

---

窗体：

---

object Form1: TForm1

  Left = 0

  Top = 0

  Caption = 'Form1'

  ClientHeight = 348

  ClientWidth = 476

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'Tahoma'

  Font.Style = []

  OldCreateOrder = False

  OnCreate = FormCreate

  PixelsPerInch = 96

  TextHeight = 13

  object ListBox1: TListBox

    Left = 0

    Top = 0

    Width = 129

    Height = 348

    Align = alLeft

    ItemHeight = 13

    TabOrder = 0

    OnClick = ListBox1Click

  end

  object Panel1: TPanel

    Left = 129

    Top = 0

    Width = 347

    Height = 348

    Align = alClient

    Caption = 'Panel1'

    Padding.Top = 10

    TabOrder = 1

    object PaintBox1: TPaintBox

      Left = 1

      Top = 129

      Width = 345

      Height = 218

      Align = alClient

      OnMouseDown = PaintBox1MouseDown

      OnMouseMove = PaintBox1MouseMove

      OnMouseUp = PaintBox1MouseUp

      OnPaint = PaintBox1Paint

      ExplicitLeft = 208

      ExplicitTop = 136

      ExplicitWidth = 105

      ExplicitHeight = 105

    end

    object GroupBox1: TGroupBox

      Left = 1

      Top = 11

      Width = 345

      Height = 62

      Align = alTop

      Caption = 'Pen'

      TabOrder = 0

      object Edit1: TEdit

        Left = 256

        Top = 24

        Width = 48

        Height = 21

        TabOrder = 0

        Text = 'Edit1'

      end

      object UpDown1: TUpDown

        Left = 303

        Top = 22

        Width = 17

        Height = 23

        TabOrder = 1

      end

      object ColorBox1: TColorBox

        Left = 112

        Top = 24

        Width = 114

        Height = 22

        TabOrder = 2

      end

      object CheckBox1: TCheckBox

        Left = 16

        Top = 26

        Width = 97

        Height = 17

        Caption = 'CheckBox1'

        TabOrder = 3

      end

    end

    object GroupBox2: TGroupBox

      Left = 1

      Top = 73

      Width = 345

      Height = 56

      Align = alTop

      Caption = 'Brush'

      TabOrder = 1

      object ColorBox2: TColorBox

        Left = 112

        Top = 22

        Width = 114

        Height = 22

        TabOrder = 0

      end

      object CheckBox2: TCheckBox

        Left = 16

        Top = 24

        Width = 97

        Height = 17

        Caption = 'CheckBox2'

        TabOrder = 1

      end

    end

  end

end

---

效果图：

---