delphi - 在某些组件上更改鼠标光标而不影响其他光标设置代码

Question

我正在 Delphi XE2 中使用 DevExpress QuantumGrid (MasterView) 的古老前身，并且希望某些单元格能够有效地充当超链接(将鼠标光标从 crDefault 更改为 crHandPoint 当位于它们上方时并触发单击操作)。

网格组件的配置使得各个单元格不是它们自己的组件，我需要从鼠标光标坐标找到单元格并从那里设置光标。

我认为我需要在网格对象上设置一些事件来实现此目的，但我对这些事件如何与在执行长时间运行的操作时将光标设置为沙漏的代码进行交互感到有点不舒服(目前使用 IDisposible 处理，完成后将光标设置回原始状态)，并希望在开始之前仔细检查是否有更好的方法来执行此操作，然后找到大量使鼠标光标处于错误状态的边缘情况。

我想我需要重写:

• omMouseMove - 获取 XY 坐标并将光标设置为手形/箭头
• onMouseDown - 获取 XY 坐标并“激活”超链接(如果存在)(可能恢复为箭头？超链接通常会打开一个新窗口，调用的代码可能会将光标更改为沙漏)
• onMouseLeave - 将光标重置为箭头(此事件实际上并未公开，因此 我认为我需要手动处理消息)

这种功能在 TButton 上是默认提供的，但我在 VCL 中乍一看无法看出它是如何实现的，可能是底层 Windows 控件的一个功能。

Answer 1

这是我更喜欢的场景。光标设置为WM_SETCURSOR消息处理程序和后端工作由标志发出信号。然后从MouseDown处理链接点击。方法重写。请注意，仅此控件的光标会发生更改(当鼠标光标悬停在控件上时)。在伪代码中:

type
  THitCode =
  (
    hcHeader,
    hcGridCell,
    hcHyperLink { ← this is the extension }
  );

  THitInfo = record
    HitRow: Integer;
    HitCol: Integer;
    HitCode: THitCode;
  end;

  TMadeUpGrid = class(TGridAncestor)
  private
    FWorking: Boolean;
    procedure DoStartWork;
    procedure DoFinishWork;
    procedure UpdateCursor;
    procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  public
    function GetHitTest(X, Y: Integer): THitInfo; override; 
  end;

implementation

procedure TMadeUpGrid.DoStartWork;
begin
  FWorking := True;
  UpdateCursor;
end;

procedure TMadeUpGrid.DoFinishWork;
begin
  FWorking := False;
  UpdateCursor;
end;

procedure TMadeUpGrid.UpdateCursor;
begin
  Perform(CM_CURSORCHANGED, 0, 0); { ← triggers WM_SETCURSOR handler if needed }
end;

procedure TMadeUpGrid.WMSetCursor(var Msg: TWMSetCursor);
var
  P: TPoint;
  HitInfo: THitInfo;
begin
  { the mouse is inside the control client rect, inherited call here should
    "default" to the Cursor property cursor type }
  if Msg.HitTest = HTCLIENT then
  begin
    GetCursorPos(P);
    P := ScreenToClient(P);
    HitInfo := GetHitTest(P.X, P.Y);
    { if the mouse is hovering a hyperlink or the grid backend is working }
    if FWorking or (HitInfo.HitCode = hcHyperLink) then
    begin
      { here you can setup the "temporary" cursor for the hyperlink, or
        for the working grid backend }
      if not FWorking then
        SetCursor(Screen.Cursors[crHandPoint])
      else
        SetCursor(Screen.Cursors[crHourGlass]);
      { tell the messaging system that this message has been handled }
      Msg.Result := 1;
    end
    else
      inherited;
  end
  else
    inherited;
end;

procedure TMadeUpGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  HitInfo: THitInfo;
begin
  if Button = mbLeft then
  begin
    HitInfo := GetHitTest(X, Y);
    { the left mouse button was pressed when hovering the hyperlink, so set
      the working flag, trigger the WM_SETCURSOR handler "manually" and do the
      navigation; when you finish the work, call DoFinishWork (from the main
      thread context) }
    if HitInfo.HitCode = hcHyperLink then
    begin
      DoStartWork;
      DoSomeNavigation(HitInfo.HitRow, HitInfo.HitCol);
    end;
  end;
end;

function TMadeUpGrid.GetHitTest(X, Y: Integer): THitInfo;
begin
  { fill the Result structure properly }
end;