如何使用Delphi在活动显示的右下角显示消息窗口 [英] How to display a message window in the right bottom corner of the active display using Delphi

问题描述

这些天，您会看到许多软件在活动屏幕的右下角显示消息窗口几秒钟，或者直到关闭按钮被点击（fi诺顿在检查之后执行此操作

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

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

Thx提前。

更新26一月，10： 从代码 drorhan 我创建了以下表单（在Delphi 7中），无论任务栏是显示在底部，右边，左边还是顶部，都可以使用。

  fPopupMessage.dpr：
 
对象frmPopupMessage：TfrmPopupMessage 
 Left = 537 
顶部= 233 
 AlphaBlend = True 
 AlphaBlendValue = 200 
 BorderStyle = bsToolWindow 
 Caption ='frmPopupMessage'
 ClientHeight = 48 
 ClientWidth = 342 
颜色= clBtnFace 
字体.Charset = DEFAULT_CHARSET 
 Font.Color = clWindowText 
 Font.Height = -11 
 Font.Name ='MS Sans Serif'
 Font.Style = [] 
 OldCreateOrde r = False 
 OnClose = FormClose 
 OnCreate = FormCreate 
 DesignSize =（
 342 
 48）
 PixelsPerInch = 96 
 TextHeight = 13 
对象img：TImage 
 Left = 0 
顶部= 0 
宽度= 64 
高度= 48 
 Align = alLeft 
 Center = True 
透明= True 
结束
对象lblMessage：TLabel 
左= 72 
顶部= 8 
宽度= 265 
高度= 34 
对齐= 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 
透明= True 
 WordWrap = True 
 end 
对象tmr：TTimer 
启用= False 
间隔= 3000 
 OnTimer = tmrTimer 
左= 16 
顶部= 16 
结束
结束
  

和

fPopupMessage.pas

  unit fPopupMessage; 
 
接口
 
使用
 Windows，消息，SysUtils，变体，类，图形，控件，窗体，
对话框，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 
 {私有声明} 
 bBeingDisplayed：boolean; 
函数GetPopupMessage：string; 
程序SetPopupMessage（const value：string）; 
函数GetPopupCaption：string; 
程序SetPopupCaption（const Value：string）; 
函数TaskBarHeight：integer; 
 function TaskBarWidth：integer; 
程序ToHiddenPosition; 
程序ToVisiblePosition; 
 public 
 {公开声明} 
程序StartAnimationToHide; 
程序StartAnimationToShow; 
属性PopupCaption：string读取GetPopupCaption写入SetPopupCaption; 
属性PopupMessage：string读取GetPopupMessage写入SetPopupMessage; 
结束
 
 var 
 frmPopupMessage：TfrmPopupMessage; 
 
 procedure DisplayPopup（sMessage：string; sCaption：string =''）; 
 
执行
 
 {$ R * .dfm} 
 
 const 
 DFT_TIME_SLEEP = 5; //你想显示/隐藏的速度。增加/降低这个速度使其更快或更慢
 DFT_TIME_VISIBLE = 3000; //开始消失之前窗体可见的米莉秒数
 GAP = 2; //屏幕的窗体和右下边缘之间的像素
 
 procedure DisplayPopup（sMessage：string; sCaption：string =''）; 
 begin 
 //如果需要，我们可以在这里创建表单... 
如果没有分配（frmPopupMessage）然后退出; 
 
 frmPopupMessage.PopupCaption：= sCaption; 
 frmPopupMessage.PopupMessage：= sMessage; 
如果不是frmPopupMessage.bBeingDisplayed 
然后开始
 ShowWindow（frmPopupMessage.Handle，SW_SHOWNOACTIVATE）; 
 frmPopupMessage.Visible：= True; 
结束
 frmPopupMessage.StartAnimationToShow; 
结束
 
程序TfrmPopupMessage.FormCreate（发件人：TObject）; 
 begin 
 img.Picture.Assign（Application.Icon）; 
 Caption：=''; 
 lblMessage.Caption：=''; 
 bBeingDisplayed：= False; 
 
 ToHiddenPosition（）; 
结束
 
程序TfrmPopupMessage.FormClose（发件人：TObject; var Action：TCloseAction）; 
 begin 
 tmr.Enabled：= False; 
动作：= caHide; 
 bBeingDisplayed：= False; 
结束
 
函数TfrmPopupMessage.TaskBarHeight：integer; //这只是为了让任务栏的高度把
 //我的表单放在正确的位置
 var 
 hTB：HWND; 
 TBRect：TRect; 
 begin 
 hTB：= FindWindow（'Shell_TrayWnd'，''）; 
如果hTB = 0，那么
结果：= 0 
 else 
 begin 
 GetWindowRect（hTB，TBRect）; 
如果TBRect.Top = 0 //托盘栏位于左侧或右侧
然后
结果：= 1 
 else 
结果：= TBRect。底部 -  TBRect.Top; 
结束
结束
 
函数TfrmPopupMessage.TaskBarWidth：integer; //这只是为了让任务栏的高度把
 //我的表单放在正确的位置
 var 
 hTB：HWND; 
 TBRect：TRect; 
 begin 
 hTB：= FindWindow（'Shell_TrayWnd'，''）; 
如果hTB = 0，那么
结果：= 0 
 else 
 begin 
 GetWindowRect（hTB，TBRect）; 
如果TBRect.Left = 0 //托盘栏位于左侧或右侧
然后
结果：= 1 
 else 
结果：= TBRect。右 -  TBRect.Left 
结束; 
结束
 
程序TfrmPopupMessage.ToHiddenPosition; 
 begin 
 Self.Left：= Screen.Width  -  TaskbarWidth  -  Self.Width  -  GAP; 
 Self.Top：= Screen.Height  -  TaskBarHeight; 
结束
 
程序TfrmPopupMessage.ToVisiblePosition; 
 begin 
 Self.Left：= Screen.Width  -  TaskBarWidth  -  Self.Width  -  GAP; 
 Self.Top：= Screen.Height  -  Self.Height  -  TaskBarHeight  -  GAP; 
结束
 
程序TfrmPopupMessage.StartAnimationToShow; 
 var 
 i：integer; 
 begin 
如果bBeingDisplayed 
然后
 ToVisiblePosition（）
 else begin 
 ToHiddenPosition（）; 
 
 for i：= 1 to Self.Height + GAP do 
 begin 
 Self.Top：= Self.Top-1; 
 Application.ProcessMessages; 
睡眠（DFT_TIME_SLEEP）; 
结束
结束
 tmr.Interval：= DFT_TIME_VISIBLE; 
 tmr.Enabled：= True; 
 bBeingDisplayed：= True; 
 
 end; 
 
程序TfrmPopupMessage.StartAnimationToHide; 
 var 
 i：integer; 
 begin 
如果不是bBeingDisplayed然后退出; 
 
 for i：= 1 to Self.Height + GAP do 
 begin 
 Self.Top：= Self.Top + 1; 
 Application.ProcessMessages; 
睡眠（DFT_TIME_SLEEP）; 
结束
 bBeingDisplayed：= False; 
可见：= False; 
结束
 
程序TfrmPopupMessage.tmrTimer（Sender：TObject）; 
 begin 
 tmr.Enabled：= False; 
 StartAnimationToHide（）; 
结束
 
函数TfrmPopupMessage.GetPopupMessage：string; 
 begin 
结果：= lblMessage.Caption; 
结束
 
程序TfrmPopupMessage.SetPopupMessage（const Value：string）; 
 begin 
 lblMessage.Caption：= Value; 
结束
 
函数TfrmPopupMessage.GetPopupCaption：string; 
 begin 
结果：= frmPopupMessage.Caption; 
结束
 
程序TfrmPopupMessage.SetPopupCaption（const Value：string）; 
 begin 
 frmPopupMessage.Caption：= Value; 
结束
 
结束。 
  

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

  procedure TfrmMain.button1Click（Sender：TObject）; 
 begin 
 DisplayPopup（'消息显示在'+ FormatDateTime（'ddd mmm yy zzz'，Now），'我的程序'）; 
哔哔声
结束
 
程序TfrmMain.button2Click（发件人：TObject）; 
 begin 
 DisplayPopup（'另一个消息显示在'+ FormatDateTime（'hh：nn zzz'，Now），'我的程序'）; 
结束
  

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

我用Delphi 7进行了测试和Windows XP。如果有人使用这个单元与另一个版本的Delphi和/或Windows Vista或Windows 7，请告诉我这个单位是否也会在那里工作。

解决方案

  unit Unit1; 
 
接口
 
使用
 Windows，消息，SysUtils，变体，类，图形，控件，窗体，
对话框，StdCtrls; 
 
 type 
 TForm1 = class（TForm）
 Button1：TButton; 
 procedure FormCreate（Sender：TObject）; 
 procedure Button1Click（Sender：TObject）; 
 private 
 {私人声明} 
 public 
 {公开声明} 
 end; 
 
 var 
 Form1：TForm1; 
 
实现
 
 {$ R * .dfm} 
 
程序TForm1.FormCreate（发件人：TObject）; 
函数TaskBarHeight：integer; //这只是为了让任务栏的高度把
 //我的表单放在正确的位置
 var 
 hTB：HWND; 
 TBRect：TRect; 
 begin 
 hTB：= FindWindow（'Shell_TrayWnd'，''）; 
如果hTB = 0，那么
结果：= 0 
 else 
 begin 
 GetWindowRect（hTB，TBRect）; 
结果：= TBRect.Bottom  -  TBRect.Top; 
结束
结束
 
 begin 
 Self.Left：= Screen.Width  -  Self.Width; 
 Self.Top：= Screen.Height-Self.Height-TaskBarHeight; 
结束
 
 procedure TForm1.Button1Click（Sender：TObject）; 
 var 
 i：integer; 
 TimeSleep：integer; 
 begin 
 TimeSleep：= 5; //你想显示/隐藏的速度。增加/减少这个以使其更快或更慢
对于i：= 1到Self.Height do 
 begin 
 Self.Top：= Self .Top + 1; 
睡眠（TimeSleep）; 
结束
 //现在让我们再次显示（使用代码作为显示代码）
 for i：= 1 to Self.Height do 
 begin 
 Self.Top：= Self .Top-1; 
睡眠（TimeSleep）; 
结束
结束
 
结束。 
  

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

These days you see a lot of software displaying message windows in the right bottom corner of the active screen for a few seconds or until a close button is clicked (f.i. Norton does this after it has checked a download).

I would like to do this using Delphi 7 (and if possible Delphi 2010, since I am slowly migrating my code to the latest version).

I found some posts here on SO regarding forms not receiving focus, but that's only one part of the problem. I'm thinking also on how to determine the exact position of this message window (knowing that f.i. a user may have put his taskbar to the right of the screen.

Thx in advance.

UPDATE 26 Jan, 10: Starting from the code of drorhan I created the following form (in Delphi 7) which works whether the taskbar is displayed at the bottom, the right, the left or the top of the schreen.

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

and

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.

To be used as in my test form with two buttons:

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;

The message form will display the application icon, but I will probably add a TImageList and add a property to pass an image index so I can display different icons. I will also use the TcxLabel from the Dev.Express components as this will provide verticle positionting, but the above unit can be used as is.

I tested this with Delphi 7 and Windows XP. If anyone uses this unit with another version of Delphi and/or Windows Vista or Windows 7, please tell me if this unit will work there too.

解决方案

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.

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

这篇关于如何使用Delphi在活动显示的右下角显示消息窗口的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！