forms - 如何使用Delphi在事件显示器的右下角显示消息窗口

标签 forms delphi

如今,您会看到很多软件在事件屏幕的右下角显示消息窗口几秒钟或直到单击关闭按钮(例如,诺顿在检查后会执行此操作)下载)。

我想使用Delphi 7(如果可能的话使用Delphi 2010,因为我正在慢慢地将代码迁移到最新版本)来执行此操作。

我在这里找到了一些关于表单未获得焦点的帖子,但这只是问题的一部分。我还在考虑如何确定此消息窗口的确切位置(知道用户可能已将其任务栏放在屏幕的右侧。

提前致谢。

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 一起使用,请告诉我此单元是否也可以在那里工作。

最佳答案

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

关于forms - 如何使用Delphi在事件显示器的右下角显示消息窗口,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/2132108/

相关文章:

delphi - 如何使用 LeakCheck 处理 DUnit 中的 "false"/expected 内存?

delphi - 如何初始化声明为局部变量的记录?

javascript - 在垂直列中动态创建 HTML 表单

php - 使用 PHP 将查询转换为单选按钮以供选择

jquery - 按钮 onclick this.form.submit 调用验证函数

windows - 如何检查网络共享EXE文件是否被多个用户使用?

c++ - 如何将 DLL 注入(inject) Delphi 程序

forms - 如何让浏览器有选择地忽略表单上的 HTML5 必需属性

jquery - symfony 表单在输入类型 ="choice"上使用 jquery 更改方法

delphi - 自动构建脚本