How to stop Screen.Cursor affects all controls on the form?

Question

I will try to simplify my problem. If for example you drop 2 TSpeedButton and do:

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
  SpeedButton2.Cursor := crHandPoint; // note I'm setting other cursor than crDefault
end;

The SpeedButton2.Cursor remains showing Screen.Cursor which was set to crHourGlass.
I have looked into the TScreen.SetCursor code, and realize it sets the cursor for the entire form.
My question: is it somehow possible to use the Screen.Cursor for the entire form, BUT without impacting some control(s) which I want to set other cursor.

The same happens with a TButton. I don't mind placing the SpeedButton on a windowed control if I can somehow control it's cursor while Screen.Cursor is set to crHourGlass.

Thanks.

Answer 1

This is intentional behavior as explained in the documentation for TScreen.Cursor:

... When Cursor is crDefault, the individual objects determine the cursor image. Assigning any other value sets the mouse cursor image for all windows belonging to the application. The global mouse cursor image remains in effect until the screen's Cursor property is changed back to crDefault. ..

Windowed controls handle their cursors in TWinControl.WMSetCursor procedure, handler of WM_SETCURSOR message, where they explicitly set the screen cursor if it is anything other than crDefault and disregard their own cursor.

So to change the behavior you can handle the mentioned message. For a TButton interposer, an example could be:

procedure TButton.WMSetCursor(var Message: TWMSetCursor);
begin
  if (Cursor <> crDefault) and (Message.HitTest = HTCLIENT) then begin
    Message.Result := 1;
    Windows.SetCursor(Screen.Cursors[Cursor]);
  end else
    inherited;
end;

---

Graphic controls' cursors are handled by their parent TWinControl. So to change the behavior of a speed button, you would still need to handle the same message on its parent. This would likely be impractical since the parent class might not be known beforehand.

Still, a very non-generalized implementation, for example for a graphic control placed directly on the form, might look like the below:

procedure TForm1.WMSetCursor(var Message: TWMSetCursor);
var
  SmPt: TSmallPoint;
  Control: TControl;
begin
  DWORD(SmPt) := GetMessagePos;
  Control := ControlAtPos(ScreenToClient(SmallPointToPoint(SmPt)), True);
  if Assigned(Control) and Boolean(Control.Tag) then begin
    Message.Result := 1;
    Windows.SetCursor(Screen.Cursors[Control.Cursor])
  end else
    inherited;
end;

Above example would require the graphic control to have a non zero tag value. E.g.:

procedure TForm1.Button1Click(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
  SpeedButton1.Cursor := crHandPoint;
  SpeedButton1.Tag := 1;
end;