udrag.pas

运行时设计控件的一个小例子

//------TDragClass------------------------
unit uDrag;

interface

uses
   Windows, Messages,Classes,SysUtils,Controls,Graphics,uDragPoint,StdCtrls;

type
  //控件的八个点，用于拉动大小
    TPointRec=record
      LeftTop:TDragPoint;
      LeftBottom:TDragPoint;
      RightTop:TDragPoint;
      RightButton:TDragPoint;
      LeftMid:TDragPoint;
      TopMid:TDragPoint;
      RightMid:TDragPoint;
      ButtonMid:TDragPoint;
    end;

    TDragClass = class
    private
      FConList:TList;  //保存控件的列表
      FCurActiveCon:Integer;  //当前活动控件
      FPointRec:TPointRec; //当前控件的边缘的八个小点
      //跳跃式移动的成员
      FisMoveStep:Boolean;
      FMoveStep:integer;
      MoveX,MoveY:integer;
      //控件事件相关的成员
      FConMouseDown:TMouseEvent;
      FConMouseMove:TMouseMoveEvent;
      FConMouseup:TMouseEvent;
      isDown:Boolean;
      prevP,nextP:TPoint;
    protected
      //------- 对移动点的操作 --
      procedure CreateDragPoint(PointParent:TWinControl);
      procedure SetPointPos(posRect:TRect);
      procedure SetPointParent(PointParent:TWinControl);
      procedure SetPointEvent;
      procedure SetCurActiveCon(curCon:Pointer);
      //----------------------
      procedure MoveLeftTopPoint;
      procedure AlignLeftTop;
      procedure MoveLeftBottomPoint;
      procedure AlignLeftBottom;
      procedure MoveRightTopPoint;
      procedure AlignRightTop;
      procedure MoveRightBottomPoint;
      procedure AlignRightBottom;
      procedure MoveLeftMidPoint;
      procedure AlignLeftMid;
      procedure MoveTopMidPoint;
      procedure AlignTopMid;
      procedure MoveRightMidPoint;
      procedure AlignRightMid;
      procedure MoveBottomMidPoint;
      procedure AlignBottomMid;
      procedure reSizeCon;

      //当前控件事件和移动点事件处理------------
      procedure ConMouseDown(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);
      procedure ConMouseMove(Sender: TObject; Shift: TShiftState; X,
        Y: Integer);
      procedure ConMouseUp(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);
      procedure PointMouseDown(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);
      procedure PointMouseMove(Sender: TObject; Shift: TShiftState; X,
        Y: Integer);
      procedure PointMouseUp(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);
      procedure SetisMoveStep(value:Boolean);
      procedure SetMoveStep(value:integer);
    public
      constructor create(PointParent:TWinControl);
      destructor destroy; override;
      function addControl(AddCon:Pointer):Boolean;  //important
      procedure DeleteControl(index : integer);  //  AJ
      procedure SetPointVisible(Visibled:Boolean);
      property isMoveStep:Boolean read FisMoveStep write SetisMoveStep;
      property MoveStep:Integer read FMoveStep write SetMoveStep;
      property SelectControlInex : Integer read FCurActiveCon;
    end;

implementation

Uses CustomUnit;

{ TDragClass }
//----------------------------------------------------------------------------//
constructor TDragClass.create(PointParent:TWinControl);
begin
  inherited Create;
  FConList:= TList.Create;
  FCurActiveCon:=-1;
  isDown:=False;
  FisMoveStep:=False;
  FMoveStep:=5;
  FConMouseDown:=ConMouseDown;
  FConMouseMove:=ConMouseMove;
  FConMouseup:=ConMouseUp;
  CreateDragPoint(PointParent);
  SetPointVisible(false);
  SetPointEvent;
end;

//----------------------------------------------------------------------------//
destructor TDragClass.destroy;
begin
  FreeAndNil(FConList);
  FPointRec.LeftTop.Free;
  FPointRec.LeftBottom.Free;
  FPointRec.RightTop.Free;
  FPointRec.RightButton.Free;
  FPointRec.LeftMid.Free;
  FPointRec.TopMid.Free;
  FPointRec.RightMid.Free;
  FPointRec.ButtonMid.Free;
  inherited;
end;

//----------------------------------------------------------------------------//
//----- 加一个控件进入拖拉类 -------------------------------------------------//
function TDragClass.addControl(AddCon: Pointer): Boolean;
var
  TempCon:TControl;
  R:TRect;
  i:integer;
begin
  result:=True;
  if TControl(AddCon).Parent=nil then begin
    result:=false;
    exit;
  end;
  //如果该控件已经在列表中了，则加入失败
  for i:=0 to FConList.Count-1 do begin
    if Integer(AddCon)=Integer(FConList.Items[i]) then begin
      result:=false;
      exit;
    end;
  end;  
  //将控件加入列表中，并指定当前的控件的索引
  FConList.Add(AddCon);
  FCurActiveCon:= FConList.Count-1;
  TempCon:= TControl(AddCon);
  TempCon.Cursor:=crSizeAll;
  TempCon.Parent.DoubleBuffered:=True;  //使用双缓冲技术
  //折中方案，指定控件鼠标事件
  TButton(TempCon).OnMouseDown:= FconMouseDown;
  TButton(TempCon).OnMouseMove:= FconMouseMove;
  TButton(TempCon).OnMouseUp:= FconMouseUp;
  //画控件周围的八个小点
  R.Left:=TempCon.Left;
  R.Top:=TempCon.Top;
  R.Right:=TempCon.Left+TempCon.Width;
  R.Bottom:=TempCon.Top+TempCon.Height;
  SetPointParent(TempCon.Parent);
  SetPointPos(R);
  SetPointVisible(True);
end;

//----------------------------------------------------------------------------//
//设置八小点的可见性
procedure TDragClass.SetPointVisible(Visibled: Boolean);
begin
  FPointRec.LeftTop.Visible:=Visibled;
  FPointRec.LeftBottom.Visible:=Visibled;
  FPointRec.RightTop.Visible:=Visibled;
  FPointRec.RightButton.Visible:=Visibled;
  FPointRec.LeftMid.Visible:=Visibled;
  FPointRec.TopMid.Visible:=Visibled;
  FPointRec.RightMid.Visible:=Visibled;
  FPointRec.ButtonMid.Visible:=Visibled;
end;

//----------------------------------------------------------------------------//
//设置小点事件
procedure TDragClass.SetPointEvent;
begin
  FPointRec.LeftTop.OnMouseDown:=PointMouseDown;
  FPointRec.LeftTop.OnMouseMove:=PointMouseMove;
  FPointRec.LeftTop.onMouseUp:=PointMouseUp;
  FPointRec.LeftBottom.OnMouseDown:=PointMouseDown;
  FPointRec.LeftBottom.OnMouseMove:=PointMouseMove;
  FPointRec.LeftBottom.onMouseUp:=PointMouseUp;
  FPointRec.RightTop.OnMouseDown:=PointMouseDown;
  FPointRec.RightTop.OnMouseMove:=PointMouseMove;
  FPointRec.RightTop.onMouseUp:=PointMouseUp;
  FPointRec.RightButton.OnMouseDown:=PointMouseDown;
  FPointRec.RightButton.OnMouseMove:=PointMouseMove;
  FPointRec.RightButton.onMouseUp:=PointMouseUp;
  FPointRec.LeftMid.OnMouseDown:=PointMouseDown;
  FPointRec.LeftMid.OnMouseMove:=PointMouseMove;
  FPointRec.LeftMid.onMouseUp:=PointMouseUp;
  FPointRec.TopMid.OnMouseDown:=PointMouseDown;
  FPointRec.TopMid.OnMouseMove:=PointMouseMove;
  FPointRec.TopMid.onMouseUp:=PointMouseUp;
  FPointRec.RightMid.OnMouseDown:=PointMouseDown;
  FPointRec.RightMid.OnMouseMove:=PointMouseMove;
  FPointRec.RightMid.onMouseUp:=PointMouseUp;
  FPointRec.ButtonMid.OnMouseDown:=PointMouseDown;
  FPointRec.ButtonMid.OnMouseMove:=PointMouseMove;
  FPointRec.ButtonMid.onMouseUp:=PointMouseUp;
end;

//----------------------------------------------------------------------------//
//确定控件边缘八个小点的位置
procedure TDragClass.SetPointPos(posRect: TRect);
begin
  FPointRec.LeftTop.Left:=posRect.Left-5;
  FPointRec.LeftTop.Top:=posRect.Top-5;
  FPointRec.LeftBottom.Left:=PosRect.Left-5;
  FPointRec.LeftBottom.Top:=PosRect.Bottom;
  FPointRec.RightTop.Left:=posRect.Right;
  FPointRec.RightTop.Top:=posRect.Top-5;
  FPointRec.RightButton.Left:=PosRect.Right;
  FPointRec.RightButton.Top:=PosRect.Bottom;
  FPointRec.LeftMid.Left:=posRect.Left-5;
  FPointRec.LeftMid.Top:=(posRect.Top+posRect.Bottom) div 2 - 3;
  FPointRec.TopMid.Left:=(posRect.Left+posRect.Right) div 2 -3;
  FPointRec.TopMid.Top:=PosRect.Top-5;
  FPointRec.RightMid.Left:=posRect.Right;
  FPointRec.RightMid.Top:=(posRect.Top+posRect.Bottom) div 2 - 3;
  FPointRec.ButtonMid.Left:=(posRect.Left+posRect.Right) div 2 -3;
  FPointRec.ButtonMid.Top:=PosRect.Bottom;
end;

//----------------------------------------------------------------------------//
//创建八个小点
procedure TDragClass.CreateDragPoint(PointParent:TWinControl);
begin
  FPointRec.LeftTop:=TDragPoint.Create(nil);
  FPointRec.LeftTop.Cursor:= crSizeNWSE;
  FPointRec.LeftBottom:=TDragPoint.Create(nil);
  FPointRec.LeftBottom.Cursor:=crSizeNESW;
  FPointRec.RightTop:=TDragPoint.Create(nil);
  FPointRec.RightTop.Cursor:=crSizeNESW;
  FPointRec.RightButton:=TDragPoint.Create(nil);
  FPointRec.RightButton.Cursor:=crSizeNWSE;
  FPointRec.LeftMid:=TDragPoint.Create(nil);
  FPointRec.LeftMid.Cursor:=crSizeWE;
  FPointRec.TopMid:=TDragPoint.Create(nil);
  FPointRec.TopMid.Cursor:=crSizeNS;
  FPointRec.RightMid:=TDragPoint.Create(nil);
  FPointRec.RightMid.Cursor:=crSizeWE;
  FPointRec.ButtonMid:=TDragPoint.Create(nil);
  FPointRec.ButtonMid.Cursor:=crSizeNS;
  SetPointParent(PointParent);
end;

//------当前控件事件处理-------------------------
//处理点下的事件
procedure TDragClass.ConMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  TempCon:TControl; R:TRect;
begin
  if Button=mbLeft then begin
    isDown:=True;
    GetCursorPos(PrevP);
  end;
   TempCon:=TControl(Sender);
   SetPointParent(TempCon.Parent);
   R.Left:=TempCon.Left;
   R.Top:=TempCon.Top;
   R.Right:=TempCon.Left+TempCon.Width;
   R.Bottom:=TempCon.Top+TempCon.Height;
   MoveX:=0; MoveY:=0;
   SetPointPos(R);
   SetPointvisible(true);
   SetCurActiveCon(TempCon);
end;

//----------------------------------------------------------------------------//
//处理当前控件移动的消息
procedure TDragClass.ConMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  offsetX,offsetY:integer;
  con:TControl;
  R:TRect;
begin
  if isDown and (Shift=[ssLeft]) then begin
     GetCursorPos(nextP);
     offsetX:=NextP.X-PrevP.X;
     offSetY:=NextP.Y-PrevP.Y;
     Con:=TControl(Sender);
     if not FisMoveStep then begin
       Con.Left:=Con.Left+offSetX;
       Con.Top:=Con.Top+offSetY;
     end else begin
       MoveX:=MoveX+offsetX;
       MoveY:=MoveY+offsetY;
       if Abs(MoveX)>=FMoveStep then begin
         Con.Left:=Con.Left+MoveX;
         MoveX:=0;
       end;
       if Abs(MoveY)>FMoveStep then begin
         Con.Top:=Con.Top+MoveY;
         MoveY:=0;
       end;
     end;
     R.Left:=Con.Left;
     R.Top:=Con.Top;
     R.Right:=Con.Left+Con.Width;
     R.Bottom:=Con.Top+Con.Height;
     SetPointPos(R);
     prevP:=nextP;
  end;
end;

//处理当前控件鼠标弹起的消息
procedure TDragClass.ConMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  isDown:=False;
end;

//----------------------------------------------------------------------------//
 //设置八个点的父子关系
procedure TDragClass.SetPointParent(PointParent: TWinControl);
begin
   FPointRec.LeftTop.Parent:=PointParent;
   FPointRec.LeftBottom.Parent:=PointParent;
   FPointRec.RightTop.Parent:=PointParent;
   FPointRec.RightButton.Parent:=PointParent;
   FPointRec.LeftMid.Parent:=PointParent;
   FPointRec.TopMid.Parent:=PointParent;
   FPointRec.RightMid.Parent:=PointParent;
   FPointRec.ButtonMid.Parent:=PointParent;
end;

//----------------------------------------------------------------------------//
//得到当前活动窗口
procedure TDragClass.SetCurActiveCon(curCon: Pointer);
var
  i:integer;
begin
  for i:=0 to FConList.Count-1 do
   if Integer(curCon)=Integer(FConList.Items[i]) then begin
     FCurActiveCon:=i;
     break;
   end;
end;

//----------------------------------------------------------------------------//
//八个小点的处理消息
procedure TDragClass.PointMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button= mbLeft then begin
    moveX:=0; moveY:=0;
    if Sender=FPointRec.LeftTop then begin
      FpointRec.LeftTop.isDown:=True;
      GetCursorPos(FPointRec.LeftTop.PrevP);
    end else if Sender=FPointRec.RightTop then begin
      FpointRec.RightTop.isDown:=True;
      GetCursorPos(FPointRec.RightTop.PrevP);
    end else if Sender=FPointRec.LeftBottom then begin
      FpointRec.LeftBottom.isDown:=True;
      GetCursorPos(FPointRec.LeftBottom.PrevP);
    end else if Sender=FPointRec.RightButton then begin
      FpointRec.RightButton.isDown:=True;
      GetCursorPos(FPointRec.RightButton.PrevP);
    end else if Sender=FPointRec.LeftMid then begin
      FpointRec.LeftMid.isDown:=True;
      GetCursorPos(FPointRec.LeftMid.PrevP);
    end else if Sender=FPointRec.TopMid then begin
      FpointRec.TopMid.isDown:=True;
      GetCursorPos(FPointRec.TopMid.PrevP);
    end else if Sender=FPointRec.RightMid then begin
      FpointRec.RightMid.isDown:=True;
      GetCursorPos(FPointRec.RightMid.PrevP);
    end else if Sender=FPointRec.ButtonMid then begin
      FpointRec.ButtonMid.isDown:=True;
      GetCursorPos(FPointRec.ButtonMid.PrevP);
    end;
  end;
end;

//----------------------------------------------------------------------------//
procedure TDragClass.PointMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Shift=[ssLeft] then begin
    if FPointRec.LeftTop.isDown then begin
     MoveLeftTopPoint;
     reSizeCon
    end else if FPointRec.LeftBottom.isDown then begin
     MoveLeftBottomPoint;
     reSizeCon