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
      onm ouseDown = PaintBox1MouseDown
      onm ouseMove = PaintBox1MouseMove
      onm ouseUp = 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

---

效果图：

---

posted on 2011-03-30 23:42  万一  阅读(3043)  评论(1)  编辑  收藏