delphi绘图canvas及应用(转）

delphi绘图canvas及应用2010年03月25日 星期四 14:59DELPHI为编程者提供了一个灵活的绘图场所,CANVAS类,在DELPHI中的很多控件都具有此属性,使编程者可以   
在这些控件的表面随心所欲的绘图,这对完善用户界面或者制作一些屏幕特技都有着非凡的作用。
一、CANVAS必备基本知识   
1.具有CANVAS属性的控件  
TBitmap,TComboBox,TDBComboBox,TDBGrid,TDBListBox,TDirectoryListBox,
TDrawGrid,TFileListBox,TForm,THeaderControl,TImage,TListBox,TOutline,
TPaintBox,TPrinter,TStatusBar,TStringGrid等。     
2.CANVAS属性及命令    
rectangle():画矩形
roundrect():画圆角矩形  
arc():画弧线(不填充)    
chord():画弧线(填充)   
pie:画扇形
Ellipse():画圆或椭圆   
polygon():画多边形填充  
polyline():多点连线(不填充)
Pixels():指定固定象素点颜色值  
moveto():指明画线起点     
lineto():指明画线终点

pen.color:定义画笔颜色
pen.width:定义画笔宽度
brush.color:定义填充颜色
textout():在固定位置输出字符串
textwidth:取字符串高度
textheight:取字符串宽度
font.color:指定字体颜色
font.size:指定字体大小

3.使用CANVAS注意事项
    当窗口进行重画时,画布上的图像将消失,比如当窗口进行最小化又重新恢复时，就会引起画布上图像的消失，另外当刚刚运行程序时，窗口也是属于重新绘制，所以如果在绘制窗口之前在画布上绘图

，弹出窗口后将不能显示出图像，比如在TForm1.FormCreate()事件中进行画布绘图操作将是徒劳的，但可以在此事件中进行画布操作的准备工作，比如设置画笔的颜色和宽度等。   
二、CANCAS应用举例  
1.为控件增加阴影或投影效果
    基本原理就是在利用该控件的父控件比如FORM或者其它容器控件的CANVAS,在需要修饰的控件周围适当处填加图像,通过线条及颜色的合理搭配,使控件与周围的图像融为一体,形成特殊的视觉效果,具体

操作时需要根据被修饰控件的TOP、LEFT、WIDTH、HEIGHT等属性，确定需要画线的起点和终点坐标，这样操作无论被修饰控件位置及尺寸如何变化，都可以保证投影及阴影效果完美的实现；比如可在窗口

中建立三个按钮,然后在按钮2和按钮3的CLICK事件中填加如下代码,之后按下按钮2或按钮3即使按钮1形成投影和阴影效果:  
procedure TForm1.Button2Click(Sender:TObject);   
var   
    i:integer;   
begin   
    form1.canvas.pen.width:=1;   
    for i:=0 to 8 do   
    begin   
      form1.canvas.pen.color:=$00a0a0a0;   
      form1.canvas.moveto(Button1.left+Button1.width+i,Button1.top+i);   
      form1.canvas.lineto(Button1.left+Button1.width+i,Button1.top+button1.height+i);   
      form1.canvas.pen.color:=$00606060;   
      form1.canvas.moveto(Button1.left+i,Button1.top+Button1.height+i);   
      form1.canvas.lineto(Button1.left+Button1.width+i,Button1.top+button1.height+i);
    end;   
end;   
procedure TForm1.Button3Click(Sender:TObject);   
var   
    i:integer;   
begin  
    form1.canvas.pen.width:=1;   
    for i:=0 to 8 do   
    begin   
      form1.canvas.pen.color:=$00404040;   
      form1.canvas.moveto(Button1.left+Button1.width+i,Button1.top+8);   
      form1.canvas.lineto(Button1.left+Button1.width+i,Button1.top+button1.height+8);   
      form1.canvas.moveto(Button1.left+8,Button1.top+Button1.height+i);   
      form1.canvas.lineto(Button1.left+Button1.width+8,Button1.top+button1.height+i);
    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.height),   
                           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-35),   
                           point(0,form1.height-35),
                           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;//和背景同底色的字串向上移动1个高度，刚好覆盖上一次的显示内容   
    tt:=tt-1;//图片向上移动一个高度，不会完全覆盖上一次显示的图片，需要添加一条和底色同色的直线覆盖   
    if x<-160 then//所有字符和图片占用的总高度为80+80=160
    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);//StretchDraw(Rect,Bitmap)将图象显示到指定的矩形空间里
    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;

Delphi CANVAS使用三例2010年03月25日 星期四 15:01CANVAS是Delphi的一个对象，它提供了许多诸如显示器、打印机等输出设备上进行图形显示的方法和属性。CANVAS封装了Windows的图形设备接口GDI，GDI是Windows中图形显示的最基本工具，但与GDI直接通信是一件麻烦事。Delphi的TCANVAS内封了GDI的复杂性，为程序员提供了一个相对简单一致而又易于使用的接口，利用TCANVAS我们能实现以往要调用复杂的Windows API 才能完成的功能。笔者在使用CANVAS对象过程中，积累了一些心得，愿与大家共享。

一、 用CANVAS实现渐近色画面
大家对某些多媒体软件中的渐近色画面印象都很深，这种渐近色实际上是通过用颜色连续变化的线条或填充矩形来填满部分或整个画面而形成的。在Delphi中，借助CANVAS对象，定义好CANVAS的BRUSH大小和颜色，用填充矩形进行填充即可形成渐近效果。下面的代码执行的效果是表单从左到右颜色由黑色渐变为红色。
procedure TForm1.FormPaint(Sender: TObject);
var
   w,r:integer;
begin
   w:=(clientwidth+255) div 256;
   for r:=0 to 255 do
   begin
     canvas.Brush.color:=rgb(r,0,0); {只改变红色分量}
     canvas.fillrect(rect(r*w,0,(r+1)*w,clientwidth));
   end;
end;

需要注意的是，对表单的OnSize事件而言，要将其过程段也指向表单的FormPaint过程，因为当表单尺寸改变时，表单需要刷新。

二、用CANVAS实现动画显示
下面的位图表示一只羊旋转的动作，该动作由8个占40×40点阵的状态组成，下面的定时器时间的代码就是要让小羊动起来。
代码中imgdest和imgsource为两个Image 控件的名字。在imgdest中装入了上面提到的位图作为源，其Visible属性为false；imgdest则作为目的位图进行动画显示，高度和宽度均设为40。计时器的时间间隔设为100毫秒。
procedure TForm1.Timer1Timer(Sender: TObject);
begin
   imgdest.canvas.copyrect(rect(0,0,40,40),
   imgsource.canvas,rect(tag*40,0,tag*40+40,40));
   if tag=7 then {动作状态编号从零开始，一共有8个状态}
     tag:=0
   else
     tag:=tag+1; {用表单的tag属性表示动作状态，初始值为0}
   imgdest.refresh; {刷新图像}
end;

三、 用CANVAS实现特技显示
由于Delphi直接封装了Windows API ，而CANVAS又封装了Windows的设备环境，因此在Delphi中可以直接调用BitBlt等API函数进行图形图像的显示。BitBlt函数能将源设备中的矩形区域按指定操作模式复制到目的设备相应的矩形区域中。

下面的程序先用随机函数产生每页的行数，作为每页高度，然后从顶端开始以lines作为增量，将源图的数据显示在目的图的显示区域，依次循环便形成了从上至下的百页窗效果，源图尺寸越大，效果越明显。

procedure TForm1.Button1Click(Sender: TObject);
var
   i,j,lines,h,w:integer;
   pdest,psour:hbitmap;
begin
   psour:=image1.canvas.handle; {源图句柄}
   pdest:=image2.canvas.handle; {目的图句柄}
   h:=image1.picture.Height;
   w:=image1.picture.width;
   image2.canvas.FillRect(rect(0,0,w,h)); {先将目的图清空}
   randomize;
   lines:=3+random(10);
   for i:=0 to lines －1 do
   begin
     j:=i;
     while (j<=h) do
     begin
       bitblt(pdest,0,j,w,i,psour,0,j,srccopy);
       j:=j+lines;
       image2.refresh;
     end;
   end;
end;

Delphi中关于Canvas.TextOut的用法2010年03月25日 星期四 15:04我想让字符串在Canvas上显现出来，但不知道如何改变字底边的颜色，想变成透明或其它色彩都行，
只是希望所输出的字符串不会影响到Canvas里边的图形。请问前辈们让如何做呢？

Canvas.Font.Color:=clblue;//字体颜色
//Canvas.Brush.Color:=clred;//底色
Canvas.Brush.Style := bsClear;//透明
canvas.textout(0,0,'avalokita');

拉两个 TImage
procedure TfrmMain.FormCreate(Sender: TObject);
begin
Image1.Canvas.Brush.Color := clBlack;
Image1.Canvas.FillRect(Image1.ClientRect);
Image1.Canvas.Font.Color := clRed;
Image1.Canvas.Font.Name := 'Times New Roman';
Image1.Canvas.Font.Size := 18;
Image1.Canvas.TextOut(9, 36, 'Delphi');
end;

// 水平转
procedure TfrmMain.Button1Click(Sender: TObject);
var
i: integer;
begin
for i := 1 to Image1.Width do
BitBlt(Image2.Canvas.Handle, i, 0, 1, Image2.Height,
Image1.Canvas.Handle, Image1.Width - i, 0, SRCCOPY);

Image2.Refresh;
end;

// 垂直转
procedure TfrmMain.Button2Click(Sender: TObject);
var
i: integer;
begin
for i := 1 to Image1.Height do
BitBlt(Image2.Canvas.Handle, 0, i, Image2.Width, 1,
Image1.Canvas.Handle, 0, Image1.Height - i, SRCCOPY);

Image2.Refresh;
end;
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

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()事件中进行画布绘图操作将是徒劳的，但可以在此事件中进行画布操作的准备工作，比如设置画笔的颜色和宽度等。

procedure TForm1.SpeedButton5MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if Sender is Tspeedbutton then
begin
statusbar1.canvas.Brush.Color:=clwhite;
statusbar1.canvas.fillRect(statusbar1.Canvas.ClipRect);//清空画布
statusbar1.Panels[0].Style:=psOwnerDraw;
statusbar1.Canvas.font.Color:=clred;//字体颜色
statusbar1.Canvas.Brush.Color:=clblue;//底色
statusbar1.Canvas.brush.style:=bsclear; //透明
statusbar1.Canvas.TextOut(0,5,'This is sample'); //定位x,y坐标轴及输入文字
end;
end;

Canvas.Brush.Style:=bsclear 可以去掉字体的背景

delphi canvas 边界问题 作图画布大小2010年03月25日 星期四 15:05各位大侠： 您们好
一个问题想了很长时间，没有解决，请求帮助！
我用canvas 在form 上画东东，可以form 的界面上不够我显示得，如果有个滚动条就好了，能将要画的东西
显示出来，我请教一个写c的朋友，他说他是这样就得，在form 上加个form 我没办法就出来，能不能指点我
用什么方法将内容都能显示出来，谢谢

/////////////////////////

在Form上面放个Panel或者PaintBox,在Form.onShow上面加入Panel1.Width := 1500;Panel1.Height := 1500;
滚动条自己会出来,你想要多大都可以,在Panel或者PaintBox的Canvas上画一样可以,

///////////////////

首先在Form上加个TScrollBox（在additional面板里），然后再在TScrollBox里面加个TImage。

OK，设置TImage的大小就可以用滚动的方式浏览了。

/////////////////////

image1

ScrollBox1

procedure TForm1.FormCreate(Sender: TObject);
begin
Image1.Picture.Bitmap.Width := 1000;
Image1.Picture.Bitmap.Height := 1000;
Image1.AutoSize := True;

Image1.Picture.Bitmap.Canvas.Font.Size := 150;
Image1.Picture.Bitmap.Canvas.TextOut(10, 10, 'Zswang 路过！');
end;

////////////////////////
Delphi 对汉字字符串的截取问题2010年03月25日 星期四 15:24在Delphi中，用Length来取字符长度时，会将汉字当成两个字节来计算，Copy把汉字当成两个来处理，可能截取半个汉字，那我们如何知道是否取的是汉字呢？是否把一个汉字取完整了呢？

其实，可以用ByteType对取出来的字符进行判断是一个单字符还是汉字的一部分！
mbLeadByte: 汉字的第一个字节
mbTrailByte: 汉字的第二个字节
mbSingleByte: 单个的字符，不是中文字符。
如果Copy出来的是汉字的第一个字节，就再多(或少)Copy一个，凑成完整的汉字。
如下例：

function GetText(strtxt:string;iLen:integer):string;
begin
//先判断要截取的字符串最后一个字节的类型
//如果为汉字的第一个字节则减(加)一位
if ByteType(strtxt,iLen) = mbLeadByte then
iLen := iLen - 1;

result := copy(strtxt,1,iLen) + "...";
end