Question

我在Delphi XE2中使用了DevExpress QuantumGrid（MasterView）的古老前身，并希望某些单元格有效地充当超链接（将鼠标光标从crDefault更改为crHandPoint，并在触发时点击动作）。

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

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

我想我需要覆盖：

omMouseMove - 获取XY坐标并将光标设置为手/箭头
onMouseDown - 获取XY坐标并激活＆＃39;如果存在超链接（可能还原为箭头？超链接通常会打开一个新窗口，调用的代码可能会将光标更改为沙漏）
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;

Answer 2

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

我忘了组件通常有自己的Cursor属性，这是指针在它们上面时设置正确鼠标光标类型的方式（即按钮行为）

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

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

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;

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

2 个答案: