如何停止Screen.Cursor 影响窗体上的所有控件?

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

我会尽量简化我的问题。例如,如果您放下 2 TSpeedButton 并执行:

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

SpeedButton2.Cursor 仍然显示 Screen.Cursor 已设置为 crHourGlass
我查看了 TScreen.SetCursor 代码,发现它为整个表单设置了光标。
我的问题:是否有可能以某种方式对整个表单使用 Screen.Cursor,但不影响我想设置其他光标的 some 控件。

TButton 也是如此。如果我可以在 Screen.Cursor 设置为 crHourGlass.

时以某种方式控制它的光标,我不介意将 SpeedButton 放在窗口控件上

谢谢。

这是 documentation 中针对 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. ..


窗口控件在 TWinControl.WMSetCursor 过程中处理它们的光标,WM_SETCURSOR 消息的处理程序,如果屏幕光标不是 crDefault,它们会在其中明确设置屏幕光标并忽略它们自己的光标。

因此,要更改行为,您可以处理上述消息。对于 TButton 内插器,示例可能是:

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;



图形控件的光标由它们的父控件处理 TWinControl。因此,要更改速度按钮的行为,您仍然需要在其父级上处理相同的消息。这可能是不切实际的,因为父 class 可能事先不知道。

不过,一个非常不通用的实现,例如直接放在窗体上的图形控件,可能如下所示:

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;

以上示例要求图形控件具有非零标记值。例如:

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