Delphi中canvas(画布)的运用

最新推荐文章于 2024-11-25 04:37:39 发布
转载最新推荐文章于 2024-11-25 04:37:39 发布 · 1.5k 阅读
标签
#delphi #button #image #integer #timer
其他专栏收录该内容
7 篇文章
订阅专栏
本文介绍 Delphi 中 Canvas 类的应用技巧，包括为控件添加阴影、边框，实现动态帮助功能，以及创建平滑移动的字幕和图像效果。通过实际代码示例展示如何利用 Canvas 实现这些特殊效果。
{
在DELPHI为编程者提供了一个灵活的绘图场所, 即本文所述的CANVAS类, 在DELPHI中的很多控件都具有此属性, 使编程者可以在这些的控件的表面随心所欲的绘图, 这对完善用户界面或者制作一些屏幕特技都有着非凡的作用, 下面举例说明几种特殊屏幕效果的形成过程。
一、CANVAS必备基本知识：
1. 具有CANVAS属性的控件:
TBitmap, TComboBox, TDBComboBox, TDBGrid, TDBListBox, TDirectoryListBox,
TDrawGrid, TFileListBox, TForm, THeaderControl, TImage, TListBox, TOutline,
TPaintBox, TPrinter, TStatusBar, TStringGrid等,
2. CANVAS属性及命令: 篇幅所限, 省略参数及格式说明, 具体请参考文后程序及DELPHI帮助文件:
canvas.rectangle(): 画矩形
pen.color: 定义画笔颜色
roundrect():画圆角矩形
pen.width: 定义画笔宽度
arc(): 画弧线(不填充)
brush.color: 定义填充颜色
chord(): 画弧线(填充)
textout(): 在固定位置输出字符串
pie: 画扇形
textwidth: 取字符串高度
polygon(): 画多边形填充
textheight: 取字符串宽度
polyline(): 多点连线(不填充)
font.color: 指定字体颜色
Pixels(): 指定固定象素点颜色值
font.size: 指定字体大小
moveto(): 指明画线起点
Ellipse(): 画圆或椭圆
lineto(): 指明画线终点
3. 使用CANVAS注意事项: 当窗口进行重画时, 画布上的图像将消失, 比如当窗口进行最小
化又重新恢复时，就会引起画布上图像的消失，另外当刚刚运行程序时，窗口也是属于重新
绘制，所以如果在绘制窗口之前在画布上绘图，弹出窗口后将不能显示出图像，比如在
TForm1.FormCreate()事件中进行画布绘图操作将是徒劳的，但可以在此事件中进行画布操作的准备工作，比如设置画笔的颜色和宽度等。
二、CANCAS应用举例:
1. 为控件增加阴影或投影效果: 基本原理就是在利用该控件的父控件比如FORM或者其它容器控件的CANVAS, 在需要修饰的控件周围适当处填加图像, 通过线条及颜色的合理达配, 使控件与周围的图像融为一体, 形成特殊的视觉效果, 具体操作时需要根据被修饰控件的TOP、LEFT、WIDTH、HEIGHT等属性，确定需要画线的起点和终点坐标，这样操作无论被修饰控件位置及尺寸如何变化，都可以保证投影及阴影效果完美的实现；比如可在窗口中建立三个按钮,然后在按钮2和按钮3的CLICK事件中填加如下代码, 之后按下按钮2或按钮3即使按钮1形成投影和阴影效果:
}
procedure TForm1.Button2Click(Sender: TObject);
var
  x, y, i: integer;
begin
  x := 0; y := 0;
  form1.canvas.pen.width := 1;
  fori := 0 to8do
  begin
    form1.canvas.pen.color := $00A0A0A0;
    form1.canvas.moveto(Button1.left + Button1.width + x,
      Button1.top + y);
    form1.canvas.lineto(Button1.left + Button1.width + x,
      Button1.top + Button1.height + y);
    form1.canvas.pen.color := $00606060;
    form1.canvas.moveto(Button1.left + x,
      Button1.top + Button1.height + y);
    form1.canvas.lineto(Button1.left + Button1.width + x,
      Button1.top + Button1.height + y);
    x := x + 1;
    y := y + 1;
  end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
  x, y, i: integer;
begin
  x := 0; y := 0;
  form1.canvas.pen.width := 1;
  fori := 0 to8do
  begin
    form1.canvas.pen.color := $00404040;
    form1.canvas.moveto(Button1.left + Button1.width + x,
      Button1.top + 8);
    form1.canvas.lineto(Button1.left + Button1.width + x,
      Button1.top + Button1.height + 8);
    form1.canvas.moveto(Button1.left + 8,
      Button1.top + Button1.height + y);
    form1.canvas.lineto(Button1.left + Button1.width + 8,
      Button1.top + Button1.height + y);
    x := x + 1;
    y := y + 1;
  end;
end;
{
2. 为控件加上边框: DELPHI中有很多控件无边框属性, 利用CANVAS可以为任意的控件填加边框, 使其轮廓清楚; 具体操作时, 可先定义出画笔的颜色、画笔的宽度(边框宽度), 之后用polyline()命令根据相应控件的位置、尺寸自动定位四角坐标，一次可完成一个固定宽度矩形的绘制工作，如果需要多种颜色或者具有立体效果的边框，可多次定义画笔颜色，画出连续的多个矩形，通过调整相邻矩形的颜色来实现特殊效果的边框绘制工作；比如在窗体中安放两个按钮, 分别在MOUSEMOVE事件中填加如下代码, 之后每当鼠标移到相应的按钮上时, 相应的按钮就会出现特殊颜色的边框, 当鼠标移到窗口空白处时, 则窗口会出现明显的边线,起到特殊的提示效果;
}
procedure TForm1.Button1MouseMove(Sender: TObject; Shift: TShiftState; x, y: integer);
begin
  form1.repaint;
  form1.canvas.pen.color := clGreen;
  form1.canvas.pen.width := 5;
  form1.canvas.polyline([point(Button1.left, Button1.top),
  point(Button1.left + Button1.width, Button1.top),
  point(Button1.left + Button1.width, Button1.top + Button1.height),
  point(Button1.left, Button1.top + Button1.height),
  point(Button1.left, Button1.top)]);
end;
procedure TForm1.Button2MouseMove(Sender: TObject; Shift: TShiftState; x,y: integer);
begin
  form1.repaint;
  form1.canvas.pen.color := clBlue;
  form1.canvas.pen.width := 5;
  form1.canvas.polyline([point(Button2.left, Button2.top),
    point(Button2.left + Button2.width, Button2.top),
      point(Button2.left + Button2.width, Button2.top + Button2.hei
      ght),
      point(Button2.left, Button2.top + Button2.height),
      point(Button2.left, Button2.top)]);
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; x,y: integer);
begin
  form1.repaint;
  form1.canvas.pen.color := clRed;
  form1.canvas.pen.width := 3;
  form1.canvas.polyline([point(0, 0), point(form1.width -10, 0),
    point(form1.width - 10, form1.height - 30),
    point(0, form1.height - 30), point(0, 0)]);
end;
{
3. 为图形按钮或其它控件安装动态帮助功能, 此处主要使用它的字符串显示功能, 也就是当鼠标移到指定控件上时, 在其周围适当位置显示相应的字符串, 当鼠标离开时通过图像覆盖动作使字符串消失, 也可以使用一个简单的命令完成即form1.repaint, 它的作用是使FORM1内的所有控件全部重新绘制, 这样即可快速清除原来显示的字符; 编程时主要使用各个控件的MouseMove()事件;比如可在窗口中安放两个按钮, 并安排如下代码, 运行之后当鼠标移到相应按钮上时, 就会在其上方显示相应的提示信息, 鼠标移到窗口空白处则会在窗口的左下角显示"OK"字样;
}
procedure TForm1.Button1MouseMove(Sender: TObject; Shift: TShiftState; x, y: integer);
begin
  form1.repaint;
  form1.canvas.brush.color := clGreen;
  form1.canvas.font.size := 8;
  form1.canvas.font.color := $1200FFFF;
  form1.canvas.textout(Button1.left,Button1.top - 15, 'OPENFILE');
end;
procedure TForm1.Button2MouseMove(Sender: TObject; Shift: TShiftState; x, y: integer);
begin
  form1.repaint;
  form1.canvas.font.size := 8;
  form1.canvas.brush.color := clRed;
  form1.canvas.font.color := $1200FFFF;
  form1.canvas.textout(Button2.left, Button2.top -15, 'EXIT');
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; x,y: integer);
begin
  form1.repaint;
  form1.canvas.font.size := 12;
  form1.canvas.brush.color := clBlue;
  form1.canvas.font.color := $00FFFFFF;
  form1.canvas.textout(0, form1.height - 50, 'OK');
end;
{
4. 仿电视移动字幕或图像, 用此方法制作移动字幕的基本方法是:首先选定一个可作为画布
的控件, 比如FORM或IMAGE, 然后用一种填充颜色填满整个画布, 在画布的固定位置显示一个特殊前景色固定尺寸的字符串, 在TIMER控件中定时连续改变显示字符串的位置, 由于原来位置的字符串不能自动消失, 所以需要用与填充颜色相同颜色的线条覆盖多余部分, 这样即可实现平滑的字幕移动效果; 实现图像移动的方法: 可事先定义Bitmap类和Rect类变量,在程序运行阶段建立Bitmap和Rect对象, 并在Bitmap中装入指定的图像文件, 同时把对象Bitmap装入Rect对象中实现图像的显示, 然后在Timer控件中定时连续改变Rect的坐标值, 并用与填充颜色相同的线条覆盖遗留图像部分, 即可以实现图像的平稳移动; 采用上述方法实现的字符串或图像移动操作, 其效果平稳，无任何闪烁或抖动现象，视觉效果极佳，并且不需要事先建立控件，完全由程序代码实现，具有相当多的优点；编程举例: 在窗体中安放时间控件TIMER1、图像框IMAGE1, 定义TRECT及TBITMAP型变量, 并在FormCreate和Timer1Timer事件中安排如下代码,程序运行之后即会在图像框中出现至下而上的移动字幕及图像效果, 并从顶部消失, 之后重新从底部出现;
}
var {定义变量}
  form1: TForm1;
  x, tt, l, h: integer;
  pic: Trect;
  map: TBitmap;
  {具体动画演示代码}
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  x := x - 1;
  tt := tt - 1;
  ifx < -160 then
    x := image1.height + 20;
  tt := x + 80;
  image1.canvas.font.size := 18;
  image1.canvas.font.color := $1200FFFF;
  image1.canvas.textout(10, x, 'OK字幕移动演示');
  image1.canvas.font.size := 12;
  image1.canvas.font.color := $120000FF;
  image1.canvas.textout(20, x + 50, '字体变色效果演示');
  l := image1.canvas.textwidth('字体变色效果演示');
  h := image1.canvas.textheight('字体变色效果演示');
  image1.canvas.pen.color := clGreen;
  image1.canvas.moveto(20, h + x + 50 - 2);
  image1.canvas.lineto(20 + l, h + x + 50 - 2);
  pic.topleft.x := 30;
  pic.topleft.y := tt;
  pic.bottomright.x := pic.topleft.x + 100;
  pic.bottomright.y := pic.topleft.y + 80;
  image1.canvas.stretchdraw(pic, map);
  image1.canvas.pen.color := clGreen;
  image1.canvas.moveto(0, pic.topleft.y + 80);
  image1.canvas.lineto(pic.topleft.x + 100, pic.topleft.y + 80);
end;
{以下设置动画初值}
procedure TForm1.FormCreate(Sender: TObject);
begin
  timer1.enabled := true;
  timer1.Interval := 10;
  x := image1.height + 20;
  tt := x + 80;
  form1.repaint;
  image1.canvas.brush.color := clGreen;
  pic := Rect(0, 0, image1.width, image1.height);
  image1.canvas.FillRect(pic);
  pic := Rect(-1, -1, 1, 1);
  map := TBitmap.create;
  map.loadfromfile('d:/windows/256color.bmp');
  image1.canvas.stretchdraw(pic, map);
end;