如何使用 Delphi 在活动显示器的右下角显示消息窗口

Question

如今，您会看到很多软件在活动屏幕的右下角显示消息窗口几秒钟或直到单击关闭按钮（f.i. Norton 在检查后会执行此操作下载）。

我想使用 Delphi 7（如果可能的话，使用 Delphi 2010，因为我正在慢慢地将我的代码迁移到最新版本）。

我在 SO 上发现了一些关于表单未获得焦点的帖子，但这只是问题的一部分。我也在考虑如何确定此消息窗口的确切位置（知道用户可能已将他的任务栏放在屏幕右侧。

提前致谢。

10 年 1 月 26 日更新： 从drorhan 的代码开始，我创建了以下表单（在 Delphi 7 中），无论任务栏是否显示在底部，右侧都有效，屏幕的左侧或顶部。

fPopupMessage.dpr:

  object frmPopupMessage: TfrmPopupMessage
    Left = 537
    Top = 233
    AlphaBlend = True
    AlphaBlendValue = 200
    BorderStyle = bsToolWindow
    Caption = 'frmPopupMessage'
    ClientHeight = 48
    ClientWidth = 342
    Color = clBtnFace
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = []
    OldCreateOrder = False
    OnClose = FormClose
    OnCreate = FormCreate
    DesignSize = (
      342
      48)
    PixelsPerInch = 96
    TextHeight = 13
    object img: TImage
      Left = 0
      Top = 0
      Width = 64
      Height = 48
      Align = alLeft
      Center = True
      Transparent = True
    end
    object lblMessage: TLabel
      Left = 72
      Top = 8
      Width = 265
      Height = 34
      Alignment = taCenter
      Anchors = [akLeft, akTop, akRight, akBottom]
      AutoSize = False
      Caption = '...'
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clNavy
      Font.Height = -11
      Font.Name = 'Verdana'
      Font.Style = [fsBold]
      ParentFont = False
      Transparent = True
      WordWrap = True
    end
    object tmr: TTimer
      Enabled = False
      Interval = 3000
      OnTimer = tmrTimer
      Left = 16
      Top = 16
    end
  end

和

fPopupMessage.pas

  unit fPopupMessage;

  interface

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

  type
    TfrmPopupMessage = class(TForm)
      tmr: TTimer;
      img: TImage;
      lblMessage: TLabel;
      procedure FormCreate(Sender: TObject);
      procedure tmrTimer(Sender: TObject);
      procedure FormClose(Sender: TObject; var Action: TCloseAction);
    private
      { Private declarations }
      bBeingDisplayed : boolean;
      function GetPopupMessage: string;
      procedure SetPopupMessage(const Value: string);
      function GetPopupCaption: string;
      procedure SetPopupCaption(const Value: string);
      function TaskBarHeight: integer;
      function TaskBarWidth: integer;
      procedure ToHiddenPosition;
      procedure ToVisiblePosition;
    public
      { Public declarations }
      procedure StartAnimationToHide;
      procedure StartAnimationToShow;
      property PopupCaption: string read GetPopupCaption write SetPopupCaption;
      property PopupMessage: string read GetPopupMessage write SetPopupMessage;
    end;

  var
    frmPopupMessage: TfrmPopupMessage;

  procedure DisplayPopup( sMessage:string; sCaption:string = '');

  implementation

  {$R *.dfm}

  const
     DFT_TIME_SLEEP = 5;       // the speed you want to show/hide.Increase/descrease this to make it faster or slower
     DFT_TIME_VISIBLE = 3000;  // number of mili-seconds the form is visible before starting to disappear
     GAP = 2;                  // pixels between form and right and bottom edge of the screen

  procedure DisplayPopup( sMessage:string; sCaption:string = '');
  begin
     // we could create the form here if necessary ...
     if not Assigned(frmPopupMessage) then Exit;

     frmPopupMessage.PopupCaption := sCaption;
     frmPopupMessage.PopupMessage := sMessage;
     if not frmPopupMessage.bBeingDisplayed
     then begin
        ShowWindow( frmPopupMessage.Handle, SW_SHOWNOACTIVATE);
        frmPopupMessage.Visible := True;
     end;
     frmPopupMessage.StartAnimationToShow;
  end;

  procedure TfrmPopupMessage.FormCreate(Sender: TObject);
  begin
    img.Picture.Assign(Application.Icon);
    Caption := '';
    lblMessage.Caption := '';
    bBeingDisplayed := False;

    ToHiddenPosition();
  end;

  procedure TfrmPopupMessage.FormClose(Sender: TObject; var Action: TCloseAction);
  begin
     tmr.Enabled := False;
     Action := caHide;
     bBeingDisplayed := False;
  end;

  function TfrmPopupMessage.TaskBarHeight: integer; // this is just to get the taskbar height to put
  // my form in the correct position
  var
    hTB: HWND;
    TBRect: TRect;
  begin
    hTB := FindWindow('Shell_TrayWnd', '');
    if hTB = 0 then
      Result := 0
    else
    begin
      GetWindowRect(hTB, TBRect);
      if TBRect.Top = 0  // tray bar is positioned to the left or to the right
      then
         Result := 1
      else
         Result := TBRect.Bottom - TBRect.Top;
    end;
  end;

  function TfrmPopupMessage.TaskBarWidth: integer; // this is just to get the taskbar height to put
  // my form in the correct position
  var
    hTB: HWND;
    TBRect: TRect;
  begin
    hTB := FindWindow('Shell_TrayWnd', '');
    if hTB = 0 then
      Result := 0
    else
    begin
      GetWindowRect(hTB, TBRect);
      if TBRect.Left = 0  // tray bar is positioned to the left or to the right
      then
         Result := 1
      else
         Result := TBRect.Right - TBRect.Left
    end;
  end;

  procedure TfrmPopupMessage.ToHiddenPosition;
  begin
    Self.Left := Screen.Width - TaskbarWidth - Self.Width - GAP;
    Self.Top := Screen.Height - TaskBarHeight;
  end;

  procedure TfrmPopupMessage.ToVisiblePosition;
  begin
    Self.Left := Screen.Width - TaskBarWidth - Self.Width - GAP;
    Self.Top := Screen.Height - Self.Height - TaskBarHeight - GAP;
  end;

  procedure TfrmPopupMessage.StartAnimationToShow;
  var
    i: integer;
  begin
    if bBeingDisplayed
    then
       ToVisiblePosition()
    else begin
       ToHiddenPosition();

       for i := 1 to Self.Height+GAP do
       begin
         Self.Top := Self.Top-1;
         Application.ProcessMessages;
         Sleep(DFT_TIME_SLEEP);
       end;
    end;
    tmr.Interval := DFT_TIME_VISIBLE;
    tmr.Enabled := True;
    bBeingDisplayed := True;

  end;

  procedure TfrmPopupMessage.StartAnimationToHide;
  var
    i: integer;
  begin
    if not bBeingDisplayed then Exit;

    for i := 1 to Self.Height+GAP do
    begin
      Self.Top := Self.Top+1;
      Application.ProcessMessages;
      Sleep(DFT_TIME_SLEEP);
    end;
    bBeingDisplayed := False;
    Visible := False;
  end;

  procedure TfrmPopupMessage.tmrTimer(Sender: TObject);
  begin
     tmr.Enabled := False;
     StartAnimationToHide();
  end;

  function TfrmPopupMessage.GetPopupMessage: string;
  begin
     Result := lblMessage.Caption;
  end;

  procedure TfrmPopupMessage.SetPopupMessage(const Value: string);
  begin
     lblMessage.Caption := Value;
  end;

  function TfrmPopupMessage.GetPopupCaption: string;
  begin
     Result := frmPopupMessage.Caption;
  end;

  procedure TfrmPopupMessage.SetPopupCaption(const Value: string);
  begin
     frmPopupMessage.Caption := Value;
  end;

  end.

在我的带有两个按钮的测试表单中使用：

procedure TfrmMain.button1Click(Sender: TObject);
begin
   DisplayPopup('Message displayed at ' + FormatDateTime('ddd mmm yy zzz', Now),'My Program');
   beep;
end;

procedure TfrmMain.button2Click(Sender: TObject);
begin
   DisplayPopup('Another message displayed at ' + FormatDateTime('hh:nn zzz', Now),'My Program');
end;

消息表单将显示应用程序图标，但我可能会添加一个 TImageList 并添加一个属性来传递图像索引，以便我可以显示不同的图标。我还将使用 Dev.Express 组件中的 TcxLabel，因为这将提供垂直定位，但上述单元可以按原样使用。

我使用 Delphi 7 和 Windows XP 对此进行了测试。如果有人将此单元与其他版本的 Delphi 和/或 Windows Vista 或 Windows 7 一起使用，请告诉我这个单元是否也可以在那里工作。

Answer 1

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
  function TaskBarHeight: integer; // this is just to get the taskbar height to put
  // my form in the correct position
  var
    hTB: HWND;
    TBRect: TRect;
  begin
    hTB := FindWindow('Shell_TrayWnd', '');
    if hTB = 0 then
      Result := 0
    else
    begin
      GetWindowRect(hTB, TBRect);
      Result := TBRect.Bottom - TBRect.Top;
    end;
  end;

begin
  Self.Left := Screen.Width - Self.Width;
  Self.Top := Screen.Height-Self.Height-TaskBarHeight;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
  TimeSleep: integer;
begin
  TimeSleep := 5; // the speed you want to show/hide.Increase/descrease this to make it faster or slower
  for i := 1 to Self.Height do
  begin
    Self.Top := Self.Top+1;
    Sleep(TimeSleep);
  end;
  // now let's show it again(use this as code as the show code)
  for i := 1 to Self.Height do
  begin
    Self.Top := Self.Top-1;
    Sleep(TimeSleep);
  end;
end;

end.

通过http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_25043483.html

Answer 2

TMsnPopUpNotify

http://www.torry.net/vcl/forms/appearence/tmsnpopup.zip

Answer 3

尝试使用 JVCL 中包含的 TJvDesktopAlert 组件，您可以在 jvcl\examples\JvDesktopAlert\JvDesktopAlertDemo.dpr 中找到示例

_{（来源：agnisoft.com）}

Answer 4

您正在搜索的是系统托盘中的气球提示。对于一般的 WinAPI，这里有一个 nice tutorial，你不应该在转换到 Delphi 时遇到问题。

您可以在 Delphi here 中找到一些现成的气球提示代码。

一个不错的实现是available here。

Answer 5

你可以查看任务栏在哪里：

uses ShellAPI;
//...
Var AppBar: TAppbarData;
//...
begin
  FillChar(AppBar, sizeof(AppBar), 0);
  AppBar.cbSize := Sizeof(AppBar);

  if ShAppBarMessage(ABM_GETTASKBARPOS, AppBar) <> 0 then
  begin
    //AppBar.rc is TRect
  end;
end;

然后显示您的表单...

Answer 6

您可以使用Growl for Windows - 我认为还没有适用于它的 Delphi 库，但您可以通过 UDP 消息控制它，因此任何网络库都应该这样做。

Answer 7

查看 Snarl，类似于 Windows 的 Growl，但我发现它更好。 有一个Pas文件可以方便的接口，而且它的工作方式非常简单，只需要发送windows消息。

http://fullphat.net/

它还允许最终用户在一定程度上控制要查看的消息、褪色前的持续时间等。