delphi - 如何随着鼠标光标显示动态文本

Question

当用户重新调整表单大小时，在 XE2 中我想在当前鼠标光标旁边显示当前表单大小。我将使用 OnResize 事件。

换句话说:我需要如何在用户移动鼠标时显示动态文本(例如下图中的 300、250 等 x,y 坐标)以及鼠标光标。

一种方法是模拟 .cur 文件并将其分配给 OnResize 中的光标。这看起来很麻烦，而且可能很慢(而且我还不知道文件的内容)

另一个想法是显示一些透明文本(什么组件可以做到这一点？)，我在 OnResize 事件中设置了 .Top、.Left。

我关心的一个问题是如何检测调整大小操作何时完成，以便我可以恢复到标准鼠标光标。

有什么建议和继续的方向吗？

Answer 1

更新:

这是一个更新版本，其中删除了提示动画部分(因为我觉得您需要立即显示提示以达到您的目的)并添加双缓冲(由于频繁更新提示)以防止闪烁和还有一个不错的阿尔法混合(只是出于好奇)。

感谢 @NGLN 修复了提示窗口变量未分配的缺失!

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TAlphaHintWindow = class(THintWindow)
  private
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWindowHandle(const Params: TCreateParams); override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure ActivateHint(Rect: TRect; const AHint: string); override;
  end;

type
  TForm1 = class(TForm)
  private
    FSizeMove: Boolean;
    FHintWindow: TAlphaHintWindow;
    procedure WMEnterSizeMove(var AMessage: TMessage); message WM_ENTERSIZEMOVE;
    procedure WMSize(var AMessage: TWMSize); message WM_SIZE;
    procedure WMExitSizeMove(var AMessage: TMessage); message WM_EXITSIZEMOVE;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TAlphaHintWindow }

constructor TAlphaHintWindow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  // window might be updated quite frequently, so enable double buffer
  DoubleBuffered := True;
end;

procedure TAlphaHintWindow.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  // include the layered window style (for alpha blending)
  Params.ExStyle := Params.ExStyle or WS_EX_LAYERED;
end;

procedure TAlphaHintWindow.CreateWindowHandle(const Params: TCreateParams);
begin
  inherited CreateWindowHandle(Params);
  // value of 220 here is the alpha (the same as form's AlphaBlendValue)
  SetLayeredWindowAttributes(Handle, ColorToRGB(clNone), 220, LWA_ALPHA);
end;

procedure TAlphaHintWindow.ActivateHint(Rect: TRect; const AHint: string);
var
  Monitor: TMonitor;
begin
  // from here was just stripped the animation part and fixed one bug
  // (setting a hint window top position when going off screen; it is
  // at least in Delphi 2009 with the most recent updates)
  Caption := AHint;
  Inc(Rect.Bottom, 4);
  UpdateBoundsRect(Rect);
  Monitor := Screen.MonitorFromPoint(Point(Rect.Left, Rect.Top));
  if Width > Monitor.Width then
    Width := Monitor.Width;
  if Height > Monitor.Height then
    Height := Monitor.Height;
  if Rect.Top + Height > Monitor.Top + Monitor.Height then
    Rect.Top := (Monitor.Top + Monitor.Height) - Height;
  if Rect.Left + Width > Monitor.Left + Monitor.Width then
    Rect.Left := (Monitor.Left + Monitor.Width) - Width;
  if Rect.Left < Monitor.Left then
    Rect.Left := Monitor.Left;
  if Rect.Top < Monitor.Top then
    Rect.Top := Monitor.Top;
  ParentWindow := Application.Handle;
  SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, Width, Height,
    SWP_NOACTIVATE);
  ShowWindow(Handle, SW_SHOWNOACTIVATE);
  Invalidate;
end;

procedure TAlphaHintWindow.CMTextChanged(var Message: TMessage);
begin
  // do exactly nothing, because we're adjusting the size by ourselves
  // and the ancestor would just autosize the window by the text; text
  // or if you want Caption, is updated only by calling ActivateHint
end;

{ TForm1 }

procedure TForm1.WMEnterSizeMove(var AMessage: TMessage);
begin
  inherited;
  FSizeMove := True;
end;

procedure TForm1.WMSize(var AMessage: TWMSize);
var
  CurPos: TPoint;
begin
  inherited;
  if FSizeMove and GetCursorPos(CurPos) then
  begin
    if not Assigned(FHintWindow) then
      FHintWindow := TAlphaHintWindow.Create(nil);
    FHintWindow.ActivateHint(
      Rect(CurPos.X + 20, CurPos.Y - 20, CurPos.X + 120, CurPos.Y + 30),
      'Current size' + sLineBreak +
      'Width: ' + IntToStr(Width) + sLineBreak +
      'Height: ' + IntToStr(Height));
  end;
end;

procedure TForm1.WMExitSizeMove(var AMessage: TMessage);
begin
  inherited;
  FHintWindow.Free;
  FHintWindow := nil;
  FSizeMove := False;
end;

end.

以及表单大小调整的结果(对我的口味来说非常透明:-)