Как отобразить окно сообщения в правом нижнем углу активного дисплея с помощью Delphi

Question

В наши дни вы видите много программ, отображающих окна сообщений в правом нижнем углу активного экрана в течение нескольких секунд или до нажатия кнопки закрытия (например, Нортон делает это после того, как проверил скачать).

Я хотел бы сделать это, используя Delphi 7 (и, если возможно, Delphi 2010 , поскольку я медленно переношу свой код на последнюю версию).

Я нашел некоторые посты здесь на SO относительно форм, не получающих фокуса, но это только одна часть проблемы. Я также думаю о том, как определить точное положение этого окна сообщения (зная, что, например, пользователь, возможно, поместил свою панель задач справа от экрана.

Спасибо заранее.

ОБНОВЛЕНИЕ 26 января, 10: Начиная с кода 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 и добавлю свойство для передачи индекса изображения, чтобы я мог отображать различные значки. Я также буду использовать TcxLabel из компонентов Dev.Express, поскольку это обеспечит позиционирование по вертикали, но вышеуказанный блок можно использовать как есть.

Я проверил это с Delphi 7 и Windows XP. Если кто-либо использует это устройство с другой версией Delphi и / или Windows Vista или Windows 7, скажите, пожалуйста, будет ли оно работать и там.

Answer 1

Попробуйте использовать компонент TJvDesktopAlert, который включен в JVCL , пример можно найти в jvcl \ examples \ JvDesktopAlert \ JvDesktopAlertDemo.dpr

_{(источник: agnisoft.com )}

Answer 2

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 / Программирование / Языки / Pascal / Delphi / Q_25043483.html

Answer 3

То, что вы ищете, - это подсказки в системном трее. Для общего WinAPI вот хороший учебник , чтобы у вас не было проблем с переводом на Delphi.

Вы можете найти готовый код для подсказок в Delphi здесь .

Хорошая реализация доступна здесь .

Answer 4

Проверьте Snarl, похожий на Growl для Windows, но я обнаружил, что он лучше. Существует файл Pas для простого взаимодействия, и способ его работы очень прост, просто отправляя сообщения Windows.

http://fullphat.net/

Это также позволяет конечному пользователю некоторое количество контроля над тем, какие сообщения видеть, длительность до исчезновения и т. Д.

Answer 5

TMsnPopUpNotify

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

Answer 6

Вы можете использовать Growl для Windows - я не думаю, что для него пока есть библиотека Delphi, но вы можете управлять ею с помощью сообщений UDP, так что любая сетевая библиотека должна это делать.

Answer 7

Вы можете проверить, где находится панель задач:

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;

А потом покажи свою форму ...