Delphi 中的 RectTracker - 原创

本文算是副产品，正品是利用 FFmpeg 从任意视频中生成GIF片段的小程序，写完了就发。

V2G 正品已出炉，虽然不大像样，但好歹是能用，请见：用 Delphi 7 实现基于 FFMS2 的视频转 GIF 工具。

因为要对视频画面进行框选，再生成 GIF，所以得有个框选的控件，可 Delphi 里没有啊，只好自己写一个了。

声明

本文参考的是盒子网的 RectTracker，原作者署名 xwwaw，发布于2007年5月28日。主要的修改之处是增加了边框检测，因为我觉得让选框超出父控件是不合逻辑的。

最开始参考的是 Anthony Scott 的 TStretchHandle，可是怎么改都不好用，遂放弃。以下是 TStretchHandle 的网站介绍截图：



是的，你没看错！TStretchHandle v.2.0 在 Windows 3.1 和 Windows 95 下测试通过！看到这2个词，我瞬间石化。顿时想起了毕业前去光盘市场淘了张 Windows 95 的预览版，想着去了工作单位也许能用的上。结果上了班才发现，干活的是 Sco Unix，办公还都是 Windows 3.2，而且品牌机全都自带操作系统。

什么是 RectTracker

直译是“橡皮筋”，窃以为不好理解，还是称其为框选控件，说白了就是在屏幕上画个虚线框供选中区域，8 个方向都有可以拉伸的控制柄，类似 QQ 的屏幕截图功能。在 MFC 里有个CRectTracker可用，可参考 CRectTracker源码学习笔记。

在微软官方的文档 GetHandleMask里，8 个控制柄是有编号的：



当然我们就不必这么讲究了。

主要思路

• 覆盖Paint方法：画框，包括画 8 个控制柄（小黑块）
• 响应WMMouseMove消息：修改光标形状，边界检测（不论移动还是拉伸都不超出父控件），最小尺寸检测
• 响应WMLButtonDown消息：开始拖动
• 响应WMLButtonUp消息：停止拖动

常量

const
  DefaultSize=65;            //默认的控件大小
  DefaultHandleSize=5;  //默认的控制柄大小
  DefaultBorderWidth=1;//默认的边框宽度（暂时没用，因为超过 1 就画不出虚线框）

主要成员变量

TDXRectTracker = class(TGraphicControl)
private
  FDragging: boolean;      //是否处于拖动状态（鼠标左键保持按下）
  FHandleSize: integer;    //控制柄大小
  FBorderWidth: integer;  //边框宽度（暂时没用）
  FMinSize: integer;         //控件最小尺寸
  FTrackerType: TMousePosType;  //当前控件拖动类型
  FX,FY: integer;             //当前光标位置（相对于本控件，在拖动状态下可能是负值）

Paint 方法

一图解千惑：



绘制8个控制柄和虚线框还是简单的。但是有一点，如果Pen.Width>1，是无法绘制出虚线的，不知哪位高人能解。

WMLButtonDown 消息处理

在收到鼠标左键按下的消息时，表示要启动拖动状态，为后续的WMMouseMove消息处理做准备。

  FDragging:= true;     //启动拖动状态
  Fx:= Message.XPos;  //记录光标当前横位置
  Fy:= Message.YPos;  //记录光标当前纵位置
  FTrackerType:= GetMousePos(Fx, Fy);  //根据光标位置设置鼠标光标类型
  inherited;

本控件全部区域都是可拖动范围，所以鼠标左键按下即表示要开始拖动。如果鼠标位于控制柄上，表示要拉伸边框；如果鼠标位于控件内部，表示要移动整个控件；如果鼠标位于控件之外，则不会接收到鼠标左键按下事件。

WMLButtonUp 消息处理

在收到鼠标左键抬起的消息时，表示拖动状态结束，做状态清理：

  FDragging:= false;
  Fx:= -1;
  Fy:= -1;
  FTrackerType:= mpOutBox;
  inherited;

WMMouseMove 消息

本控件最“重”的处理就是在MouseMove消息上了。为了能在鼠标拖动边框或整个控件时，能实时显示位置，必须计算出目标位置。

1. 根据WMLButtonDown消息处理时记录的光标初始值（Fx, Fy）计算偏移量（dx, dy）；
2. 根据WMLButtonDown消息处理时记录的拖动类型（FTrackerType）计算控件外框相对于父控件的坐标值（x1, x2, y1, y2）；
3. 修正控件外框坐标，将控件限制在父控件的Client区域内部，拖动或者拉伸均不能越界。且拉伸也不能小于最小尺寸（FMinSize）；
4. 根据当前光标位置，设置鼠标光标形状。

以下是最关键的计算控件外框坐标的代码：

  case FTrackerType of
    mpLeft:
      begin
        inc(x1, dx);
      end;
    mpRight:
      begin
        inc(x2, dx);
        Fx:= Message.XPos;
      end;
    mpTop:
      begin
        inc(y1, dy);
      end;
    mpBottom:
      begin
        inc(y2, dy);
        Fy:= Message.YPos;
      end;
    mpLeftTop:
      begin
        inc(x1, dx);
        inc(y1, dy);
      end;
    mpRightBottom:
      begin
        inc(x2, dx);
        inc(y2, dy);
        Fx:= Message.XPos;
        Fy:= Message.YPos;
      end;
    mpLeftBottom:
      begin
        inc(x1, dx);
        inc(y2, dy);
        Fy:= message.YPos;
      end;
    mpRightTop:
      begin
        inc(x2, dx);
        inc(y1, dy);
        Fx:= message.XPos;
      end;
    mpInBox:  //只是移动，不做拉伸
      begin
        inc(x1, dx);
        inc(y1, dy);
        inc(x2, dx);
        inc(y2, dy);
      end;
  end;

请注意，WMMouseMove消息带入的是相对于父控件的坐标，光标坐标（message.XPos, message.YPos）可能会小于0，也可能会大于当前控件的Width及Height值。因为在鼠标保持按下状态时，即使光标位置移出了当前控件的边界，控件仍然会接收到WMMouseMove消息。向左向上移出，坐标就会出现负值。向下向右移出，坐标则会大于当前控件的Width及Height值。以下是示意图：



中间是子控件，外围是父控件。

源码

DXRectTracker.zip