画图是遇到的问题(20分)

  • 主题发起人 主题发起人 845355
  • 开始时间 开始时间
8

845355

Unregistered / Unconfirmed
GUEST, unregistred user!
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Image1.canvas.MoveTo(X,Y);
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Image1.Canvas.LineTo(X,Y);
end;
这样画线的时候,看不到所画的线.画完了放开鼠标,才能看见.怎样才能在画的时候,也能看到所画的线?是不是要再加一个鼠标拖动的过程?
 
当然,不过比较麻烦的是鼠标脱动过程,你要擦掉鼠标轨迹线条。呵呵,很麻烦。并且tcanvas这个东西反映不是那么快,很可能产生虚线。解决办法,没有做过。不过我想api能够解决。值得研究
---------
Delphi编程天地:18600851
 
谁来说说,具体怎么实现的?
 
xor啊,在mousemove里面划线,记录上次的位置,或模式就可以了
 
DelphiTeenS 大哥,说具体点吧. 没办法,谁叫我太菜了!!!!
我将十分感激11111!!!!!!!!!!!
 
呵呵,随手写的代码,楼主看看满足你的要求不?

bb: boolean;
Origin,MovePt,old,new:tpoint;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
bb:=true;
image1.Canvas.Pen.Width :=1;
Image1.Canvas.MoveTo(x,y);
Origin := Point(x,y);
MovePt := Origin;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
bb:=false;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if bb then
begin
DrawShape(Origin, MovePt);
MovePt := Point(x,y);
DrawShape(Origin, MovePt);
end;
end;

procedure TForm1.drawShape(TopLeft, BottomRight: TPoint);
begin
with Image1.Canvas do
begin
Pen.Mode := pmnot;
Pen.Color := clred;
image1.Canvas.Pen.Width :=1;
Image1.Canvas.MoveTo(TopLeft.X, TopLeft.Y);
Image1.Canvas.LineTo(BottomRight.X, BottomRight.Y);
end;
end;
 
每次鼠标拖动时画当前线,并且擦除以前的线即可!
 
啊啊啊啊啊,的程序好象也不行啊
 
关键是擦去上一条线。先定义两个TPoint变量Origin,MovePt,Origin记录点下鼠标的位置,MovePt记录在移动过程中当前位置的上一个位置。

一个画线过程Draw(BeginPt, EndPt: TPoint); 画一条从BeginPt到EndPt的线

MouseDown时Origin和MovePt都赋Point(x,y)

主要是MouseMove过程:

Procedure MouseMove(x, y: Integer);
begin
Pen.mode:=pmNotXOR; //选择画笔模式
Draw(Origin, MovePt); //擦去上一条线
Draw(Origin, Point(x,y)); //画当前线
MovePt:= Point(x, y);
end;

MouseUp时就画一条从Origin到Point(x,y)的线。
 
to Regwolf 我有疑问
如果用mousemove,那么只要移动鼠标就在画线了,并不是拖动后画线
还有 Draw(Origin, MovePt); //擦去上一条线 能实现吗?
 
LineTo的功能是从起点(用MoveTo来定义),画直线到LineTo的参数X,Y
你在mousedown里定义起始位置,再在mouseup里画线,当然要到鼠标左键UP时才能看的到线条了。
你定义一个全局标志位boolean变量,
//在mousedown中MoveTo(x,y),并设定标志位为True;
//在MouseMove中如果标志位为True画线LineTo(x,y);
//画完线后MoveTo(x,y)
//在MousUp中复位标志位为False;
 
To 845355,
啊啊啊啊啊, 都给你代码了,怎么不试一下效果呢?
 
明白你的意思了。写了段完整的程序,可以满足你的要求。用一个枚举型变量MouseStatus记录当前鼠标的状态,如果按下了左键并且鼠标状态为按下状态时才画线。把鼠标动作封装了一个类,如果有更复杂的要求就丰富这个类的过程来实现。

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 FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
public

end;

TMouseAction = Class(TObject) //111111111111111111111
private
Origin, MovePt: TPoint; //111111111111111111111
Canvas: TCanvas;
Public
constructor Create(ACanvas: TCanvas);
procedure MouseDown(x, y: Integer);
procedure MouseMove(x, y: Integer);
procedure DrawLine(BeginPt, EndPt: TPoint);
end;

TMouseStatus = (msUp, msDown); //111111111111111111111111


var
Form1: TForm1;
DMouse: TMouseAction;
MouseStatus: TMouseStatus; //11111111111111111

implementation

{$R *.dfm}

constructor TMouseAction.Create(ACanvas: TCanvas);
begin
Canvas:= Acanvas;
end;

procedure TMouseAction.DrawLine(BeginPt, EndPt: TPoint);
begin
With Canvas do
begin
MoveTo(BeginPt.X, BeginPt.Y);
LineTo(EndPt.X, EndPt.Y);
end;
end;

procedure TMouseAction.MouseDown(x, y: Integer);
begin
Origin.X:= X;
Origin.Y:= Y;
MovePt.X:= X;
MovePt.Y:= Y;
end;

procedure TMouseAction.MouseMove(x, y: Integer);
begin
Canvas.Pen.Mode:= pmNotXOR;
Canvas.Pen.Width:= 1;
DrawLine(Origin, MovePt); //1111111111111111
DrawLine(Origin, Point(x,y)); //1111111111111111
MovePt:= Point(x,y);
end;


procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if(Button<>mbLeft) then exit;
DMouse:= TMouseAction.Create(Form1.Canvas);
DMouse.MouseDown(X,Y);
MouseStatus:= msDown; //11111111111111111
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
MouseStatus:= msUp; //1111111111111111111111
if (DMouse = nil) then exit;

end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if (DMouse<>nil) and (MouseStatus= msDown)then DMouse.MouseMove(X,Y); //1111
end;

end.
 
非常非常感谢Regwolf 的程序!!!!!!!!!!!!!!!!!!!!!!!!!!
 

Similar threads

I
回复
0
查看
734
import
I
I
回复
0
查看
589
import
I
I
回复
0
查看
746
import
I
后退
顶部