Delphi_的绘图功能.doc

Graphics 单元中的类
//Graphics 单元中的类
TGraphicsObject
TFont
TPen
TBrush
TFontRecall
TPenRecall
TBrushRecall
TCanvas
TGraphic
TPicture
TMetafileCanvas
TMetafileImage
TMetafile
TBitmapImage
TBitmap
TIconImage
TIcon
TResourceManager
TBrushResourceManager
TFileFormatsList

Delphi 的绘图功能[1] - TCanvas 的类成员
//过程:
Arc
BrushCopy
Chord
CopyRect
Draw
DrawFocusRect
Ellipse
Ellipse
FillRect
FloodFill
FrameRect
LineTo
Lock
MoveTo
Pie
Polygon
Polyline
PolyBezier
PolyBezierTo
Rectangle
Rectangle
Refresh
RoundRect
StretchDraw
TextOut
TextRect
TextRect
Unlock

//函数:
HandleAllocated
TextExtent
TextHeight
TextWidth
TryLock

//属性:
ClipRect
Handle
LockCount
CanvasOrientation
PenPos
Pixels
TextFlags
Brush
CopyMode
Font
Pen

//事件
OnChange
OnChanging

Delphi 的绘图功能[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;
interface
uses
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 *.dfm}
var
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;
interface
uses
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 *.dfm}
var
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;
interface
uses
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 *.dfm}
procedure 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: array[0..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: array[0..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;
interface
uses
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 *.dfm}
{PolyBezier 至少需要四个点做参数; 不改变画笔的当前位置}
procedure TForm1.Button1Click(Sender: TObject);
var
pts: array[0..3] of TPoint;
begin
Canvas.Pen.Width := 2;
Canvas.Pen.Color := clRed;
pts[0].X := 10; pts[0].Y := 10; {起点}
pts[1].X := 60; pts[1].Y := 10; {控制点1}
pts[2].X := 10; pts[2].Y := 100; {控制点2}
pts[3].X := 60; pts[3].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: array[1..3] of TPoint; {从 1 开始的, 就 3 个元素}
begin
Canvas.Pen.Width := 2;
Canvas.Pen.Color := clRed;
Canvas.MoveTo(10 + 82, 10); {起点}
//pts[0].X := 10; pts[0].Y := 10;
pts[1].X := 60 + 82; pts[1].Y := 10; {控制点1}
pts[2].X := 10 + 82; pts[2].Y := 100; {控制点2}
pts[3].X := 60 + 82; pts[3].Y := 100; {终点}
Canvas.PolyBezierTo(pts);
Canvas.Pen.Width := 1;
Canvas.Pen.Color := clBlue;
Canvas.LineTo(ClientWidth, ClientHeight);
end;
end.

//效果图:

//绘制多条贝塞尔线时, 每条线的终点也是下条线的起点.
unit Unit1;
interface
uses
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 *.dfm}
{PolyBezier 绘制多条线时, 需要 3*x + 1 个点}
procedure TForm1.Button1Click(Sender: TObject);
var
pts: array[0..6] of TPoint;
begin
Canvas.Pen.Width := 2;
Canvas.Pen.Color := clRed;
pts[0].X := 10; pts[0].Y := 10;
pts[1].X := 60; pts[1].Y := 10;
pts[2].X := 10; pts[2].Y := 100;
pts[3].X := 40; pts[3].Y := 100;
pts[4].X := 100; pts[4].Y := 10;
pts[5].X := 55; pts[5].Y := 99;
pts[6].X := 70; pts[6].Y := 10;
Canvas.PolyBezier(pts);
end;
{PolyBezierTo 绘制多条线时, 需要 3*x 个点}
procedure TForm1.Button2Click(Sender: TObject);
var
pts: array[1..6] of TPoint;
begin
Canvas.Pen.Width := 2;
Canvas.Pen.Color := clRed;
Canvas.MoveTo(10 + 82, 10);
//pts[0].X := 10; pts[0].Y := 10;
pts[1].X := 60 + 82; pts[1].Y := 10;
pts[2].X := 10 + 82; pts[2].Y := 100;
pts[3].X := 40 + 82; pts[3].Y := 100;
pts[4].X := 100 + 82; pts[4].Y := 10;
pts[5].X := 55 + 82; pts[5].Y := 99;
pts[6].X := 70 + 82; pts[6].Y := 10;
Canvas.PolyBezierTo(pts);
end;
end.

//效果图:

Delphi 的绘图功能[8] - TextOut、TextWidth、TextHeight
unit Unit1;
interface
uses
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 *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
const
arr: array[0..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(arr[i]) do {j := 0 to Length(arr[i])-1 ? WideString!}
begin
s := arr[i][j];
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
tfCalcRect
tfCenter
tfEditControl
tfEndEllipsis
tfPathEllipsis
tfExpandTabs
tfExternalLeading
tfLeft
tfModifyString
tfNoClip
tfNoPrefix
tfRight
tfRtlReading
tfSingleLine
tfTop
tfVerticalCenter
tfWordBreak
//这个函数是 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: 字体样式; 是个集合值, 是下面可选值或它们的组合:}
fsBold
fsItalic
fsUnderline
fsStrikeOut
{Pitch: 是字间距相关的, 有三个枚举值可选(不过我没测试出效果):}
fpDefault
fpVariable
fpFixed
{Charset: 字符集, 是个整数, 可能的值有:}
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、Mode
{Color: 颜色}
{Width: 宽度; 默认是 1; 如果赋予 <= 0 的值, 会使用默认值}
{Style: 样式; Delphi 定义了笔样式枚举 TPenStyle, 包含以下样式:}
psSolid = 0; {实线}
psDash = 1; {段线; 要求笔宽<=1}
psDot = 2; {点线; 要求笔宽<=1}
psDashDot = 3; {线、点; 要求笔宽<=1}
psDashDotDot = 4; {线、点、点; 要求笔宽<=1}
psClear = 5; {不可见}
psInsideFrame = 6; {实线; 但笔宽是向里扩展}
psUserStyle = 7; {自定义, Delphi.Net 支持}
psAlternate = 8; {交替, Delphi.Net 支持}

//下面的例子依次展示了各种样式:
var
i,x,y,n: Integer;
begin
x := 10;
y := 15;