怎么在paintbox里实现鼠标拖拽画矩形的操作？

Question

我要的效果就和在Windows的桌面上按下鼠标左键然后就会随着鼠标的移动产生一个矩形的方框一样。一定是要随着鼠标的移动一起产生。

Answer 1

如下代码，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;

Answer 2

我有这样的例子，还可以拖动矩形、改变矩形的大小，需要的话留下email，我发给我。

Answer 3

LZ再處理一下
unit Unit1;interfaceuses
  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.

Answer 4

[email protected]   谢谢！

Answer 5

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;bluekitty的这段代码中用到了两次Rectangle，怎么第一次是清除上一个矩形啊，不太明白

Answer 6

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

Answer 7

taxi你好： 我是delphi的初学者，对这方面很想学习学习，请给我发一份拖动矩形、改变矩形的大小的例子吧多谢了，地址是 email：[email protected] 我想了解在Image控件上通过鼠标的拖拽画出的矩形，并可以移动和改变大小，移动后还能知道矩形的具体位置坐标，急等！！！

Answer 8

我这里也弄来一份。可以拖拽，调整大小，话说楼主taoran12太逊了，我问他要代码居然不给，说什么有其他代码，扣不出来，喷一下楼主。