文档章节

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

涂孟超
 涂孟超
发布于 2014/09/26 15:35
字数 989
阅读 9
收藏 0

代码:

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


效果图:



本文转载自:http://www.cnblogs.com/del/archive/2011/03/30/2000412.html

共有 人打赏支持
涂孟超
粉丝 12
博文 2011
码字总数 14107
作品 0
深圳
程序员
杂谈SharpDx中的WIC组件——我们需要WIC的图片编码功能么?

在前文 SharpDX之Direct2D教程II——加载位图文件和保存位图文件 中,发现在VB2010中不能很好的运用SharpDx中的WIC组件进行图片的编码工作。可能是我的设置问题,也可能是SharpDx对VB2010支持...

万仓一黍
2013/10/08
0
0
WPF 使用 Direct2D1 画图 绘制基本图形

本文来告诉大家如何在 Direct2D1 绘制基本图形,包括线段、矩形、椭圆 本文是一个系列 WPF 使用 Direct2D1 画图入门 WPF 使用 Direct2D1 画图 绘制基本图形 本文的组织参考Direct2D,对大神表...

lindexi_gd
04/19
0
0
WhiteStarUML 5.6.1 发布,UML 建模软件

WhiteStarUML 发布了 5.6.1 版本。 该版本的改动: 新增选项:现在可以在 Windows 7+上面选择启用 Direct2D 来绘制反锯齿图形。勾选 General -> Use Direct2D 添加了“复制/粘贴格式”命令 ...

daxiaoming
2015/01/26
2.7K
9
深度解读 - Windows 7核心图形架构细致分析(转贴)

原帖地址:http://technet.microsoft.com/zh-cn/library/ee921514.aspx 如现在大家所想的那样, Windows7 其实是 Windows Vista 的改进版。 Windows 7 在 Windows Vista 的基础上进行了大量的...

迈克老狼1
2012/12/23
0
0
关于Direct3D11里汉字显示的一些思考

本系列文章由zhmxy555(毛星云)编写,转载请注明出处。 http://blog.csdn.net/zhmxy555/article/details/8147234 作者:毛星云 邮箱: happylifemxy@163.com 这篇文章里,浅墨希望与大家一起...

长平狐
2012/11/12
690
0

没有更多内容

加载失败,请刷新页面

加载更多

利用碎片化时间Get Linux系统

起初,我做着一份与IT毫无关系的工作,每月领着可怜的工资,一直想改变现状,但无从下手,也就是大家熟知的迷茫。我相信,每一个人都会或多或少的经历过迷茫,迷茫每一个选择,迷茫工作或者生...

Linux就该这么学
15分钟前
0
0
图像显示深入学习一:Activity启动过程

一个月左右写了图像显示深入学习之文章开篇文章表明了自己近期的计划,前半年重新学习了opengl es,c++以及Linux的一些知识,觉得是时候开始看图像这一块的源码了,边看边补缺补漏吧。 作为该...

JerryLin123
38分钟前
1
0
给MySQL授权远程访问

putty登录服务器; 登录MySQL: mysql -u root -p 新建远程用户: CREATE USER 'myusername' IDENTIFIED BY 'mypassword'; 授权: grant all on *.* to john@'101.102.103.104' identified by......

sweethome
今天
1
0
在t-io老巢造谣,不过有造谣的就会有反造谣的!

只发当事人的截图,不发表评论,以免有引导嫌疑 PS: 截图是由不同的人发过来的 本人已经不在此微信群 图3:有造谣的,就有反造谣的 图4是2018-09-23的t-io官方群的一个发言小统计,有助于让...

talent-tan
今天
99
0
heartbeat 资源

drbd+apache+heartbeat : http://blog.51cto.com/11838039/1827901 heartbeat双机热备的架设 : http://blog.51cto.com/11838039/1827560 对heaetbeat的深一步认识 : http://blog.51cto.co......

寰宇01
今天
4
0

没有更多内容

加载失败,请刷新页面

加载更多

返回顶部
顶部