您现在的位置:首页 >> VCL >> VCL >> 内容

谈VCL中DragDrop功能的底层实现

时间:2011-9-3 16:27:20 点击:

  核心提示:一、与DragDrop操作相关的属性、事件、函数 VCL的DragDrop功能是在TControl类中现的,因此所有从TControl类派生出来的控件类者继承了这些属性、事件和函数,包括: 属性:Dr...
一、与DragDrop操作相关的属性、事件、函数

  VCL的DragDrop功能是在TControl类中现的,因此所有从TControl类派生出来的控件类者继承了这些属性、事件和函数,包括:

  属性:DragCursor: Drag时的鼠标类型:(TCursor);
     DragKind:  Drag的类型:(dkDrag, dkDock);
     DragMode:  Drag的方式:手动(dmManual)或自动(dmAutomatic);

  事件:OnStartDrag:Drag开始事件;
     OnDragOver: Drag经过某个控件;
     OnDragDrop: Drag到某个控件并放开;
     OnEndDrag: Drag动作结束;

  函数:BeginDrag:  开始控件的Drag动作;
     Dragging:   返回控件是否正被Dragging;
     CancelDrag:  取消正在执行的Drag操作;
     EndDrag:   结束正在执行的Drag操作,与CancelDrag不同,EndDrag允许操作指定是否产生Drop操作(由Drop参数决定)。

  此外还有一些与DragDrop相关的函数,在随后的介绍中将逐一说明。



  二、DragDrop操作产生与执行的过程


  1、自动产生过程。

  我们知道在控件上单击鼠标左键时便会产生WM_LBUTTONDOWN消息,TControl类的WinProc消息处理方法捕捉到该消息时,便判断控件的DragMode是否为dmAutomatic,即是否自动执行DragDrop操作,如果是则调用类保护函数BeginAutoDrag,立即进入DragDrop状态,详见下面代码:

  procedure TControl.WndProc(var Message: TMessage);
  begin
   ...
   case Message.Msg of
   WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
    begin     
     if FDragMode = dmAutomatic then
     begin
      BeginAutoDrag;  // 进行DragDrop操作
      Exit;
     end;
     Include(FControlState, csLButtonDown);
    end;
   ...
   else ... end;
   ...
  end;

  procedure TControl.BeginAutoDrag;
  begin
   BeginDrag(Mouse.DragImmediate, Mouse.DragThreshold);
  end;


  从上面代码可知它只是简单的调用了BeginDrag函数,具体开始DragDrop是由BeginDrag函数执行的。


  2、手动产生过程。

  当DragMode为dmManual时,将由程序在代码中显式调用BeginDrag方法产生。如:

  procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
  begin
   Panel1.BeginDrag(True, -1);
  end;


  3、BeginDrag函数

  分析前请先留意在 Controls 单元中声明的几个全局变量:
  var
   DragControl: TControl;     // 被Drag的控件
   DragObject: TDragObject;    // 管理整个DragDrop过程的TDragObject对象
   DragInternalObject: Boolean;  // TDragObject对象是否由内部创建
   DragCapture: HWND;       // 管理DragDrop过程的Wnd实例句柄
   DragStartPos: TPoint;     // Drag开始时的鼠标位置
   DragSaveCursor: HCURSOR;    // Drag开始的的鼠标类型
   DragThreshold: Integer;    // Drag操作延迟位置
   ActiveDrag: TDragOperation;  // 正在执行的Drag操作:(dopNone, dopDrag, dopDock);
   DragImageList: TDragImageList; // Drag过程中代替鼠标显示的图像列表


  BeginDrag的函数原型声明为:
  procedure BeginDrag(Immediate: Boolean; Threshold: Integer = -1);

  参数:
  Immediate:是否直接进入DragDrop状态;
  Threshold:若Immediate参数为False,当鼠标移动量超过Threshold给出的值时进入DragDrop状态;

  且先看其实现代码:
  procedure TControl.BeginDrag(Immediate: Boolean; Threshold: Integer);
  var
   P: TPoint;
  begin
   // DragDrop操作的对象不允许是窗体

   if (Self is TCustomForm) and (FDragKind <> dkDock) then
    raise EInvalidOperation.CreateRes(@SCannotDragForm);

   // 前面提过暂且不讨论DragDock相关部分,所以对CalcDockSizes的函数调用不作分析。
   CalcDockSizes;


   // DragControl 不为 nil 或 Pointer($FFFFFFFF) 说明已经进入了DragDrop状态
   // 这里的判断避免了递归调用

   if (DragControl = nil) or (DragControl = Pointer($FFFFFFFF)) then
   begin
    DragControl := nil; 

    // 如果被Drag控件处于鼠标按下状态(如前面的手动产生方式)时应先清除其状态
    //
    if csLButtonDown in ControlState then
    begin
     GetCursorPos(P);
     P := ScreenToClient(P);
     Perform(WM_LBUTTONUP, 0, Longint(PointToSmallPoint(P)));
    end;

    { 如果传递的Threshold变量小于0,则使用系统默认的值 }
    if Threshold < 0 then
     Threshold := Mouse.DragThreshold;
    
    // 以Pointer($FFFFFFFF)为标志防止在BeginDrag中调用EndDrag
    if DragControl <> Pointer($FFFFFFFF) then
     DragInitControl(Self, Immediate, Threshold); // !!!!!!
   end;

  end;


  在BeginDrag的最后一行代码,由TControl类转入全局函数DragInitControl中。函数DragInitControl、DragInit、DragTo、DragDone共同组成了DragDrop核心与VCL类的交互接口。


  4、DragInitControl、DragInit函数

  DragInitControl函数接收了BeginDrag函数的Immediate和Threshold参数,还多了一个Control参数,该参数但是被Drag的控件。下面来看DragInitControl函数的实现代码:

  procedure DragInitControl(Control: TControl; Immediate: Boolean; Threshold: Integer);
  var
   DragObject: TDragObject;
   StartPos: TPoint;
  begin
   DragControl := Control;
   try
    DragObject := nil;
    DragInternalObject := False;  
    if Control.FDragKind = dkDrag then
    begin
     Control.DoStartDrag(DragObject);  // 产生StartDrag事件
     if DragControl = nil then Exit;
     if DragObject = nil then
     begin
      DragObject := TDragControlObjectEx.Create(Control);
      DragInternalObject := True;
     end
    end
    else begin
     ...  // DragDock控件部分
    end;
    DragInit(DragObject, Immediate, Threshold);
   except
    DragControl := nil;
    raise;
   end;
  end;

  DragInitControl函数只是简单地进行一些判断然后调用TControl的DoStartDrag函数(该函数产生的OnStartDrag事件)并创建TDragControlObjectEx对象,就直接进入了DragInit函数,也就是真正由VCL控件类进入DragDrop管理核心的部分。
  TDragControlObjectEx的内部保存了被Drag的控件及执行DragDrop的所需的其他参数,该类的实现及内部功能我们稍候再介绍。


  DragInit函数接收的实现代码:

  procedure DragInit(ADragObject: TDragObject; Immediate: Boolean; Threshold: Integer);
  begin
   // 在全局变量中保存参数
   DragObject := ADragObject;
   DragObject.DragTarget := nil;
   GetCursorPos(DragStartPos);
   DragObject.DragPos := DragStartPos;
   DragSaveCursor := Windows.GetCursor;

   // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

   DragCapture := DragObject.Capture;      // 启动DragDrop管理核心

   // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

   DragThreshold := Threshold;

   if ADragObject is TDragDockObject then
   begin
    ...     // DragDock控制部分
   end
   else begin
    if Immediate then ActiveDrag := dopDrag  // 直接进入DragDrop操作
    else ActiveDrag := dopNone;
   end;

   // -> 以下部分可以忽略
   DragImageList := DragObject.GetDragImages;
   if DragImageList <> nil then
    with DragStartPos do DragImageList.BeginDrag(GetDeskTopWindow, X, Y);
   QualifyingSites := TSiteList.Create;
   // <-

   if ActiveDrag <> dopNone then DragTo(DragStartPos);  
  end;


  到此,便完全由TDragControlObjectEx(由全局变量DragObject保存)控制整个DragDrop操作;当DragObject检测到鼠标移动消息(WM_MOUSEMOVE)时,便会调用DragTo函数;DragTo函数查找鼠标所在位置的VCL控件,并产生DragOver事件。 

5、DragTo函数


  procedure DragTo(const Pos: TPoint);

   function GetDropCtl: TControl;
   begin
    ...
   end;

  var
   DragCursor: TCursor; //
   Target: TControl;   // 鼠标所在位置(Pos)的VCL控件
   TargetHandle: HWND;  // 控件的句柄
   DoErase: Boolean;   // 是否执行擦除背景操作
  begin
   // 只有当Drag操作为dopDrag或dopDock,或鼠标移动量大于Threshold(传递给BeginDrag的值)时,
   // 才执行后面的操作
   if (ActiveDrag <> dopNone) or (Abs(DragStartPos.X - Pos.X) >= DragThreshold) or
    (Abs(DragStartPos.Y - Pos.Y) >= DragThreshold) then
   begin

    // 查找鼠标当前位置的VCL控件
    Target := DragFindTarget(Pos, TargetHandle, DragControl.DragKind, DragControl);

    // ->
    // 如果尚未开始Drag,则初始化图像列表为Dragging状态
    if (ActiveDrag = dopNone) and (DragImageList <> nil) then
     with DragStartPos do DragImageList.BeginDrag(GetDeskTopWindow, X, Y);
    // <-

    if DragControl.DragKind = dkDrag then
    begin
     ActiveDrag := dopDrag;
     DoErase := False;    // Drag操作只改变鼠标形状,不需要迫擦除移动框的背景
    end
    else begin
     ...
    end;

    // 如果鼠标位置移动前后所在的VCL控件不同

    if Target <> DragObject.DragTarget then
    begin
     DoDragOver(dmDragLeave);      // 原来的控件产生DragOver(dmDragLeave[离开])事件
     if DragObject = nil then Exit;
     DragObject.DragTarget := Target;
     DragObject.DragHandle := TargetHandle;
     DragObject.DragPos := Pos;
     DoDragOver(dmDragEnter);      // 新位置的控件产生DragOver(dmDragEnter[进入])事件
     if DragObject = nil then Exit;
    end;

    // 计算Drag的当前位置
    DragObject.DragPos := Pos;
    if DragObject.DragTarget <> nil then
     DragObject.DragTargetPos := TControl(DragObject.DragTarget).ScreenToClient(Pos);


    // 获取Drag操作的鼠标形状
    // 注意GetDragCursor的参数,它的参数正在DragOver(dmDragMove[移动])事件的返回值
    DragCursor := TDragObject(DragObject).GetDragCursor(DoDragOver(dmDragMove),
     Pos.X, Pos.Y);

    //-〉 可以暂时忽略
    if DragImageList <> nil then
    begin
     if (Target = nil) or (csDisplayDragImage in Target.ControlStyle) then
     begin
      DragImageList.DragCursor := DragCursor;
      if not DragImageList.Dragging then
       DragImageList.BeginDrag(GetDeskTopWindow, Pos.X, Pos.Y)
      else DragImageList.DragMove(Pos.X, Pos.Y);
     end
     else begin
      DragImageList.EndDrag;
      Windows.SetCursor(Screen.Cursors[DragCursor]);
     end;
    end;
    // 〈-

    Windows.SetCursor(Screen.Cursors[DragCursor]);

    if ActiveDrag = dopDock then
    begin
     ...   // DragDock相关部分
    end;
   end;
  end;

  从代码中,我们可以看出DragTo函数的工作分为两个部分:一是判断是否已经进入了Drag状态中,否则检查是否满足进入Drag状态的条件;二是查找鼠标当前位置的VCL控件,判断鼠标前后位置所在的VCL控件,并产生相应的事件。


  当DragObject检测到鼠标放开消息(WM_LBUTTONUP, WM_RBUTTONUP)或ESC键按下消息(CN_KEYDOWN + K_ESCAPE)时,调用DragDone函数结束Drag操作。


  6、DragDone函数

  DragDone函数接收一个Drop参数,该参数指明是否使目标控件产生DragDrop事件

  procedure DragDone(Drop: Boolean);

   // -> DragDock相关部分
   function CheckUndock: Boolean;
   begin
    Result := DragObject.DragTarget <> nil;
    with DragControl do
     if Drop and (ActiveDrag = dopDock) then
      if Floating or (FHostDockSite = nil) then
       Result := True
      else if FHostDockSite <> nil then
       Result := FHostDockSite.DoUnDock(DragObject.DragTarget, DragControl);
   end;
   // <-

  var
   DockObject: TDragDockObject;
   Accepted: Boolean;       // 目标控件是否接受DragDrop操作
   DragMsg: TDragMessage;
   TargetPos: TPoint;       //
   ParentForm: TCustomForm;
  begin
   DockObject := nil;
   Accepted := False;

   // 防止递归调用
   // 检查DragObject的Canceling属性,如为真则直接退出
   if (DragObject = nil) or DragObject.Cancelling then Exit;

   try
    DragSave := DragObject;          // 保存当前DragDrop控制对象
    try
     DragObject.Cancelling := True;      // 设置Cancelling标志,表示正在执行DragDone操作
     DragObject.FDropped := Drop;       // 在目标控件上释放标志

     // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     DragObject.ReleaseCapture(DragCapture); // 停止DragDrop管理核心
     // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

     if ActiveDrag = dopDock then
     begin
      ...    // DragDock相关部分
     end;

     // 取得Drag的位置
     if (DragObject.DragTarget <> nil) and
      (TObject(DragObject.DragTarget) is TControl) then
      TargetPos := DragObject.DragTargetPos
     else
      TargetPos := DragObject.DragPos;

     // 目标控件是否接受Drop操作
     // 当Drag操作为dopDrag时,目标控件产生DoDragOver(dmDragLeave[离开])事件
     // 若传递给DragDone的Drop参数为False时,Accepted恒为False
     Accepted := CheckUndock and
      (((ActiveDrag = dopDock) and DockObject.Floating) or
      ((ActiveDrag <> dopNone) and DoDragOver(dmDragLeave))) and
      Drop;

     if ActiveDrag = dopDock then
     begin
      ... // DragDock相关操作
     end
     else begin
      // ->
      if DragImageList <> nil then DragImageList.EndDrag
      else Windows.SetCursor(DragSaveCursor);
      // <-
     end;

     DragControl := nil;
     DragObject := nil;

     if Assigned(DragSave) and (DragSave.DragTarget <> nil) then
     begin
      DragMsg := dmDragDrop;     // 产生DragDrop事件
      if not Accepted then      // 如果Accepted为False,则不产生DragDrop事件
      begin              // 实际上在VCL中没有处理dmDragCancel的相关代码
       DragMsg := dmDragCancel;   // 即dmDragCancel只是一个保留操作
       DragSave.FDragPos.X := 0;
       DragSave.FDragPos.Y := 0;
       TargetPos.X := 0;
       TargetPos.Y := 0;
      end;
      DragMessage(DragSave.DragHandle, DragMsg, DragSave,
       DragSave.DragTarget, DragSave.DragPos);
     end;
    finally
     // ->
     QualifyingSites.Free;
     QualifyingSites := nil;
     // <-

     if Assigned(DragSave) then
     begin
      DragSave.Cancelling := False;
      DragSave.Finished(DragSave.DragTarget, TargetPos.X, TargetPos.Y, Accepted);  // 产生EndDrag事件
     end;

     DragObject := nil;
    end;
   finally
    DragControl := nil;
    if Assigned(DragSave) and ((DragSave is TDragControlObjectEx) or (DragSave is TDragObjectEx) or
      (DragSave is TDragDockObjectEx)) then
     DragSave.Free;
    ActiveDrag := dopNone;   
   end;
  end; 

至此,与DragDrop核心的接口函数已介绍完毕;我们留意到在这些几个函数中还调用了DragFindTarget、DoDragOver、DragMessage几个函数,这些函数的源码在Control.pas中,功能分别如下:

  DragFindTarget:(const Pos: TPoint; var Handle: HWND; DragKind: TDragKind; Client: TControl): Pointer;
   根据DragKind的类型查找Pos位置的VCL控件(由函数返回值返回),Handle返回控件的句柄。

  DoDragOver:(DragMsg: TDragMessage): Boolean;
   产生目标控件的DragOver事件。

  DragMessage:(Handle: HWND; Msg: TDragMessage;
         Source: TDragObject; Target: Pointer; const Pos: TPoint): Longint;
   发送Drag相关的消息到Drag控件。

  

  7、DragDrop管理核心

  下面的部分将是DragDrop管理的核心部分介绍。先来看一直管理核心类的定义及继承关系:
    TDragObject  = class(TObject);
    TDragObjectEx = class(TDragObject);
    TBaseDragControlObject = class(TDragObject);
    TDragControlObject  = class(TBaseDragControlObject);
    TDragControlObjectEx = class(TDragControlObject);

  这里只对TDragObject类的DragDrop控制实现过程作详细介绍,其他部分及其他类的实现就不多作介绍。


  在DragInit函数中有这么一句调用:
   DragCapture := DragObject.Capture;

  TDragObject.Capture调用AllocateHWND函数创建了一个内部不可见窗口(Delphi习惯上称为TPUtilWindow),并设置该窗口句柄为Capture窗口,以接收应用程序的所有鼠标和键盘输入消息,实现Drag控制。下面是其实现代码:
  
  function TDragObject.Capture: HWND;
  begin
   Result := Classes.AllocateHWND(MainWndProc);
   SetCapture(Result);
  end;


  与TDragObject.Capture对应,有一个TDragObject.ReleaseCapture函数,在DragDone有相应调用:
   DragObject.ReleaseCapture(DragCapture);

  TDragObject.Capture结束DragDrop控制,函数中首先释放系统的Capture句柄,并调用DeallocateHWND释放由AllocateHWND创建的窗口。


  当调用WinAPI函数SetCapture将一个窗口(句柄)设置为Capture模式后,系统的所有鼠标、键盘输入消息都将发送到该窗口中,VCL的DragDrop操作便是基于这样的原理来实现的。当调用了TControl.BeginDrag函数后,随后的几个函数设置DragDrop操作所需的参数,并创建了一个这样的Capture窗口,直到这时,鼠标的按键一直是按下的,当Capture窗口接收到鼠标按键释放或ESC键按下的消息时,便结束了DragDrop操作。


  我们再来看一下TDragObject的消息处理函数TDragObject.WndProc:

  procedure TDragObject.WndProc(var Msg: TMessage);
  var
   P: TPoint;
  begin
   try
    case Msg.Msg of

     // 鼠标移动时调用DragTo函数,检查鼠标位置的VCL控件并产生相应的事件ss 
     WM_MOUSEMOVE:
      begin
       P := SmallPointToPoint(TWMMouse(Msg).Pos);
       ClientToScreen(DragCapture, P);
       DragTo(P);
      end;

     // 系统的Capture窗口改变或鼠标按键释放时结束DragDrop操作
     WM_CAPTURECHANGED:
      DragDone(False);   // 取消Drag
     WM_LBUTTONUP, WM_RBUTTONUP:
      DragDone(True);    // 结束Drag并产生DragDrop事件

     // 当一个TPUtilWindow获得鼠标Capture时,Forms.IsKeyMsg向其发送所有的键盘消息,
     // 但是这些键盘消息都加上了CN_BASE,变成了CN_KEYxxx
     // 如果Ctrl键按下或释放,
     CN_KEYUP:
      if Msg.WParam = VK_CONTROL then DragTo(DragObject.DragPos);
     CN_KEYDOWN:
      begin
       case Msg.WParam of
        VK_CONTROL:
         DragTo(DragObject.DragPos);
        VK_ESCAPE:
         begin
          { Consume keystroke and cancel drag operation }
          Msg.Result := 1;
          DragDone(False);   // ESC键按下,取消Drag操作
         end;
       end;
      end;
    end;
   except
    if DragControl <> nil then DragDone(False);
    Application.HandleException(Self);
   end;
  end;


  8、小结

  通过全文的介绍,可以总结出下图:

    TControl.BeginDrag
        |
     DragInitControl --> { TDragObject.Create; }
        |
      DragInit --> { TDragObject.Capture; }
        |
  |---------->|
  |  TDragObject.WinProc ---> WM_MOUSEMOVE   ===> DragTo
  |      |      |
  |----------<|      |-> WM_CAPTURECHANGED ===> DragDone(False)
        |      |
      DragDone    |-> WM_LBUTTONUP, WM_RBUTTONUP ==> DragDone(True)
              |
              |-> CN_KEYUP(VK_CONTROL)  ===> DragTo
              |
              |-> CN_KEYDOWN(VK_CONTROL) ===> DragTo
              |
              |-> CN_KEYDOWN(VK_ESCAPE) ===> DragDone(False)

作者:网络 来源:转载
共有评论 1相关评论
发表我的评论
  • 大名:
  • 内容:
本类推荐
  • 没有
本类固顶
  • 没有
  • 盒子文章(www.2ccc.com) © 2017 版权所有 All Rights Reserved.
  • 沪ICP备05001939号