在不影响其他光标设置代码的情况下，在某些组件上更改鼠标光标

Question

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

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

我想我需要在我的网格对象上设置一些事件来实现这一点，但我对这些事件如何与在执行 long-运行操作（当前使用 IDisposible 进行处理，在完成后将光标设置回原始位置）并想在开始之前仔细检查是否有更好的方法，然后找到大量离开鼠标的边缘情况光标处于错误状态。

我想我需要覆盖：

omMouseMove - 获取 XY 坐标并将光标设置为 hand/arrow
onMouseDown - 获取 XY 坐标和 'activate' 超链接（如果存在）（可能恢复为箭头？超链接通常会打开一个新的 window 并且调用的代码可能会将光标更改为沙漏)
onMouseLeave - 将光标重置为箭头（此事件实际上并未公开，因此我想我需要手动处理消息）

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

Answer 1

我实际上在浏览 SO 时找到了解决方案。

我忘记了组件通常有自己的光标属性，这就是当指针悬停在组件上时它们如何设置正确的鼠标光标类型（即按钮行为）

通过重写 MouseMove 将光标更改为 crHandPoint（如果它在超链接单元格上）并存储旧光标属性以恢复到（如果它不在超链接上）似乎工作正常（并且分开到 long-运行代码中设置的 screen.cursor）。我需要完成代码以确认它能正常工作，所以我暂时不回答这个问题，直到我能确认一切都按我预期的方式工作。

编辑：添加一些代码。我决定使用拦截器 class 而不是子 class 网格并且必须注册控件 - 我只会在一个应用程序的一两个地方使用它并且它节省了设置其他人的机器。

TdxMasterView = class(dxMasterView.TdxMasterView)
private
  FDefaultCursor: TCursor;
  procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
public
  constructor Create(AOwner: TComponent); override;
end;

constructor TdxMasterView.Create(AOwner: TComponent);
begin
  inherited create(AOwner);
  FDefaultCursor := self.Cursor;
end;

procedure TdxMasterView.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  lvHitTestCode: TdxMasterViewHitTestCode;
  lvNode : TdxMasterViewNode;
  lvColumn: TdxMasterViewColumn;
  lvRowIndex, lvColIndex: integer;
begin
  inherited;
  lvHitTestCode   := self.GetHitTestInfo( Point(X,Y),
                                          lvNode,
                                          lvColumn,
                                          lvRowIndex,
                                          lvColIndex );
  if (lvHitTestCode = htContent) and (lvColumn is TMasterViewClickableColumn) then
  begin
    TMasterViewClickableColumn(lvColumn).onClickContentCell(lvNode);
  end;
end;

procedure TdxMasterView.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  lvHitTestCode: TdxMasterViewHitTestCode;
  lvNode : TdxMasterViewNode;
  lvColumn: TdxMasterViewColumn;
  lvRowIndex, lvColIndex: integer;
begin
  inherited;
  lvHitTestCode   := self.GetHitTestInfo( Point(X,Y), 
                                          lvNode,
                                          lvColumn,
                                          lvRowIndex,
                                          lvColIndex );
  if (lvHitTestCode = htContent) and (lvColumn is TMasterViewClickableColumn) then
  begin
    self.cursor := TMasterViewClickableColumn(lvColumn).cursorOnMouseOver;
  end
  else
  begin
    self.cursor := self.FDefaultCursor;
  end;
end;

Answer 2

这是我更喜欢的场景。游标是从 WM_SETCURSOR message handler and backend work signalled by a flag. Link click is then handled from the 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;

在不影响其他光标设置代码的情况下，在某些组件上更改鼠标光标

Change mouse cursor when over certain components without affecting other cursor-setting code

delphi

button

delphi-xe2