8

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

换句话说：我需要有关如何在用户移动鼠标时随鼠标光标显示动态文本（例如，下图中的 300、250 等 x,y 坐标）的想法。

在此处输入图像描述

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

另一个想法是显示一些我在 OnResize 事件中设置的 .Top、.Left 的透明文本（什么组件会这样做？）。

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

有什么建议可以继续进行吗？

4

2 回答 2

15

更新：

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

感谢@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.

尺寸调整的结果（对我的口味来说非常透明:-)

在此处输入图像描述

于 2012-09-13T13:47:44.503 回答
3

它真的需要透明吗？请记住，在某些背景下可能难以阅读文本。

相反，请考虑显示一个工具提示窗口。创建一个THintWindow控件，设置其标题和位置，并显示它。

当您收到wm_ExitSizeMove消息时，隐藏或销毁窗口。

于 2012-09-13T13:38:00.700 回答