Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2009.08.30;
Скачать: [xml.tar.bz2];

Вниз

Окно, всплывающее над панелью системного трея   Найти похожие ветки 

 
Dr. Genius   (2009-07-03 21:32) [0]

Здравствуйте!

Если скачать из Интернета какой-нибудь файл через браузер Mozilla Firefox, то прямо над панелью системного трея всплывает маленькое окошко с уведомлением, что все загрузки завершены. Как реализовать такое же окно в Delphi?

Может быть, есть какой-нибудь компонент для этой цели…


 
turbouser ©   (2009-07-03 22:39) [1]


> Dr. Genius   (03.07.09 21:32)  


> Может быть, есть какой-нибудь компонент для этой цели…

Есть. google + tray balloon hint
http://www.google.ru/search?hl=ru&client=firefox&rls=org.mozilla:ru:official&hs=RNT&newwindow=1&ei=Ql BOSunFC862sgayif3wBw&sa=X&oi=spell&resnum=0&ct=result&cd=1&q=tray+balloon+hint&spell=1


 
DVM ©   (2009-07-03 22:46) [2]


unit AlertWindow;

interface

uses
 Windows, Classes, Messages, Controls, Forms, ExtCtrls, Graphics,
 SysUtils, ShellApi;

type
 TAlertDirection = (adNone, adUp, adDown, adLeft, adRight);
 TOnShow = procedure (Sender: TObject) of object;
 TOnClose = procedure (Sender: TObject) of object;

type
TAlertWindow = class(TCustomControl)
 private
  FAlertDirection: TAlertDirection;
   FCloseDelay: Integer;
   FDelayTimer: TTimer;
   FForegroundColor: TColor;
   FInProgress: Boolean;
   FOnShow: TOnShow;
   FOnClose: TOnClose;
   TaskBarRect: TRect;
   function FindTaskbar(var ARect: TRect): Integer;
   procedure GetTaskBar;
   procedure SetCloseDelay(const Value: Integer);
   procedure SetForegroundColor(const Value: TColor);
   procedure GoPopUp;
 protected
   procedure CreateParams(var Params: TCreateParams); override;
   procedure CreateWnd; override;
   procedure DoDelayTimer(Sender: TObject);
   procedure Paint; override;
   procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
   procedure WMSize(var Message: TWMSize); message WM_SIZE;
 public
  constructor Create(AOwner: TComponent); override;
  procedure PopUp;
  procedure CloseUp;
   procedure Show(X, Y: Integer);
 published
   property CloseDelay: Integer read FCloseDelay write SetCloseDelay;
   property Font;
   property ForegroundColor: TColor read FForegroundColor write SetForegroundColor;
   property OnShow: TOnShow read FOnShow write FOnShow;
   property OnClose: TOnClose read FOnClose write FOnClose;
   property OnClick;
   property OnContextPopup;
   property OnDblClick;
   property OnDragDrop;
   property OnDragOver;
   property OnEndDock;
   property OnEndDrag;
   property OnMouseDown;
   property OnMouseMove;
   property OnMouseUp;
   property OnStartDock;
   property OnStartDrag;
 end;

procedure Register;

var
 TaskBarPos: Cardinal;

implementation

//------------------------------------------------------------------------------

procedure Register;
begin
 RegisterComponents("Samples", [TAlertWindow]);
end;

//------------------------------------------------------------------------------

function WindowAnimate(Wnd: HWND; dwTime: DWORD; dwFlags: DWORD): BOOL;
type
 TWndAnimate = function (h: HWND; Time: DWORD; Flags: DWORD): BOOL; stdcall;
var
 WndAnimate: TWndAnimate;
begin
 @WndAnimate := GetProcAddress(GetModuleHandle(PChar("user32.dll")), PChar("AnimateWindow"));
 Result := Assigned(@WndAnimate);
 if Result then
   Result := WndAnimate(Wnd, dwTime, dwFlags);

end;

//------------------------------------------------------------------------------

constructor TAlertWindow.Create(AOwner: TComponent);
begin
 inherited;
 Visible := csDesigning in ComponentState;
 ControlStyle := ControlStyle + [csAcceptsControls, csReplicatable];
 FAlertDirection := adNone;
 FCloseDelay := 5000;
 FForegroundColor := clInfoBk;
 FInProgress := False;
 FDelayTimer := TTimer.Create(Self);
 FDelayTimer.Enabled := False;
 FDelayTimer.OnTimer := DoDelayTimer;
 FDelayTimer.Interval := FCloseDelay;
 FOnShow := nil;
 ParentColor := true;
 Height := 150;
 Width := 150;
end;

//------------------------------------------------------------------------------

procedure TAlertWindow.CreateParams(var Params: TCreateParams);
begin
 inherited CreateParams(Params);
 with Params do
  if not (csDesigning in ComponentState) then
   begin
    WndParent:= GetDesktopWindow;
     Style:= WS_CLIPSIBLINGS or WS_CHILD;
    ExStyle:= WS_EX_TOPMOST or WS_EX_TOOLWINDOW;
     WindowClass.Style:= CS_DBLCLKS or CS_SAVEBITS and not(CS_HREDRAW or CS_VREDRAW);
  end;
end;

//------------------------------------------------------------------------------

procedure TAlertWindow.CreateWnd;
begin
 inherited;
end;

//------------------------------------------------------------------------------

procedure TAlertWindow.SetCloseDelay(const Value: Integer);
begin
 FCloseDelay := Value;
 FDelayTimer.Interval := Value;
end;

//------------------------------------------------------------------------------

procedure TAlertWindow.SetForegroundColor(const Value: TColor);
begin
 FForegroundColor := Value;
 Invalidate;
end;

//------------------------------------------------------------------------------

procedure TAlertWindow.DoDelayTimer(Sender: TObject);
begin
 FInProgress := False;
 FDelayTimer.Enabled := False;
 CloseUp;
end;

//------------------------------------------------------------------------------



 
DVM ©   (2009-07-03 22:46) [3]


procedure TAlertWindow.GoPopUp;
begin
 if Assigned(FOnShow) then FOnShow(Self);
 case FAlertDirection of
   adUp:
   begin
     SetWindowPos(Handle, HWND_TOPMOST, TaskbarRect.Right - Width,
                                        TaskbarRect.Top - Height,
                                        Width,
                                        Height,
                                        SWP_HIDEWINDOW);
     AnimateWindow(Handle, 500, AW_VER_NEGATIVE or AW_SLIDE);
     FDelayTimer.Enabled := True;
   end;

   adDown:
   begin
     SetWindowPos(Handle, HWND_TOPMOST, TaskbarRect.Right - Width,
                                        TaskbarRect.Bottom,
                                        Width,
                                        Height,
                                        SWP_HIDEWINDOW);
     AnimateWindow(Handle, 500, AW_VER_POSITIVE or AW_SLIDE);
     FDelayTimer.Enabled := True;
   end;
   adLeft:
   begin
     SetWindowPos(Handle, HWND_TOPMOST,  TaskbarRect.Left - Width,
                                         TaskbarRect.Bottom - Height,
                                         Width,
                                         Height,
                                         SWP_HIDEWINDOW);
     AnimateWindow(Handle, 500, AW_HOR_NEGATIVE or AW_SLIDE);
     FDelayTimer.Enabled := True;
   end;
   adRight:
   begin
     SetWindowPos(Handle, HWND_TOPMOST, TaskbarRect.Right,
                                        TaskbarRect.Bottom - Height,
                                        Width,
                                        Height,
                                        SWP_HIDEWINDOW);
     AnimateWindow(Handle, 500, AW_HOR_POSITIVE or AW_SLIDE);
     FDelayTimer.Enabled := True;
   end;
 end;
end;

//------------------------------------------------------------------------------

procedure TAlertWindow.CloseUp;
var
 OldPos: Cardinal;
begin
 if Assigned(FOnClose) then FOnClose(Self);
 OldPos := TaskBarPos;
 GetTaskBar;
 FDelayTimer.Enabled := False;
 if OldPos <> TaskBarPos then
   FAlertDirection := adNone;

 case FAlertDirection of
   adUp:
     AnimateWindow(Handle, 500, AW_VER_POSITIVE or AW_SLIDE or AW_HIDE);
   adDown:
     AnimateWindow(Handle, 500, AW_VER_NEGATIVE or AW_SLIDE or AW_HIDE);
   adLeft:
     AnimateWindow(Handle, 500, AW_HOR_POSITIVE or AW_SLIDE or AW_HIDE);
   adRight:
     AnimateWindow(Handle, 500, AW_HOR_NEGATIVE or AW_SLIDE or AW_HIDE);
   adNone:
     AnimateWindow(Handle, 500, AW_CENTER or AW_SLIDE or AW_HIDE);
 end;
end;

//------------------------------------------------------------------------------

procedure TAlertWindow.Show(X, Y: Integer);
begin
 if Assigned(FOnShow) then FOnShow(Self);
 FInProgress := True;
 SetWindowPos(Handle, HWND_TOPMOST, X, Y,
              Width, Height, SWP_HIDEWINDOW);
 AnimateWindow(Handle, 500, AW_CENTER + AW_SLIDE);
 FAlertDirection := adNone;
 FDelayTimer.Enabled := True;
end;

//------------------------------------------------------------------------------

procedure TAlertWindow.WMNCPaint(var Message: TMessage);
begin
 inherited;
end;

//------------------------------------------------------------------------------

procedure TAlertWindow.WMSize(var Message: TWMSize);
begin
 inherited;
end;

//------------------------------------------------------------------------------

procedure TAlertWindow.Paint;
var
 R: TRect;
begin
 inherited;
with Canvas do
 begin
   Brush.Color:= ForegroundColor;
   FillRect(ClientRect);
   R := ClientRect;
   OffsetRect(R, R.Left, R.Top);
   DrawEdge(Handle, R, EDGE_RAISED, BF_RECT);
   InflateRect(R, -2, -2);
   DrawEdge(Handle, R, EDGE_SUNKEN, BF_RECT);
 end;
end;

//------------------------------------------------------------------------------

procedure TAlertWindow.Popup;
begin
 ShowWindow(Handle, SW_HIDE);
 GetTaskBar;
 case TaskBarPos of
   ABE_BOTTOM:
    FAlertDirection := adUp;
   ABE_TOP:
     FAlertDirection := adDown;
   ABE_LEFT:
     FAlertDirection := adRight;
   ABE_RIGHT:
     FAlertDirection := adLeft;
 end;
 FInProgress:= True;
 GoPopUp;
end;

//------------------------------------------------------------------------------

function TAlertWindow.FindTaskbar(var ARect: TRect): Integer;
var
AppData: TAppBarData;
begin
 ZeroMemory(@AppData, SizeOf(TAppBarData));
 AppData.rc := Rect(0, Screen.Height, Screen.Width, Screen.Height);
 AppData.Hwnd := FindWindow("Shell_TrayWnd", nil);
 AppData.uEdge := ABE_BOTTOM;
 AppData.cbSize:= SizeOf(TAppBarData);
 if AppData.Hwnd <> 0 then
   SHAppBarMessage(ABM_GETTASKBARPOS, AppData);
 Result := AppData.uEdge;
 ARect := AppData.rc;
end;

//------------------------------------------------------------------------------

procedure TAlertWindow.GetTaskBar;
begin
 TaskBarPos := FindTaskBar(TaskBarRect);
end;

//------------------------------------------------------------------------------

end.



 
Dr. Genius   (2009-07-04 09:57) [4]

DVM, Огромное спасибо за исходник. Сейчас буду его пробовать.


 
Dr. Genius   (2009-07-04 09:57) [5]

Удалено модератором


 
Dr. Genius   (2009-07-04 10:43) [6]

Я пользуюсь исходниками, которые выложил DVM. Добавляю на форму этот компонент – на форме появляется пустая рамка (это заготовка будущего Popup-окна). Добавляю в эту рамку Label с нужной мне надписью. Но если вызвать PopUp, то всплывает пустая рамка без добавленного мной Label’а. В чем дело?


 
DVM ©   (2009-07-04 11:47) [7]


> Dr. Genius

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


 
Rouse_ ©   (2009-07-04 12:21) [8]

http://rouse.drkb.ru/components.php#fwtray



Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2009.08.30;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.5 MB
Время: 0.005 c
2-1246131301
Alexei
2009-06-27 23:35
2009.08.30
Переход по ссылке в WebBrowser e


15-1246540232
Гость
2009-07-02 17:10
2009.08.30
Посоветуйте локальный чат для конторы


15-1246212338
vuk
2009-06-28 22:05
2009.08.30
Москва. Печать на цветном лазернике. Где?


2-1246017930
VoyagerEternal
2009-06-26 16:05
2009.08.30
Как продолжить выполнение программы после искл. ситуации(raise)?


1-1212955915
andreil
2008-06-09 00:11
2009.08.30
Дельфийский интерфейс для Сишных прог





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский