Utilizamos cookies propias y de terceros. Al navegar entendemos que aceptas el uso de cookies. +Info.
Política de cookies
Proyecto AjpdSoft

· Inicio
· Buscar
· Contactar
· Cookies
· Descargas
· Foros
· Historia
· Nosotros
· Temas
· Top 10
· Trucos
· Tutoriales
· Usuario
· Wiki

Nick


Contraseña


Nuevo usuario


English
Mostrar globo emergente en la barra de notificación de Windows XP - Delphi
Lenguaje de programación Borland Delphi



Este truco sirve para mostrar un globo emergente en la barra de notificación de Windows XP (como el que aparece cuando se detecta un nuevo hardware, por ejemplo). Para ello necesitará, un formulario, tres botones y un Memo:

unit UnidadMenuPrincipal;

interface 

uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls; 

{new constant definitions} 

const 
  NIF_INFO = $10; 
  NIF_MESSAGE = 1; 
  NIF_ICON = 2; 
  NOTIFYICON_VERSION = 3; 
  NIF_TIP = 4; 
  NIM_SETVERSION = $00000004; 
  NIM_SETFOCUS = $00000003; 
  NIIF_INFO = $00000001; 
  NIIF_WARNING = $00000002; 
  NIIF_ERROR = $00000003; 

  NIN_BALLOONSHOW = WM_USER + 2; 
  NIN_BALLOONHIDE = WM_USER + 3; 
  NIN_BALLOONTIMEOUT = WM_USER + 4; 
  NIN_BALLOONUSERCLICK = WM_USER + 5;
  NIN_SELECT = WM_USER + 0; 
  NINF_KEY = $1; 
  NIN_KEYSELECT = NIN_SELECT or NINF_KEY; 
   
  {other constants can be found in vs.net---vc7's dir: PlatformSDK\Include\ShellAPI.h} 

  {define the callback message} 
  TRAY_CALLBACK = WM_USER + $7258; 

  {new NotifyIconData structure definition} 
type 
  PNewNotifyIconData = ^TNewNotifyIconData; 
  TDUMMYUNIONNAME    = record 
    case Integer of 
      0: (uTimeout: UINT); 
      1: (uVersion: UINT); 
  end; 

  TNewNotifyIconData = record 
    cbSize: DWORD; 
    Wnd: HWND; 
    uID: UINT; 
    uFlags: UINT; 
    uCallbackMessage: UINT; 
    hIcon: HICON; 
   //Version 5.0 is 128 chars, old ver is 64 chars 
    szTip: array [0..127] of Char; 
    dwState: DWORD; //Version 5.0 
    dwStateMask: DWORD; //Version 5.0 
    szInfo: array [0..255] of Char; //Version 5.0 
    DUMMYUNIONNAME: TDUMMYUNIONNAME; 
    szInfoTitle: array [0..63] of Char; //Version 5.0 
    dwInfoFlags: DWORD;   //Version 5.0 
  end; 


type 
  TformMenuPrincipal = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    LWEB: TLabel;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure LWEBClick2(Sender: TObject);
  private 
    IconData: TNewNotifyIconData; 
    procedure SysTrayIconMsgHandler(var Msg: TMessage); message TRAY_CALLBACK; 
    procedure AddSysTrayIcon; 
    procedure ShowBalloonTips; 
    procedure DeleteSysTrayIcon; 
  public 
  end; 

var 
  formMenuPrincipal: TformMenuPrincipal;

implementation 

{$R *.DFM} 

uses 
  ShellAPI; 

procedure TformMenuPrincipal.SysTrayIconMsgHandler(var Msg: TMessage);
begin 
  case Msg.lParam of 
    WM_MOUSEMOVE:; 
    WM_LBUTTONDOWN:; 
    WM_LBUTTONUP:; 
    WM_LBUTTONDBLCLK:; 
    WM_RBUTTONDOWN:; 
    WM_RBUTTONUP:; 
    WM_RBUTTONDBLCLK:; 
    //followed by the new messages 
    NIN_BALLOONSHOW: 
    {Sent when the balloon is shown} 
      ShowMessage('Se ha mostrado el globo emergente.'); 
    NIN_BALLOONHIDE: 
    {Sent when the balloon disappears?Rwhen the icon is deleted, 
    for example. This message is not sent if the balloon is dismissed because of 
    a timeout or mouse click by the user. } 
      ShowMessage('Usted ha cerrado el globo.');
    NIN_BALLOONTIMEOUT: 
      {Sent when the balloon is dismissed because of a timeout.}
      ShowMessage('Se ha cerrado el globo.'); 
    NIN_BALLOONUSERCLICK:
    begin
      {Sent when the balloon is dismissed because the user clicked the mouse.
      Note: in XP there's Close button on he balloon tips, when click the button,
      send NIN_BALLOONTIMEOUT message actually.}
      ShowMessage('Usted ha hecho click en el globo. Ahora se abrirá la página web http://www.ajpdsoft.com');
      LWEBClick2(nil);        
    end;
  end; 
end; 

  {AddSysTrayIcon procedure add an icon to notification area} 
procedure TformMenuPrincipal.AddSysTrayIcon;
begin 
  IconData.cbSize := SizeOf(IconData); 
  IconData.Wnd := AllocateHWnd(SysTrayIconMsgHandler); 
  {SysTrayIconMsgHandler is then callback message' handler} 
  IconData.uID := 0; 
  IconData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP; 
  IconData.uCallbackMessage := TRAY_CALLBACK;   //user defined callback message 
  IconData.hIcon := Application.Icon.Handle;    //an Icon's Handle 
  IconData.szTip := 'http://www.ajpdsoft.com'; 
  if not Shell_NotifyIcon(NIM_ADD, @IconData) then 
    ShowMessage('No se ha podido añadir el icono en la barra de notificación.'); 
end; 

{ShowBalloonTips procedure carry out the new feature: Balloon Tips} 
procedure TformMenuPrincipal.ShowBalloonTips;
var 
  TipInfo, TipTitle: string; 
begin 
  IconData.cbSize := SizeOf(IconData); 
  IconData.uFlags := NIF_INFO; 
  TipInfo := 'Esto es una prueba del texto que se puede poner en el globo emergente: http://www.ajpdsoft.com'; 
  strPLCopy(IconData.szInfo, TipInfo, SizeOf(IconData.szInfo) - 1);
  IconData.DUMMYUNIONNAME.uTimeout := 3000;
  TipTitle := 'Este sería el título del globo';
  strPLCopy(IconData.szInfoTitle, TipTitle, SizeOf(IconData.szInfoTitle) - 1); 
  IconData.dwInfoFlags := NIIF_INFO;     //NIIF_ERROR;  //NIIF_WARNING; 
  Shell_NotifyIcon(NIM_MODIFY, @IconData); 
  {in my testing, the following code has no use} 
  IconData.DUMMYUNIONNAME.uVersion := NOTIFYICON_VERSION; 
  if not Shell_NotifyIcon(NIM_SETVERSION, @IconData) then 
    ShowMessage('Ha fallado la creación del icono en la barra de notificación.'); 
end; 

{here's the deletion procedure} 
procedure TformMenuPrincipal.DeleteSysTrayIcon;
begin 
  DeallocateHWnd(IconData.Wnd); 
  if not Shell_NotifyIcon(NIM_DELETE, @IconData) then 
    ShowMessage('Ha fallado la ocultación de la aplicación en la barra de notificación.'); 
end; 

procedure TformMenuPrincipal.FormDestroy(Sender: TObject);
begin
  DeleteSysTrayIcon;
end;

procedure TformMenuPrincipal.FormCreate(Sender: TObject);
begin
  AddSysTrayIcon;
  ShowBalloonTips;
end;

procedure TformMenuPrincipal.Button1Click(Sender: TObject);
begin
  close;
end;

procedure TformMenuPrincipal.Button2Click(Sender: TObject);
begin
  AddSysTrayIcon;
  ShowBalloonTips;
end;

procedure TformMenuPrincipal.Button3Click(Sender: TObject);
begin
  DeleteSysTrayIcon;
end;

procedure TformMenuPrincipal.LWEBClick2(Sender: TObject);
begin
  ShellExecute(Handle, Nil, PChar(LWEB.CAPTION),
      Nil, Nil, SW_SHOWNORMAL);
end;

end.




Publicado el: 2003-12-11

Este sitio web NO CONTIENE malware, todos los programas con código fuente aquí. Autor: Alonso Javier Pérez Díaz Google+ Síguenos en Google+