TTrayIcon与OnMouseEnter / OnMouseLeave事件

时间:2018-04-18 10:04:20

标签: delphi

我正在考虑从被遗弃的TCoolTrayIcon切换到Delphi自己的TTrayIcon。在我的案例中,我唯一缺少的是OnMouseEnterOnMouseExit(≘OnMouseLeave)。

是否有一种简单的方法可以将这些事件添加到TTrayIcon? (CoolTrayIcon使用计时器做到这一点......我不确定这是否真的是最好的解决方案)

2 个答案:

答案 0 :(得分:1)

虽然似乎没有人真正对这个问题的实际解决方案感兴趣,但我想无论如何都要公布我的解决方案,以防其他人搜索同样的问题。

这种编码方式比我最初预期的要少。

unit TrayIconEx;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.ExtCtrls;

type
  TTrayIconEx = class(TTrayIcon)
  private
    CursorPosX, CursorPosY: Integer;
    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;
    EnterLeaveTimer: TTimer;
    procedure EnterLeaveEvent(Sender: TObject);
  protected
    procedure WindowProc(var Msg: TMessage); override;
    procedure MouseEnter; virtual;
    procedure MouseLeave; virtual;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Custom', [TTrayIconEx]);
end;

constructor TTrayIconEx.Create(AOwner: TComponent);
begin
  inherited;
  EnterLeaveTimer := TTimer.Create(Self);
  EnterLeaveTimer.Enabled := False;
  EnterLeaveTimer.Interval := 200;
  EnterLeaveTimer.OnTimer := EnterLeaveEvent;
end;

procedure TTrayIconEx.WindowProc(var Msg: TMessage);
var
  p: TPoint;
begin
  if Assigned(FOnMouseEnter) or Assigned(FOnMouseLeave) then
  begin
    if (Msg.Msg = WM_SYSTEM_TRAY_MESSAGE) and (Msg.lParam = WM_MOUSEMOVE) then
    begin
      GetCursorPos(p);
      CursorPosX := p.X;
      CursorPosY := p.Y;
      if not EnterLeaveTimer.Enabled then
        MouseEnter();
    end;
  end;
  inherited WindowProc(Msg);
end;

procedure TTrayIconEx.EnterLeaveEvent(Sender: TObject);
var
  p: TPoint;
begin
  //Win7+ supports Shell_NotifyIconGetRect(), but to support Vista and XP a workaround is required.
  //-> If the position differs from the last captured position in MouseMove, then the cursor was moved away.
  GetCursorPos(p);
  if (CursorPosX <> p.X) or (CursorPosY <> p.Y) then
    MouseLeave();
end;

procedure TTrayIconEx.MouseEnter;
begin
  if Assigned(FOnMouseEnter) then
    FOnMouseEnter(Self);
  EnterLeaveTimer.Enabled := True;
end;

procedure TTrayIconEx.MouseLeave;
begin
  EnterLeaveTimer.Enabled := False;
  if Assigned(FOnMouseLeave) then
    FOnMouseLeave(Self);
end;

end.

答案 1 :(得分:-1)

如果你想要的只是一个更高级的提示,那么你可以个性化它自己的提示,就像任何其他具有特殊字符的字符串,如Enter等,如下所示:

edit1.hint:='first row'+#13+'second row'+#13+#13+'last row';