delphi2007 教程

delphi2007 教程

首页 新随笔 联系 聚合 管理
  1013 Posts :: 0 Stories :: 28 Comments :: 0 Trackbacks
用CANVAS随着鼠标的移动画出矩形 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiMultimedia/html/delphi_20061107153346171.html
我想用CANVAS随着鼠标的移动,在窗体上画出一个从起点到终点的矩形框.我在MOUSEDOWN里记录起点,然后在MOUSEMOVE里从起点到鼠标所在位置画矩形,但是发现画了好多层的矩形,我现在只想从起点到鼠标所在位置画一个矩形,并且随着鼠标的移动而变化,该怎么做呢?如何擦除多余的矩形呢?

没人回答吗?

设定时器,如100ms  
  在OnTimer里执行画图操作,画矩形前清屏

unit   Unit1;  
   
  interface  
   
  uses  
      Windows,   Messages,   SysUtils,   Variants,   Classes,   Graphics,   Controls,   Forms,  
      Dialogs;  
   
  type  
      TForm1   =   class(TForm)  
          procedure   FormMouseDown(Sender:   TObject;   Button:   TMouseButton;  
              Shift:   TShiftState;   X,   Y:   Integer);  
          procedure   FormMouseMove(Sender:   TObject;   Shift:   TShiftState;   X,  
              Y:   Integer);  
      private  
          {   Private   declarations   }  
          FOpt,  
          FCpt:   TPoint;  
          procedure   DrawRectangle(AOpt,   ACpt:   TPoint);  
      public  
          {   Public   declarations   }  
      end;  
   
  var  
      Form1:   TForm1;  
   
  implementation  
   
  {$R   *.dfm}  
   
  procedure   TForm1.DrawRectangle(AOpt,   ACpt:   TPoint);  
  begin  
      With   Canvas   do  
      begin  
          //左垂  
          MoveTo(AOpt.X,   AOpt.Y);  
          LineTo(AOpt.X,   ACpt.Y);  
   
          //右垂  
          MoveTo(ACpt.X,   AOpt.Y);  
          LineTo(ACpt.X,   ACpt.Y);  
   
          //上水  
          MoveTo(AOpt.X,   AOpt.Y);  
          LineTo(ACpt.X,   AOpt.Y);  
   
          MoveTo(AOpt.X,   ACpt.Y);  
          LineTo(ACpt.X,   ACpt.Y);  
      end;  
  end;  
   
  procedure   TForm1.FormMouseDown(Sender:   TObject;   Button:   TMouseButton;  
      Shift:   TShiftState;   X,   Y:   Integer);  
  begin  
      With   Canvas   do  
      begin  
          if   Shift   =   [ssleft]   then  
          begin  
              Canvas.Pen.Mode   :=   pmNot;  
              Canvas.Pen.Color   :=   clRed;  
              FOpt   :=   Point(X,   Y);  
              FCpt   :=   Point(X,   Y);  
              MoveTo(X,   Y);  
              LineTo(X,   Y)  
          end;  
      end;  
  end;  
   
  procedure   TForm1.FormMouseMove(Sender:   TObject;   Shift:   TShiftState;   X,  
      Y:   Integer);  
  begin  
      With   Canvas   do  
      begin  
          if   Shift   =   [ssleft]   then  
          begin  
              DrawRectangle(FOpt,   FCpt);  
              FCpt   :=   Point(X,   Y);  
              DrawRectangle(FOpt,   FCpt);  
              exit;  
   
              MoveTo(FOpt.X,   FOpt.Y);  
              LineTo(FCpt.X,   FCpt.Y);  
              FCpt   :=   Point(X,   Y);  
              MoveTo(FOpt.X,   FOpt.Y);  
              LineTo(FCpt.X,   FCpt.Y)  
          end;  
      end;  
  end;  
   
  end.  
 

建议使用矢量图形组件TCAD  
  http://www.codeidea.com/cn/  
   
 

posted on 2008-11-05 09:37 delphi2007 阅读(570) 评论(0)  编辑 收藏 引用
只有注册用户登录后才能发表评论。