神康侠吕

delphi下如何实现动态对象的拖拽- -

                                      

昨天上午写了一个小程序，模仿delphi设计阶段组件的拖拽，实现了动态创建对象的拖拽。首先动态创建三个TLabel对象，并且保存到TList中，分别设置他们的onmousedown，onmouseup和onmousemove事件。

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    lstMyRect : TList;                        //类似于控件数组
    Flag_Dragging : boolean;        
    StartPoint, LastPoint : TPoint;   //记录鼠标按下的点和移动后的点
    NowRect : TRect;                       //组件对象的边框
    procedure PrepareToMove(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);
    procedure Moving(Sender: TObject; Shift: TShiftState; X,
        Y: Integer);
    procedure MoveEnd(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  public
    { Public declarations }
  end;

procedure TForm1.FormCreate(Sender: TObject);
var
    s : string;
    i : integer;
    TempLabel : TLabel;
begin
    Flag_Dragging := False;

    lstMyRect := TList.Create;  //动态创建TLabel对象，并保存
    for i := 0 to 2 do
    begin
        tempLabel := TLabel.Create(Sender as TForm);
        tempLabel.Caption := 'i love you';
        tempLabel.Top := 100 + i * 50;
        tempLabel.Left := 100 + i * 50;
        tempLabel.Parent := Form1;
        tempLabel.OnMouseDown := PrepareToMove;  //设置三个事件
        tempLabel.OnMouseMove := Moving;
        tempLabel.OnMouseUp := MoveEnd;
        lstMyRect.Add(tempLabel);
    end;
end;

当鼠标按下时，记录下开始点，并得到组件对象的边框，在移动的时候给用户以参照，并且把该边框画出

procedure TForm1.PrepareToMove(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
    TmpLabel : TLabel;
begin
    TmpLabel := Sender as TLabel;
    Flag_Dragging := True;
    StartPoint := Point(X, Y);
    LastPoint := Point(X, Y);
    NowRect := Rect(TmpLabel.Left, TmpLabel.Top,
        TmpLabel.Left + TmpLabel.Width, TmpLabel.Top + TmpLabel.Height);
    Form1.Canvas.DrawFocusRect(NowRect);
end;
当鼠标移动的时候，计算出移动的距离，消隐上一个位置的边框，计算新位置的边框并画出

procedure TForm1.Moving(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
    TmpLabel : TLabel;
    Deltax, Deltay : integer;
begin
    TmpLabel := Sender as TLabel;
    if Flag_Dragging then
    begin
        Deltax := X - LastPoint.X;  //计算移动的横纵距离
        Deltay := Y - LastPoint.Y;
        LastPoint := Point(X, Y);   //保存新点
        Form1.Canvas.DrawFocusRect(NowRect);  //消隐上一个位置的边框
        NowRect := Rect(NowRect.Left + Deltax, NowRect.Top + Deltay,
                        NowRect.Right + Deltax, NowRect.Bottom + Deltay);//计算新边框的位置
        Form1.Canvas.DrawFocusRect(NowRect);
    end;
end;

当鼠标放开时，不用再画边框，直接计算释放处与开始处的距离，然后把组件对象移动过来

procedure TForm1.MoveEnd(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
    TmpLabel : TLabel;
    Deltax, Deltay : integer;
begin
    TmpLabel := Sender as TLabel;
    if Flag_Dragging then
    begin
        Flag_Dragging := False;
        LastPoint := Point(X, Y);
        Deltax := LastPoint.X - StartPoint.X;
        Deltay := LastPoint.Y - StartPoint.Y;
        TmpLabel.Top := Deltay + TmpLabel.Top;  //重新设置组件对象的位置
        TmpLabel.Left := Deltax + TmpLabel.Left;
    end;
end;

- 作者： 神康侠吕 访问统计：　2005年09月20日, 星期二 10:22 加入博采