文档章节

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

没有更多内容

加载失败,请刷新页面

加载更多

React和Redux的连接react-redux

通过Redux文档来了解react-redux,在一段时间的实践后准备翻一翻源代码,顺便做些相关的总结。我看的代码的npm版本为v4.0.0,也就是说使用的React版本是0.14.x。 react-redux提供两个关键模块...

前端攻城老湿
36分钟前
1
0
1、Mybatis连接池配置 和 Context.xml的配置

注意: (1)mybatis 3.2 之前 通过 set get 方法 获取相关属性。之后通过属性姓名获取相关关联。 (2)mybatis 映射 优先为 sql 语句中的别名与实体类的属性进行映射。 (3)jndi Java用于调...

KingFightingAn
51分钟前
1
0
Android 界面漩涡扭曲动效实现

背景:之前偶然看到优酷有类似的页面切换动画效果。于是自己也打算来实现下这样的效果。 动效说明:点击界面中的任意位置,界面以点击位置作为中心点,开始以漩涡状态,扭曲,收缩。直到消失...

Carlyle_Lee
今天
2
0
聊聊我怎么系统学习Linux技能并快速提高的

聊聊我怎么系统学习Linux技能并快速提高的 随着电子信息科技时代的发展,学会使用计算机在我们的生活中成为了必不可少的一项技能。而作为计算机中的三大操作系统之一的Linux更是饱受计算机爱...

linuxCool
今天
4
0
Android/Java 获取一个byte[]的真实编码,用于解决乱码问题

来源地址:https://blog.csdn.net/qq_31384551/article/details/81627840 一个byte数组,byte[] buf,是由一个字符串转换来的,如何判断字符串使用的是什么编码? Mozilla的一个组件提供了相应...

她叫我小渝
今天
9
0

没有更多内容

加载失败,请刷新页面

加载更多

返回顶部
顶部