这些天你看到很多软件显示活动屏幕右下角的消息窗口几秒钟或直到单击关闭按钮(例如诺顿在检查下载后执行此操作)。
我想使用以下方法来做到这一点Delphi 7(如果可能的话德尔福2010,因为我正在慢慢地将代码迁移到最新版本)。
我在这里找到了一些关于表单未获得焦点的帖子,但这只是问题的一部分。我还在考虑如何确定该消息窗口的确切位置(知道用户可能已将其任务栏放在屏幕的右侧。
提前谢谢。
2010 年 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
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.
在我的测试表单中使用两个按钮:
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 一起使用,请告诉我此单元是否也可以在那里工作。