文档章节

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

涂孟超
 涂孟超
发布于 2014/09/26 15:35
字数 989
阅读 9
收藏 0
点赞 0
评论 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


效果图:



© 著作权归作者所有

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

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

万仓一黍 ⋅ 2013/10/08 ⋅ 0

WPF 使用 Direct2D1 画图 绘制基本图形

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

lindexi_gd ⋅ 04/19 ⋅ 0

WhiteStarUML 5.6.1 发布,UML 建模软件

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

daxiaoming ⋅ 2015/01/26 ⋅ 9

深度解读 - Windows 7核心图形架构细致分析(转贴)

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

迈克老狼1 ⋅ 2012/12/23 ⋅ 0

关于Direct3D11里汉字显示的一些思考

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

长平狐 ⋅ 2012/11/12 ⋅ 0

USB启动盘制作软件--iBurnMgr

iBurnMgr是一款基于Direct2D DirectWrite开发的USB启动盘制作软件,采用流行的扁平风格,使用原生C++开发,不依赖任何第三方库,USB启动盘制作过程使用多线程技术,制作过程可以中途终止,界...

Force武装卫队 ⋅ 2014/06/18 ⋅ 4

Windows桌面应用程序(1-2-4-7th) DPI和设备无关的像素

要使用Windows图形进行有效编程,您必须了解两个相关的概念: 每英寸点数(DPI) 设备无关像素(DIP)。 我们从DPI开始。这将需要短暂的绕行排版。在印刷术中,类型的大小以称为点的单位来测量。一点...

qq_37422196 ⋅ 01/12 ⋅ 0

硬件加速:浏览器大战的新前沿

硬件加速:浏览器大战的新前沿 作者:Frederic Lardinois / 2009年11月24日 9:04AM 微软在本月初召开的专业开发者大会(Professional Developers Conference)上宣布了其最新的IE9计划,微软在...

老枪 ⋅ 2009/11/26 ⋅ 0

Direct2D教程(十二)图层

什么是Layers? Layer,中文译成图层,在Direct2D中可以用来完成一些特殊效果,使用Layer的时候,先将Layer Push到render target,然后进行绘制,此时是直接绘制在Layer上的,绘制完毕后,将...

吞吞吐吐的 ⋅ 2017/10/26 ⋅ 0

Direct2DRotation错位问题

我用Direct2D的Matrix3X2F的Rotation旋转一个矩形,矩形是移动的,旋转后矩形发生了错位不知道是怎么回事,应该需要平移,有没有对2D图形学有研究的 BulletPosition[0]=manleft+40.f+ManLeft...

自取灭亡 ⋅ 2016/08/10 ⋅ 0

没有更多内容

加载失败,请刷新页面

加载更多

下一页

大数据,必须掌握的10项顶级安全技术

我们看到越来越多的数据泄漏事故、勒索软件和其他类型的网络攻击,这使得安全成为一个热门话题。 去年,企业IT面临的威胁仍然处于非常高的水平,每天都会看到媒体报道大量数据泄漏事故和攻击...

p柯西 ⋅ 38分钟前 ⋅ 0

Linux下安装配置Hadoop2.7.6

前提 安装jdk 下载 wget http://mirrors.hust.edu.cn/apache/hadoop/common/hadoop-2.7.6/hadoop-2.7.6.tar.gz 解压 配置 vim /etc/profile # 配置java环境变量 export JAVA_HOME=/opt/jdk1......

晨猫 ⋅ 44分钟前 ⋅ 0

crontab工具介绍

crontab crontab 是一个用于设置周期性被执行的任务工具。 周期性执行的任务列表称为Cron Table crontab(选项)(参数) -e:编辑该用户的计时器设置; -l:列出该用户的计时器设置; -r:删除该...

Linux学习笔记 ⋅ 今天 ⋅ 0

深入Java多线程——Java内存模型深入(2)

5. final域的内存语义 5.1 final域的重排序规则 1.对于final域,编译器和处理器要遵守两个重排序规则: (1)在构造函数内对一个final域的写入,与随后把这个被构造对象的引用赋值给一个引用...

江左煤郎 ⋅ 今天 ⋅ 0

面试-正向代理和反向代理

面试-正向代理和反向代理 Nginx 是一个高性能的反向代理服务器,但同时也支持正向代理方式的配置。

秋日芒草 ⋅ 今天 ⋅ 0

Spring 依赖注入(DI)

1、Setter方法注入: 通过设置方法注入依赖。这种方法既简单又常用。 类中定义set()方法: public class HelloWorldOutput{ HelloWorld helloWorld; public void setHelloWorld...

霍淇滨 ⋅ 昨天 ⋅ 0

马氏距离与欧氏距离

马氏距离 马氏距离也可以定义为两个服从同一分布并且其协方差矩阵为Σ的随机变量之间的差异程度。 如果协方差矩阵为单位矩阵,那么马氏距离就简化为欧氏距离,如果协方差矩阵为对角阵,则其也...

漫步当下 ⋅ 昨天 ⋅ 0

聊聊spring cloud的RequestRateLimiterGatewayFilter

序 本文主要研究一下spring cloud的RequestRateLimiterGatewayFilter GatewayAutoConfiguration @Configuration@ConditionalOnProperty(name = "spring.cloud.gateway.enabled", matchIfMi......

go4it ⋅ 昨天 ⋅ 0

Spring clound 组件

Spring Cloud技术应用从场景上可以分为两大类:润物无声类和独挑大梁类。 润物无声,融合在每个微服务中、依赖其它组件并为其提供服务。 Ribbon,客户端负载均衡,特性有区域亲和、重试机制。...

英雄有梦没死就别停 ⋅ 昨天 ⋅ 0

Confluence 6 重新获得站点备份文件

Confluence 将会创建备份,同时压缩 XML 文件后存储熬你的 <home-directory>/backups> 目录中。你需要自己访问你安装的 Confluence 服务器,并且从服务器上获得这个文件。 运行从 Confluence...

honeymose ⋅ 昨天 ⋅ 0

没有更多内容

加载失败,请刷新页面

加载更多

下一页

返回顶部
顶部