代碼：
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
效果圖：
