Delphi 的绘图功能.doc

Graphics 单元中的类 /Graphics 单元中的类TGraphicsObjectTFontTPenTBrushTFontRecallTPenRecallTBrushRecallTCanvasTGraphicTPictureTMetafileCanvasTMetafileImageTMetafileTBitmapImageTBitmapTIconImageTIconTResourceManagerTBrushResourceManagerTFileFormatsListDelphi 的绘图功能1 - TCanvas 的类成员 /过程:ArcBrushCopyChordCopyRectDrawDrawFocusRectEllipseEllipseFillRectFloodFillFrameRectLineToLockMoveToPiePolygonPolylinePolyBezierPolyBezierToRectangleRectangleRefreshRoundRectStretchDrawTextOutTextRectTextRectUnlock/函数:HandleAllocatedTextExtentTextHeightTextWidthTryLock/属性:ClipRectHandleLockCountCanvasOrientationPenPosPixelsTextFlagsBrushCopyModeFontPen/事件OnChangeOnChangingDelphi 的绘图功能2 - 入门 绘图需要有纸、画笔、画刷; Delphi 有 Canvas、Pen、Brush.Canvas 就是画布, 譬如窗体的 Canvas 属性, 就是窗体的画布;Pen 是画笔, 可以设置笔色、笔宽等等;Brush 是画刷, 可以设置颜色等等. /举例:绘制直线procedure TForm1.Button1Click(Sender: TObject);begin Canvas.Pen.Color := clRed; 设置画笔颜色 Canvas.Pen.Width := 2; 设置画笔宽度 Canvas.MoveTo(10,10); 直线起点 Canvas.LineTo(100,100); 直线终点这里的 Canvas 是简写, 也可以写做: Self.Canvas 或 Form1.Canvas end;矩形填充procedure TForm1.Button2Click(Sender: TObject);begin Canvas.Brush.Color := clYellow; 设置画刷颜色, 也就是填充色 Canvas.FillRect(ClientRect); 填充窗体客户区end;/效果图:Delphi 的绘图功能3 - 矩形类图形 unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;type TForm1 = class(TForm) Button1: TButton; Button2: TButton; Button3: TButton; Button4: TButton; Button5: TButton; procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure Button5Click(Sender: TObject); end;var Form1: TForm1;implementation$R *.dfmvar btn: TButton;const y1 = 10; y2 = 80;先设置画笔画刷procedure TForm1.FormCreate(Sender: TObject);begin Canvas.Pen.Width := 4; Canvas.Pen.Color := clRed; Canvas.Brush.Color := clWhite;end;给出左上角和右下角的坐标就可以绘制矩形procedure TForm1.Button1Click(Sender: TObject);begin btn := TButton(Sender); Canvas.Rectangle(btn.Left, y1, btn.Left+btn.Width, y2);end;给出一个矩形结构做参数也可以绘制矩形procedure TForm1.Button2Click(Sender: TObject);var R: TRect; 定义一个矩形结构begin btn := TButton(Sender); R := Rect(btn.Left, y1, btn.Left+btn.Width, y2); Canvas.Rectangle(R);end;绘制圆角矩形; 最后两个参数是设置圆角的procedure TForm1.Button3Click(Sender: TObject);begin btn := TButton(Sender); Canvas.RoundRect(btn.Left, y1, btn.Left+btn.Width, y2, 20,20);end;绘制焦点矩形; 它不受画笔的影响; 它的颜色是和画刷的颜色进行某种运算得来的procedure TForm1.Button4Click(Sender: TObject);var R: TRect;begin btn := TButton(Sender); R := Rect(btn.Left, y1, btn.Left+btn.Width, y2); Canvas.DrawFocusRect(R);end;矩形描边, 用的不是画笔是画刷procedure TForm1.Button5Click(Sender: TObject);var R: TRect;begin btn := TButton(Sender); R := Rect(btn.Left, y1, btn.Left+btn.Width, y2); Canvas.FrameRect(R);end;end./效果图:Delphi 的绘图功能4 - 圆弧类图形 unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;type TForm1 = class(TForm) Button1: TButton; Button2: TButton; Button3: TButton; Button4: TButton; Button5: TButton; procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure Button5Click(Sender: TObject); end;var Form1: TForm1;implementation$R *.dfmvar btn: TButton;const y1 = 10; y2 = 80;先设置画笔画刷procedure TForm1.FormCreate(Sender: TObject);begin Canvas.Pen.Width := 2; Canvas.Pen.Color := clRed; Canvas.Brush.Color := clWhite;end;绘制椭圆; 椭圆的参数和矩形是一样的procedure TForm1.Button1Click(Sender: TObject);begin btn := TButton(Sender); Canvas.Ellipse(btn.Left, y1, btn.Left+btn.Width, y2);end;根据矩形结构绘制椭圆procedure TForm1.Button2Click(Sender: TObject);var R: TRect; 定义一个矩形结构begin btn := TButton(Sender); R := Rect(btn.Left, y1, btn.Left+btn.Width, y2); Canvas.Ellipse(R);end;绘制扇形procedure TForm1.Button3Click(Sender: TObject);begin btn := TButton(Sender); Canvas.Pie( btn.Left, y1, 矩形区域左上角 btn.Left + btn.Width, y2, 矩形区域右下角 btn.Left + btn.Width, y1 + (y2-y1) div 2, 扇形起点 btn.Left + btn.Width div 2, y1 扇形终点 );end;绘制弦, 参数同上procedure TForm1.Button4Click(Sender: TObject);begin btn := TButton(Sender); Canvas.Chord( btn.Left, y1, btn.Left + btn.Width, y2, btn.Left + btn.Width, y1 + (y2-y1) div 2, btn.Left + btn.Width div 2, y1 );end;绘制弧线, 参数同上procedure TForm1.Button5Click(Sender: TObject);begin btn := TButton(Sender); Canvas.Arc( btn.Left, y1, btn.Left + btn.Width, y2, btn.Left + btn.Width, y1 + (y2-y1) div 2, btn.Left + btn.Width div 2, y1 );end;end./效果图:Delphi 的绘图功能5 - 获取 Canvas 对象 在窗体上添加 Panel1、PaintBox1 和 Button1, 代码如下: procedure TForm1.Button1Click(Sender: TObject);var cvs: TCanvas;begin PaintBox1 就像窗体一样, 也有 Canvas 属性 PaintBox1.Canvas.Brush.Color := clRed; PaintBox1.Canvas.FillRect(PaintBox1.ClientRect); 像 Panel1 这样没有 Canvas 属性的控件, 也可以绕道获取 cvs := TCanvas.Create; cvs.Handle := GetDC(Panel1.Handle); cvs.Brush.Color := clBlue; cvs.FillRect(Panel1.ClientRect); cvs.Free;end;/执行前后对比图:Delphi 的绘图功能6 - Polygon、Polyline unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;type TForm1 = class(TForm) Button1: TButton; Button2: TButton; procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); end;var Form1: TForm1;implementation$R *.dfmprocedure TForm1.FormCreate(Sender: TObject);begin Canvas.Pen.Width := 2; Canvas.Pen.Color := clRed; Canvas.Brush.Color := clYellow;end;绘制多边形; 它的参数是一个点数组, 这里定义了一个常数数组procedure TForm1.Button1Click(Sender: TObject);const pts: array0.3 of TPoint = ( (x:10; y:40), (x:46; y:120), (x:82; y:40), (x:46; y:10) );begin Canvas.Polygon(pts);end;绘制连续的一组直线; 它的参数也是一个点数组, 我只是把上面的平移了一点procedure TForm1.Button2Click(Sender: TObject);const pts: array0.3 of TPoint = ( (x:10+82; y:40), (x:46+82; y:120), (x:82+82; y:40), (x:46+82; y:10) );begin Canvas.Polyline(pts);end;end./效果图:Delphi 的绘图功能7 - PolyBezier、PolyBezierTo unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;type TForm1 = class(TForm) Button1: TButton; Button2: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); end;var Form1: TForm1;implementation$R *.dfmPolyBezier 至少需要四个点做参数; 不改变画笔的当前位置procedure TForm1.Button1Click(Sender: TObject);var pts: array0.3 of TPoint;begin Canvas.Pen.Width := 2; Canvas.Pen.Color := clRed; pts0.X := 10; pts0.Y := 10; 起点 pts1.X := 60; pts1.Y := 10; 控制点1 pts2.X := 10; pts2.Y := 100; 控制点2 pts3.X := 60; pts3.Y := 100; 终点 Canvas.PolyBezier(pts); Canvas.Pen.Width := 1; Canvas.Pen.Color := clWhite; Canvas.LineTo(ClientWidth, ClientHeight);end;PolyBezierTo 最少只需要需要三个点, 它把当前位置当作第一点; 会改变画笔的当前位置procedure TForm1.Button2Click(Sender: TObject);var pts: array1.3 of TPoint; 从 1 开始的, 就 3 个元素begin Canvas.Pen.Width := 2; Canvas.Pen.Color := clRed; Canvas.MoveTo(10 + 82, 10); 起点 /pts0.X := 10; pts0.Y := 10; pts1.X := 60 + 82; pts1.Y := 10; 控制点1 pts2.X := 10 + 82; pts2.Y := 100; 控制点2 pts3.X := 60 + 82; pts3.Y := 100; 终点 Canvas.PolyBezierTo(pts); Canvas.Pen.Width := 1; Canvas.Pen.Color := clBlue; Canvas.LineTo(ClientWidth, ClientHeight);end;end./效果图:/绘制多条贝塞尔线时, 每条线的终点也是下条线的起点.unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;type TForm1 = class(TForm) Button1: TButton; Button2: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); end;var Form1: TForm1;implementation$R *.dfmPolyBezier 绘制多条线时, 需要 3*x + 1 个点procedure TForm1.Button1Click(Sender: TObject);var pts: array0.6 of TPoint;begin Canvas.Pen.Width := 2; Canvas.Pen.Color := clRed; pts0.X := 10; pts0.Y := 10; pts1.X := 60; pts1.Y := 10; pts2.X := 10; pts2.Y := 100; pts3.X := 40; pts3.Y := 100; pts4.X := 100; pts4.Y := 10; pts5.X := 55; pts5.Y := 99; pts6.X := 70; pts6.Y := 10; Canvas.PolyBezier(pts);end;PolyBezierTo 绘制多条线时, 需要 3*x 个点procedure TForm1.Button2Click(Sender: TObject);var pts: array1.6 of TPoint;begin Canvas.Pen.Width := 2; Canvas.Pen.Color := clRed; Canvas.MoveTo(10 + 82, 10); /pts0.X := 10; pts0.Y := 10; pts1.X := 60 + 82; pts1.Y := 10; pts2.X := 10 + 82; pts2.Y := 100; pts3.X := 40 + 82; pts3.Y := 100; pts4.X := 100 + 82; pts4.Y := 10; pts5.X := 55 + 82; pts5.Y := 99; pts6.X := 70 + 82; pts6.Y := 10; Canvas.PolyBezierTo(pts);end;end./效果图:Delphi 的绘图功能8 - TextOut、TextWidth、TextHeight unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); end;var Form1: TForm1;implementation$R *.dfmprocedure TForm1.Button1Click(Sender: TObject);const arr: array0.3 of WideString = ( 白日依山尽, 黄河入海流, 欲穷千里目, 更上一层楼 ); a = 20; 横向间隔 b = 20; 纵向间隔var s: string; x,y: Integer; i,j: Integer;begin x := 20; y := 20; for i := 0 to Length(arr)-1 do begin for j := 1 to Length(arri) do j := 0 to Length(arri)-1 ? WideString! begin s := arrij; Canvas.TextOut(x, y, s); x := x + Canvas.TextWidth(s) + a; end; x := 20; y := y + Canvas.TextHeight(s) + b; end;end;end./效果图:Delphi 的绘图功能9 - TextRect /第一种重载的声明:TextRect( Rect: TRect; 矩形 X, Y: Integer; 相对于窗体的位置 const Text: string 文本);如果要输出的文本超出指定的矩形将不被显示/第一种重载的举例:procedure TForm1.Button1Click(Sender: TObject);const R: TRect = (Left:0; Top:0; Right:60; Bottom:60); s = 万一的 Delphi 博客;begin Canvas.Brush.Color := clWhite; Canvas.FillRect(R); Canvas.TextRect(R, 10, 10, s);end;/效果图:/第二种重载的声明:TextRect( var Rect: TRect; 矩形范围 var Text: string; 文本 TextFormat: TTextFormat = 选项; 集合类型, 默认值是个空的集合);参数三是 TTextFormat 类型的集合, 它定义如下:TTextFormat = set of TTextFormats;TTextFormats 是个枚举, 定义如下TTextFormats = (tfBottom, tfCalcRect, tfCenter, tfEditControl, tfEndEllipsis, tfPathEllipsis, tfExpandTabs, tfExternalLeading, tfLeft, tfModifyString, tfNoClip, tfNoPrefix, tfRight, tfRtlReading, tfSingleLine, tfTop, tfVerticalCenter, tfWordBreak);所以参数三可以是下列值之一或它们的组合tfBottom tfCalcRecttfCentertfEditControltfEndEllipsistfPathEllipsistfExpandTabstfExternalLeadingtfLefttfModifyStringtfNoCliptfNoPrefixtfRighttfRtlReadingtfSingleLinetfToptfVerticalCentertfWordBreak/这个函数是 API 函数 DrawTextEx 的简化, 可以参见: DrawTextEx/第二种重载的举例1:默认是顶对齐、左对齐; 前两个参数都是传址的, 不能用常量procedure TForm1.FormPaint(Sender: TObject);var R: TRect; S: string;begin R := ClientRect; InflateRect(R,-10,-10); 把矩形缩小一圈 S := Delphi; Canvas.Brush.Color := clWhite; Canvas.FillRect(R); Canvas.TextRect(R, S);end;/效果图:/第二种重载的举例2:单行文本、水平居中、垂直居中procedure TForm1.FormPaint(Sender: TObject);var R: TRect; S: string;begin R := ClientRect; InflateRect(R,-10,-10); 把矩形缩小一圈 S := Delphi; Canvas.Brush.Color := clWhite; Canvas.FillRect(R); Canvas.TextRect(R, S , tfSingleLine, tfCenter, tfVerticalCenter);end;/效果图:Delphi 的绘图功能10 - TFONT 类 /先来个例子:procedure TForm1.FormPaint(Sender: TObject);const S = 万一的 Delphi 博客;var font: TFont;begin font := TFont.Create; font.Name := 微软雅黑; font.Style := fsBold, fsItalic; font.Color := clRed; font.Height := 72; Canvas.Font := font; Canvas.TextOut(10, 10, S); font.Free;end;/效果图:/因为 Canvas 的 Font 属性就是 TFONT 类的一个实例, 所以上面的程序可以简化为:procedure TForm1.FormPaint(Sender: TObject);const S = 万一的 Delphi 博客;begin Canvas.Font.Name := 微软雅黑; Canvas.Font.Style := fsBold, fsItalic; Canvas.Font.Color := clRed; Canvas.Font.Height := 72; Canvas.TextOut(10, 10, S);end;/TFont 类的常用属性:Name: 字体名称Color: 颜色Size、Height: 字号与字体高度, 都可以设定字体大小Style: 字体样式; 是个集合值, 是下面可选值或它们的组合:fsBoldfsItalicfsUnderlinefsStrikeOutPitch: 是字间距相关的, 有三个枚举值可选(不过我没测试出效果):fpDefaultfpVariablefpFixedCharset: 字符集, 是个整数, 可能的值有:ANSI_CHARSET = 0;DEFAULT_CHARSET = 1;SYMBOL_CHARSET = 2;SHIFTJIS_CHARSET = 128;HANGEUL_CHARSET = 129;GB2312_CHARSET = 134;CHINESEBIG5_CHARSET = 136;OEM_CHARSET = 255;JOHAB_CHARSET = 130;HEBREW_CHARSET = 177;ARABIC_CHARSET = 178;GREEK_CHARSET = 161;TURKISH_CHARSET = 162;VIETNAMESE_CHARSET = 163;THAI_CHARSET = 222;EASTEUROPE_CHARSET = 238;RUSSIAN_CHARSET = 204;Orientation: 旋转角度, 单位是 1/10 度, 举个例子:/代码:const S = 万一的 Delphi 博客;begin Canvas.Font.Style := fsBold; Canvas.Font.Color := clRed; Canvas.Font.Height := 32; Canvas.Font.Orientation := 450; Canvas.TextOut(0, ClientHeight-20, S);end;/效果图:Delphi 的绘图功能11 - TPen 类(上) /TPen 的主要属性有四: Color、Width、Style、ModeColor: 颜色Width: 宽度; 默认是 1; 如果赋予 = 0 的值, 会使用默认值Style: 样式; Delphi 定义了笔样式枚举 TPenStyle, 包含以下样式:psSolid = 0; 实线psDash = 1; 段线; 要求笔宽=1psDot = 2; 点线; 要求笔宽=1psDashDot = 3; 线、点; 要求笔宽=1psDashDotDot = 4; 线、点、点; 要求笔宽=1psClear = 5; 不可见psInsideFrame = 6; 实线; 但笔宽是向里扩展psUserStyle = 7; 自定义, Delphi.Net 支持psAlternate = 8; 交替, Delphi.Net 支持/下面的例子依次展示了各种样式:var i,x,y,n: Integer;begin x := 10; y := 15; n := ClientWidth - 2*x; Canvas.Pen.Color := clRed; for i := 0 to 8 do begin Canvas.Pen.Style := TPenStyle(i); Canvas.MoveTo(x, y); Canvas.LineTo(x + n, y); y := y + 15; end;end;/效果图:Mode: 画笔与背景的颜色混合模式; Delphi 定义了模式枚举 TPenMode, 包含以下模式:pmBlack 总是黑色pmWhite 总是白色pmNop 画笔无效pmNot 背景色取反pmCopy 画笔设置的颜色pmNotCopy 画笔颜色取反pmMergePenNot 画笔颜色与背景颜色的反色的组合pmMaskPenNot 画笔颜色与背景公共色的反色的组合pmMergeNotPen 画笔颜色取反后与背景颜色的组合pmMaskNotPen 画笔的反色与背景的公共色的组合pmMerge 画笔颜色与背景颜色的组合pmNotMerge pmMerge 的反色pmMask 画笔与背景公共颜色的组合pmNotMask pmMask 的反色pmXor 画笔颜色与背景颜色的 Xor 组合pmNotXor pmXor 的反色/颜色模式测试程序:var i,x,y,w,n: Integer;begin 先画竖的颜色背景 x := 0; y := 0; w := ClientWidth div 18; for i := 0 to 18 do begin Canvas.Brush.Color := PaletteIndex(i); Canvas.FillRect(Rect(x, y, x+w, ClientHeight); x := x + w; end; 再按不同模式依次画 16 条红色的横线 x := 0; y := 20; n := ClientWidth; Canvas.Pen.Width := 4; Canvas.Pen.Color := clRed; for i := 0 to 15 do begin Canvas.Pen.Mode := TPenMode(i); Canvas.MoveTo(x, y); Canvas.LineTo(x + n, y); y := y + 20; end;end;/效果图:Delphi 的绘图功能12 - TPen 类(下) : 学习橡皮线 /奇妙的异或运算, 就这些简单的代码, 反复点击按钮.procedure TForm1.Button1Click(Sender: TObject);begin Canvas.Pen.Color := clYellow; 指定笔颜色为黄色 Canvas.Pen.Width := 20; 笔宽 20 Canvas.Pen.Mode := pmXor; 指定画笔模式为: 画笔色与背景色的异或运算 画线 Canvas.MoveTo(0,0); Canvas.LineTo(ClientWidth,ClientHeight);end;/效果图:/做一个橡皮线的示例:unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;type TForm1 = class(TForm) procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); end;var Form1: TForm1;implementation$R *.dfmvar x1,y1,x2,y2: Integer; 直线两个端点的坐标 f: Boolean; 判断鼠标是否点下procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);begin x1 := X; y1 := Y; x2 := X; y2 := Y; Canvas.Pen.Color := clRed; Canvas.Pen.Width := 2; Canvas.Pen.Mode := pmXor; f := True;end;procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);begin if f then begin 擦除 Canvas.MoveTo(x1, y1); Canvas.LineTo(x2, y2); x2 := X; y2 := y; 重绘 Canvas.MoveTo(x1, y1); Canvas.LineTo(x2, y2); end;end;procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);begin if f then begin 画出确定的线 Canvas.Pen.Mode := pmCopy; Canvas.MoveTo(x1, y1); Canva