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

2024-04-13

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

我想使用以下方法来做到这一点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 一起使用,请告诉我此单元是否也可以在那里工作。


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 http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_25043483.html

本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

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

  • 查找Delphi项目中的所有编译错误

    我正在对我的 Delphi 项目进行一些重构 我希望能够做出改变 然后看看all项目中因该更改而中断的地方 类似于 Eclipse 列出项目的所有编译错误 在 Java 中 在 Delphi 中 我可以进行更改 然后重新编译我的项目 但编译
  • 如何在 vue.js 中创建用于创建和编辑功能的简单模式?

    我正在尝试创建一个模型以便能够编辑现有数据 我该怎么做呢 我正在使用一个
  • TColorProperty德尔福柏林10.1.2?

    我正在尝试将组件从 Delphi 7 转换为 Delphi Berlin 平面组件 https sourceforge net projects flatstyle https sourceforge net projects flatst
  • Delphi 流畅的界面

    使用上有什么优点和缺点流畅的界面 http en wikipedia org wiki Fluent interface在德尔福 流畅的界面应该会增加可读性 但我对此有点怀疑one包含很多链式方法的长 LOC 是否存在编译器问题 是否存在任
  • Delphi中使用FindVCLWindow调用WinHelp32(WinXP Pro SP3 32bit)

    有什么问题吗 procedure TForm1 VCLHelpClick Sender TObject var Ctrl TWinControl begin Ctrl FindVCLWindow Mouse CursorPos if Ctr
  • 如何比较枚举类型集

    从某个时刻开始 我厌倦了编写设定条件 and or 因为对于更多的条件或更长的变量名 重新编写会变得笨拙且烦人 所以我开始写助手这样我就可以写ASet ContainsOne ceValue1 ceValue2 代替 ceValue1 in
  • 阻止 IDE 自动添加使用单位

    我正在将 Lazarus 项目转移到德尔福西雅图 Lazarus 项目依赖于 40 多个单元 包括控件 并具有多种应用程序 在所有项目的使用条款中 他们使用了以下内容 uses Classes SysUtils Forms Controls
  • 电话输入自动填充会删除国际前缀

    我有一个类型为 tel 的输入字段 并启用了自动完成功能
  • H2161 重复资源[一个VCL项目可以有2个类名相同但命名空间不同的表单吗?]

    我尝试在 2 个不同的命名空间中创建具有相同类名的 2 个表单 FirstNameSpace ExampleFormName TExampleFormName SecondNameSpace ExampleFormName TExample
  • 在 Laravel 中的编辑表单上获取选定选项

    我的网站订单有一个可编辑的表单 并且有以下字段 User quantity note status 我在此表单中还有其他选项 但只有这些字段对我来说很重要 以便能够获取默认值 例如 我希望能够查看用户默认订购的数量 然后我可以更改它或保留它
  • 从其可执行文件的路径获取服务名称

    我有一个可执行文件的路径 它是一个正在运行的服务应用程序 例如 C Program Files x86 Someapp somesvc exe 我想停止并启动它 为此我想我需要获取服务的名称 如下所示 this https stackove
  • Delphi 中表单分发与其生命周期相关的接口对象的安全方法?

    我有一个 Delphi 表单 它提供接口对象背后的功能 代码的其他部分也通过属于该表单的属性获取引用 我无法将接口功能委托给子对象 因为太多的功能是由表单上的控件 组件提供的 我无法使用 TAggregateObject 或 TContai
  • Delphi 的内存分析工具?

    我建立了一个项目并运行它 然后在 Process Explorer 中查看它 结果发现它在启动时使用的 RAM 比我想象的要多 5 倍 现在 如果我的程序运行得太慢 我会将其连接到分析器并让它告诉我什么正在使用我的所有周期 有没有类似的工具
  • FireMonkey iOS RAD Studio XE2 - 在从 URL 加载的表单上显示图像

    是否可以将 TImage 放置在 iOS 的 FMX 表单上 并将图像 jpg 从 URL 加载到此 TImage 中以在 iOS 应用程序中显示 我尝试过但没有成功 任何正确方向的提示或指出都会受到赞赏 将 TButton TImageC
  • 如何在拥有句柄时检查给定进程是否正在运行

    我在用ShellExecuteEx启动应用程序 成功开始阅读后TShellExecuteInfo hProcess获取已启动进程的句柄 我想定期检查我的应用程序启动的进程是否仍在运行 两个或多个同名进程可以同时运行 我想确保我的应用程序正在
  • 如何在按键时识别 unicode 键?

    我的应用程序使用 unicode 字符 并且我有几个文本字段 我想限制用户输入特殊字符 例如 begin if not Key in a z A Z 0 9 13 8 then Key 0 if Key 13 then bOk Click
  • Delphi 7 - 处理表单中嵌入框架的 MouseWheel 事件?

    你好 我有一个表格 里面有几个框架 对于某些框架 我希望滚动内容 或至少处理鼠标滚轮事件 我已经尝试过以下方法 只需为每个帧分配一个 OnMouseWheel 事件处理程序 重写父窗体的 MouseWheel 事件 procedure TF
  • Delphi:现场记录应用程序错误

    使用 Delphi 7 我想知道是否有一个免费组件可以在我的应用程序在远程站点运行时收集诊断信息并帮助我调试错误报告 也许它会记录每个选择的菜单项 单击的控件 文本输入等 也许它只是在崩溃时转储堆栈 也许它还有其他作用 我不介意添加代码 例
  • TFrame继承重构

    我提出的另一个 TFrame IDE 注册组件问题 感谢各位程序员的帮助 尝试 Darrian 的 TFrame 继承建议here https stackoverflow com questions 382562 delphi visual
  • 为什么 TImage 旋转我的图像?

    编写一个移动应用程序 它从安全网站提取图像 如下所示 第一个图像 提取不正确 注意网络版本与移动版本 第二个图像在网站上正确显示 但 Delphi TImage 由于某种原因正在旋转它我不明白为什么 旋转设置为 0 并且在 TImage 组

随机推荐

  • 时间:2019-03-14 标签:c++

    我正在编写一个 C 应用程序 我有一个类变量 多个线程正在写入该变量 在 C 中 任何可以在编译器 意识到 正在更改的情况下进行修改的内容都需要标记为易失性 对吧 因此 如果我的代码是多线程的 并且一个线程可能写入 var 而另一个线程从中
  • Swift 的标准库和名称冲突

    我知道 Swift 不使用命名空间 但名称是在每个模块中定义的 首先 我不太明白这是如何避免名称冲突的 请随意详细说明 尽管如此 我的主要问题是 假设我想要一个不使用 NSTreeNode 的树结构 所以我创建了自己的类 名为 TreeNo
  • Op 类型未在二进制中注册“SentencepieceEncodeSparse”

    我部署了一个模型 该模型使用 tfhub 模型来使用 docker 进行张量流服务 这是我的模型中包含的 tfhub 模型 https tfhub dev google universal sentence encoder multilin
  • DropboxAPI 入门,未找到类

    我第一次尝试使用 Dropbox API 但在启动应用程序时遇到此错误 Caused by java lang NoClassDefFoundError com dropbox client2 session Session AccessT
  • 异步任务中的异常在 Visual Studio 中被拦截

    我想运行多个任务 其中一些任务可以完成异步 然后等待所有任务完成 由于任务可能会引发异常 因此我想捕获并记录它们 sample code for that static async Task doit int x try Console W
  • 具有条件选择动作的剑道网格列

    这是我得到的 columns Bound t gt t Id Title Template
  • 处理 execvp 的参数数组?

    当我打电话时execvp 例如execvp echo b 其中 b 是命令 a 的参数数组 稍后更改该数组是否会影响之前进行的 execvp 调用 当我尝试调用 execp echo b 时 它最终打印出 null 而不是 b 内部的内容
  • Fetch API:从http响应中获取标题、关键字和正文

    我想知道使用 fetch api 有没有办法在同源发出 XMLHttpRequest 时不发送 cookie https stackoverflow com questions 9028234 is there a way to not s
  • 两指或小指缩放至 osmdroid 中的地图视图

    我需要帮助我正在尝试通过让用户多触摸点 首先是 2 根手指触摸 来缩放地图视图 我知道有 setMultiTouchControls 函数 但这不是我想要做的 我尝试用图片来解释 这比写作更容易 黑色粗体箭头表示手指的移动方向 相反方向也可
  • 如何停止已部署的 docker 堆栈?

    我刚刚完成了初学者 Docker 教程 https github com docker labs blob master beginner chapters votingapp md并想知道如何清理 我使用以下命令部署了一个堆栈和一些不同的
  • Firebase - 在不知道其成员的注册 ID 的情况下删除设备组

    在使用 Firebase 和设备组时 我正在测试令牌 注册 ID 发生更改的情况 例如重新安装应用程序后 但我的逻辑失败了 因为重新安装应用程序后我无法再知道以前存储的令牌 问题是现在我有一个设备组有两个 ghost 我不再知道的注册 ID
  • google +1 按钮向我的网站添加滚动条

    我的网站上有一个 google 1 按钮已经一年多了 一切都运行良好 在过去的几天里 这个按钮开始在我的网站上创建一个水平滚动条 我知道 因为当我删除按钮时 滚动条就会消失 这是我的网站 www kitchen guide co il ht
  • sonarqube 6.6 升级:不可恢复的索引失败

    sonarqube 从 6 5 升级到 6 6 使用 Debian 软件包 后 sonar 无法启动 升级之前我没有更新插件 我只是让标准的 Debian 软件包升级 我正在使用外部数据库 Postgresql 我在 web log 中发现
  • mysql搜索时如何忽略大小写的区别

    mysql搜索时如何忽略大小写的区别 做这样的事情 SELECT user FROM users WHERE UPPER user UPPER moustafa 基本上 您将结果转换为一种大小写 并与也转换为大写的搜索词进行比较 从而有效地
  • 在 C++ 中构造对象的不同方法

    我想使用 C 在堆栈中构造一个对象 你知道这两种调用构造函数的方式 带括号和不带括号 有什么区别吗 a MyClass object b MyClass object 我正在使用 MFC 在为主应用程序构造全局变量时 如果我使用后一种方式
  • React Router 4 中 URL 更改但视图未更改

    我使用的是react router 4而不是react router 3 所以我使用的是react router dom 我试图让 this props history push 工作 但它所做的只是保持视图相同 但 URL 发生了变化 例
  • 如何获取打开的文件弹出窗口

    现在 我有一个设置的类路径 但我想要弹出一个打开的文件 并且用户选择要打开的文件 我尝试过 JFileChooser 但到目前为止还没有成功 这是我的代码 public static void main String args throws
  • 在 PHP 中删除数组项的最佳方法是什么?

    您能告诉我从数组中删除项目的方法吗 你觉得这样好吗 那要看 a1 array a gt 1 b gt 2 c gt 3 unset a1 b array a gt 1 c gt 3 a2 array 1 2 3 unset a2 1 arr
  • 可以在 t4 模板中使用全局变量吗?

    如何在 TT 文件中使用全局变量 如果我在标头中声明一个变量 并且在函数中引用它 则会出现编译错误 lt template debug false hostspecific false language C gt lt output ext
  • 如何使用Delphi在活动显示器的右下角显示消息窗口

    这些天你看到很多软件显示活动屏幕右下角的消息窗口几秒钟或直到单击关闭按钮 例如诺顿在检查下载后执行此操作 我想使用以下方法来做到这一点Delphi 7 如果可能的话德尔福2010 因为我正在慢慢地将代码迁移到最新版本 我在这里找到了一些关于