如何显示动态文本和鼠标光标

时间:2012-09-13 13:22:51

标签: delphi

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

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

enter image description here

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

另一个想法是显示我在OnResize事件中设置.Top,.Left的一些透明文本(哪个组件会这样做?)。

我有一个问题是如何检测重新调整大小操作的时间,以便我可以恢复到标准鼠标光标。

有任何建议可以继续吗?

2 个答案:

答案 0 :(得分:15)

<强> 更新

这是一个更新版本,其中删除了提示动画部分(因为我觉得你需要立即为你的目的显示提示)以及在哪里添加了双缓冲(由于经常更新提示)以防止闪烁和也是一个不错的alpha混合(仅仅是为了好奇)。

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

形状大小的结果(对我的口味非常透明: - )

enter image description here

答案 1 :(得分:3)

它真的需要透明吗?请记住,在某些背景下难以阅读文字。

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

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