Вопросы Теги

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

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

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

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

Заранее спасибо.

ОБНОВИТЕ 26 января, 10: Запуск с кода drorhan Я создал следующую форму (в Delphi 7), который работает, отображена ли панель задач внизу, право, левые или вершина 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

и

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. Специальные компоненты, поскольку это обеспечит verticle positionting, но вышеупомянутая единица может быть использована как есть.

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

6
задан Robert Harvey 13 November 2013 в 18:26
поделиться

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

3
ответ дан 8 December 2019 в 18:36
поделиться

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

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;

, а затем показать свою форму ...

1
ответ дан 8 December 2019 в 18:36
поделиться

Что вы ищете, являются наконечниками Balloon в системном лотке. Для General WinApi здесь хорошее учебное пособие для него, что у вас не должно быть проблем, переведенных в Delphi.

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

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

2
ответ дан 8 December 2019 в 18:36
поделиться

Попробуйте использовать компонент TJVDESKTOPALERT, который включен в JVCL , вы можете найти пример в JVCL \ Examples \ JVDESKTOPALERT \ JVDESKTOPALERTDEMO.DPR

alt text
(Источник: Agnisoft.com )

4
ответ дан 8 December 2019 в 18:36
поделиться

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

1
ответ дан 8 December 2019 в 18:36
поделиться

TMSNPopupnotify

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

1
ответ дан 8 December 2019 в 18:36
поделиться

Проверьте Snarl, похоже на рычание для Windows, но я нашел лучше. Для легко интерфейса есть файл PA PAS, и так, как он работает, очень прост, просто отправляя сообщения Windows.

http://fullphat.net/

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

1
ответ дан 8 December 2019 в 18:36
поделиться
Другие вопросы по тегам:

Похожие вопросы: