读书人

如何在paintbox里实现鼠标拖拽画矩形的

发布时间: 2013-01-18 10:22:42 作者: rapoo

怎么在paintbox里实现鼠标拖拽画矩形的操作?
我要的效果就和在Windows的桌面上按下鼠标左键然后就会随着鼠标的移动产生一个矩形的方框一样。一定是要随着鼠标的移动一起产生。
[解决办法]
如下代码,pb是个paintbox,ptOld为全局TPoint变量,rOld为全局TRect变量:


procedure TForm1.pbMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ptOld.X:=X;
ptOld.Y:=Y; //这里矩形的起点
pb.Canvas.Brush.Style:=bsClear;
pb.Canvas.Pen.Style:=psDot;
pb.Canvas.Pen.Mode:=(pmXor);
pb.Canvas.Pen.Color:=clRed; //花红色矩形,空心
rOld:=Rect(0,0,0,0);
end;

procedure TForm1.pbMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if not (ssLeft in Shift) then exit;
pb.Canvas.Rectangle(rOld); //清除上一个矩形
pb.Canvas.Rectangle(ptOld.X,ptOld.Y,X,Y); //花当前矩形
rOld:=Rect( ptOld.X,ptOld.Y,X,Y);
end;

procedure TForm1.pbMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
pb.Canvas.Pen.Style:=psSolid; //当鼠标抬起时把那个矩形画入paintbox
pb.Canvas.Pen.Mode:=pmCopy;
pb.Canvas.Rectangle(rOld);
end;

[解决办法]
我有这样的例子,还可以拖动矩形、改变矩形的大小,需要的话留下email,我发给我。
[解决办法]
LZ再理一下。。。


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Menus, cxLookAndFeelPainters, cxButtons, Buttons;

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
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
{ Public declarations }
end;

var
Form1: TForm1;
cx,cy:Integer;
md:Boolean;



implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.DoubleBuffered:=true;
md:=false;

end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
md:=true;
cx:=x;
cy:=y;
end;

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


end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if md then
begin
Form1.Canvas.Rectangle(cx,cy,X,Y);
end;
end;

end.


[解决办法]
记住按下鼠标时的坐标,然后在鼠标move事件里面得到当前坐标,将两个坐票以矩形画出来即可,理论就是这样。楼上各位已经给出代码。不过如果仅是做做样子,那么还要注意清除问题。

读书人网 >.NET

热点推荐