在线等待画直线,曲线,矩形等的轨迹问题 ( 积分: 100 )

  • 主题发起人 主题发起人 noelse520
  • 开始时间 开始时间
N

noelse520

Unregistered / Unconfirmed
GUEST, unregistred user!
我用Canvas画直线时,mousemove是无法显示轨迹,只有当mouseup时画出直线,但这样达不到要求,求mousemove时怎么处理?
我尝试过鼠标移动过程中把pen.mode设置成pmxor或pmnot把旧的线条给覆盖掉,但这样问题又出现了,我画矩形时自动用与底色相反的颜色填充,可我的填充色可以随意变换或者选择不填充.
 
找个有mousemove事件的控件,用他的canvas来画,比如form

希望下面这段程序能帮到你

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;

type
TForm1 = class(TForm)
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
dx,dy,ox,oy:integer;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure DrawRect(_Canvas:TCanvas;rect:Trect);
var
OldColor:Tcolor;
OldMode:Tpenmode;
OldStyle:Tpenstyle;
begin
OldColor := _Canvas.Pen.Color;
OldMode := _CanVas.Pen.Mode;
OldStyle := _CanVas.Pen.Style;
_Canvas.Pen.Color:= clBlack;
_CanVas.Pen.Mode := pmMerge;
_CanVas.Pen.Style:= psDot;
_Canvas.DrawFocusRect(rect);
_Canvas.Pen.Color:= OldColor;
_CanVas.Pen.Mode := OldMode;
_CanVas.Pen.Style:= OldStyle;
end;

function SetNewRect(x1,x2,y1,y2:integer):Trect;
begin
if x1<x2 then
begin
result.Left:=x1;
result.Right:=x2;
end
else
begin
result.Left:=x2;
result.Right:=x1;
end;
if y1<y2 then
begin
result.Top:=y1;
result.Bottom:=y2;
end
else
begin
result.Top:=y2;
result.Bottom:=y1;
end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
dx:=x;
ox:=x;
dy:=y;
oy:=y;
DrawRect(Canvas,SetNewRect(x,x,y,y));
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssleft in shift then
begin
DrawRect(Canvas,SetNewRect(dx,ox,dy,oy));
DrawRect(Canvas,SetNewRect(dx,x,dy,y));
ox:=x;
oy:=y;
end;
end;

end.
 
后退
顶部