Clever Geek Handbook

Change the mouse cursor to specific components without affecting other cursor setting code

I'm using the ancient DevExpress QuantumGrid (MasterView) predecessor in Delphi XE2 and would like certain cells to effectively act as hyperlinks (change the mouse cursor from crDefault to crHandPoint when over them and activate the action on click).

The configuration of the grid component is such that the individual cells are not their own component and I will need to find the cell from the coordinates of the mouse cursor and position the cursor from there.

I think I need to set multiple events on my grid object to achieve this, but I'm a little uncomfortable with how those events would interact with the code that sets the cursor to the hourglass when doing long running operations (currently handled using IDisposible to return cursor to original when done) and want to double check if there is a better way to do this before I start and then find a ton of edges that leave the mouse cursor in the wrong state.

I think I need to override:

  • omMouseMove - get XY coordinates and set cursor to hand / arrow
  • onMouseDown - get XY coordinates and activate the hyperlink if there is one (maybe go back to the arrow? The hyperlink usually opens a new window, and the called code can change the cursor to an hourglass)
  • onMouseLeave - reset cursor to arrow (this event is not actually displayed, so I guess I will need to handle messages manually)

This type of function is the default in TButton, but I couldn't see in the VCL how it achieved at first glance, and might be a sign of a basic Windows control.

+3


source to share


2 answers


I actually found a solution while browsing SO.

I forgot that components usually have their own Cursor property as they set the correct mouse cursor type when the pointer is over them (i.e. button behavior)

Overriding MouseMove to change the cursor to crHandPoint

if it is over the hyperlink cell and retains the property of the old cursor to revert to if not over the hyperlink seems to work fine (and separate from the selected screen.cursor in long code). I need to complete the code to confirm that it is working correctly, so I will leave the question unanswered until I can confirm that everything is working as I expected.



edit: adding some code. I chose to use the interceptor class rather than subclassing the grid and registering the control - I will only use it in one or two places in one application, and this will save you the trouble of installing all the other machines.

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;
0


source


This is the scenario I would prefer. The cursor is set from the WM_SETCURSOR message handler and backend work with which the flag is set. The link is then processed using the MouseDown method . Note that the cursor only changes for this control (when the mouse cursor hovers over the slider). In pseudocode:



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;
+1


source






More articles:


All Articles