顶
没人回答吗?
设定时器,如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/