● Delphi中画布应用技巧 - 荔园在线 | 深圳大学学生论坛,荔园晨风BBS,深大在线网站

荔园之美，在春之萌芽，在夏之绽放，在秋之收获，在冬之沉淀

发信人: Peter (小飞侠), 信区: Program
标  题: Delphi中画布应用技巧
发信站: BBS 荔园晨风站 (Thu Jan 21 23:12:22 1999), 转信

    Delphi为编程者提供了一个灵活的绘图属性,即CANVAS(画布)类,
Delphi中的很多控件都具有此属性,编程者可以在这些控件的表面随
心所欲地绘图。下面举例说明几种特殊屏幕效果的形成过程。

    CANVAS必备基本知识

    1.具有CANVAS属性的控件
    具有CANVAS属性的控件有:TBitmap,TComboBox,TDBComboBox,TDB
Grid,TDBListBox,TDr ectoryListBox,TDrawGrid,TFileListBox,TFo
rm,THeaderControl,TImage,TListBox,TOuli ne,TPaintBox,TPrinte
r,TStatusBar,TStringGrid等。
    2.CANVAS属性及命令
    由于篇幅所限,省略参数及格式说明,具体请参考文后程序及Delp
hi帮助文件,下面只列出函数名。
    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()事件中进行
画布绘图操作将是徒劳的,但可以在此事件中进行画布操作的准备工
作,比如设置画笔的颜色和宽度等。

    CANVAS应用举例

    1.为控件增加阴影或投影效果:
    基本原理是利用该控件的父控件比如FORM或者其它容器控件的CA
NVAS,在需要修饰的控件周围适当处填加图像,通过线条及颜色的合理
搭配使控件与周围的图像融为一体,形成特殊的视觉效果。具体操作
时需要根据被修饰控件的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;
    for i:=0 to 8 do
    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.heigh+ y);
    form1.canvas.pen.color:=$00606060;
    form1.canvas.moveto(Button1.left+x,Button1.top+Button1.h
eight+y);
    form1.canvas.lineto(Button1.left+Button1.width+x,Button1
..top+button1.heigh+ 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;
    for i:=0 to 8 do
    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.heigh+ 8);
    form1.canvas.moveto(Button1.left+8,Button1.top+Button1.h
eight+y);
    form1.canvas.lineto(Button1.left+Button1.width+8,Button1
..top+button1.heigh+ y);
    x:=x+1;
    y:=y+1;
    end;
    end;

    2.为控件加上边框
    Delphi中有很多控件无边框属性,利用CANVAS可以为任意控件填
加边框,使其轮廓清楚。具体操作时,可先定义出画笔的颜色、画笔的
宽度(边框宽度),然后用polyline()命令根据相应控件的位置、尺寸
自动定位四角坐标,一次可完成一个固定宽度矩形的绘制工作。如果
需要多种颜色或者具有立体效果的边框,可多次定义画笔颜色,画出连
续的多个矩形,通过调整相邻矩形的颜色来实现特殊效果的边框绘制
工作。比如在窗体中安放两个按钮,分别在MOUE MOVE事件中填加如下
代码,每当鼠标移到相应的按钮上时,该按钮就会出现特殊颜色的边框
; 当鼠标移到窗口空白处时,则窗口会出现明显的边线,起到特殊的提
示效果。
    procedure TForm1.Button1MouseMove(Sender:TObject; Shift:
TShiftState; X,Y:It eger);
    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.hei
ght),
    point(Button1.left,Button1.top+Button1.height),
    point(Button1.left,Button1.top)]);
    end;
    procedure TForm1.Button2MouseMove(Sender:TObject; Shift:
TShiftState; X,Y:In teger);
    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.widthButton2.top+But
    Delphi中画布应用技巧
    point(Button2.left,Button2.top+Button2.height),
    point(Button2.left,Button2.top)]);
    end;
    procedure TForm1.FormMouseMove(Sender:TObject; Shift:TSh
iftState; X, Y:Inte ger);
    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.heig
ht-30),point(0,0)]
    end;

    3.为图形按钮或其它控件安装动态帮助功能
    此处主要使用CANVAS的字符串显示功能,即当鼠标移到指定控件
上时,在其周围适当位置显示相应的字符串;当鼠标离开时通过图像覆
盖动作使字符串消失,也可以使用一个简单的命令完成即form1.repai
nt,它的作用是使FORM1内的所有控件全部重新绘制,从而快速清除原
来显示的字符。控件的 MouseMove()事件可以实现以上功能。比如可
在窗口中安放两个按钮并安排如下代码,运行之后当鼠标移到相应按
钮上时,就会在其上方显示相应的提示信息,鼠标移到窗口空白处则会
在窗口的左下角显示"OK"字样。
    procedure TForm1.Button1MouseMove(Sender:TObject;Shift:T
ShiftState;X, Y:Ine ger);
    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,‘OPEN
FILE’);
    end;
    procedure TForm1.Button2MouseMove(Sender:TObject;Shift:T
ShiftState;X,Y:Inte ger);
    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:TShi
ftState;X, Y:Intege r);
    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.仿电视移动字幕或图像
    用CANVAS属性制作移动字幕的基本原理是:首先选定一个可作为
画布的控件,比如 FOR或IMAGE,然后用一种填充颜色填满整个画布,在
画布的固定位置显示一个具有特殊前景的色固定尺寸的字符串,在 TI
MER控件中定时连续改变显示字符串的位置。由于原来位置的字符串
不能自动消失,所以需要用与填充颜色相同颜色的线条覆盖多余部分,
实现平滑的字幕移动效果。实现图像移动的方法:事先定义Bitmap类
和Rect类变量,在程序运行阶段建立Bitmap和R ect对象,并在Bitmap
中装入指定的图像文件,同时把对象Bitmap装入Rect对象中,实现图像
的显示。在Timer 控件中定时连续改变Rect的坐标值,并用与填充颜
色相同的线条覆盖遗留图像部分,实现图像的平稳移动。采用上述方
法实现的字符串或图像移动操作,其效果平稳无任何闪烁或抖动现象,
视觉效果很好,并且不需要事先建立控件,完全由程序代码实现。
    编程举例:在窗体中安放时间控件TIMER1、图像框IMAGE1,定义TR
ECT及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;
    if x<-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;
    以上方法及程序在Windows 95、Delphi2.0环境下调试通过

--
※ 来源:．BBS 荔园晨风站 bbs.szu.edu.cn．[FROM: 192.168.1.3]

荔园在线首页友情链接：深圳大学深大招生荔园晨风BBS S-Term软件网络书店