Utilizamos cookies propias y de terceros. [Más información sobre las cookies].
Política de cookies
Proyecto AjpdSoft

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

Programación: Mostrar globo, iconizar, insertar botón en barra de título (Delphi)
Delphi


Ejemplo de aplicación en Delphi que minimiza (iconiza) la aplicación en la barra de notificación (junto al reloj de Windows), inserta un "botón" en la barra de título (junto al botón de minimizar, maximizar y cerrar) y muestra un globo emergente como los que Windows utiliza para notificar determinados eventos. Todo ello sin utilizar componentes adicionales.

Documento sin título

Mostrar globo emergente, minimizar en barra de notificación, insertar botón en barra de título

Este ejemplo hecho en Delphi 6 realiza las siguientes acciones:

  • Minimiza (oculta) la aplicación en la barra de notificación (junto al reloj), mostrando un icono, al pulsar doble clic sobre este icono mostrará la aplicación. Si se pulsa con el botón derecho sobre el icono mostrará un menú emergente con diferentes opciones:

  • Añade un "botón" (imagen con forma de botón) en la barra de notificación (junto a los botones de minimizar, maximizar y cerrar). También hemos programado este botón para que al pulsar con el ratón sobre él se pueda ejecutar un procedimiento: en nuestro caso al hacer clic la aplicación se iconiza en la barra de notificación.

  • Muestra un globo emergente con sus correspondientes eventos programables (clic, cerrar, abrir, etc):

 

Para realizar la aplicación hemos utilizado un TPopupMenu, dos TButton y un TForm:

A continuación os mostramos el código fuente completo de la unidad del formulario:

unit Unit1;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, 
  Graphics, Controls, Forms, Dialogs, Buttons, 
  StdCtrls, Menus, ShellAPI;

//para globo emergente
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;

  TRAY_CALLBACK = WM_USER + $7258;

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; 
    szTip: array [0..127] of Char;
    dwState: DWORD;
    dwStateMask: DWORD;
    szInfo: array [0..255] of Char;
    DUMMYUNIONNAME: TDUMMYUNIONNAME; 
    szInfoTitle: array [0..63] of Char;
    dwInfoFlags: DWORD;   
  end; 


//fin para globo emergente


type
  TformBotonTitulo = class(TForm)
    PopupMenu1: TPopupMenu;
    Activar1: TMenuItem;
    N1: TMenuItem;
    Cerrar1: TMenuItem;
    Mostrargloboemergente1: TMenuItem;
    bMostrarGlobo: TButton;
    bOcultarBN: TButton;
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
    procedure Cerrar1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Activar1Click(Sender: TObject);
    procedure bMostrarGloboClick(Sender: TObject);
    procedure bOcultarBNClick(Sender: TObject);
    procedure Mostrargloboemergente1Click(Sender: TObject);
  public
    procedure AppDeactivate(Sender: TObject);
  private
    TitleButton : TRect;

    //para iconizar y globo emergente
    IconData: TNewNotifyIconData;
    //fin para iconizar y globo emergente

    procedure DrawTitleButton(imagen:String);
    procedure WMSetText(var Msg : TWMSetText); 
        message WM_SETTEXT;
    procedure WMNCPaint(var Msg : TWMNCPaint); 
        message WM_NCPAINT;
    procedure WMNCActivate(var Msg : TWMNCActivate); 
        message WM_NCACTIVATE;
    procedure WMNCHitTest(var Msg : TWMNCHitTest); 
        message WM_NCHITTEST;
    procedure WMNCLButtonDown(var Msg : TWMNCLButtonDown); 
        message WM_NCLBUTTONDOWN;
    procedure WMNCLButtonUp(var Msg : TWMNCLButtonUp); 
        message WM_NCLBUTTONUP;
    procedure WMNCMouseMove(var Msg : TWMNCMouseMove); 
        message WM_NCMOUSEMOVE;
    function GetVerInfo : DWORD;

    //para iconizar y globo emergente
    procedure SysTrayIconMsgHandler(var Msg: TMessage); 
        message TRAY_CALLBACK;
    procedure insertarIconoBN;
    procedure mostrarGlobo (titulo : string; contenido : string);
    procedure eliminarIconoBN;
    procedure clickGlobo();
   //fin para iconizar y globo emergente
  end;

var
  formBotonTitulo: TformBotonTitulo;
  EstadoIcono : String;
  BotonPulsado : Boolean;
  quitarIconoCerrarGlobo : boolean;
  accionRealizarClickGlobo : integer;

const
  htTitleBtn = htSizeLast + 1;
  activo = 'activo.bmp';
  inactivo = 'desactivo.bmp';

implementation
{$R *.DFM}


//para globo emergente
procedure TformBotonTitulo.SysTrayIconMsgHandler(var Msg: TMessage);
var
  CursorPos : TPoint;
begin
  case Msg.lParam of
    WM_MOUSEMOVE:;
    WM_LBUTTONDOWN:;
    WM_LBUTTONUP:
    begin
      Activar1Click(self);
    end;

    WM_LBUTTONDBLCLK:
    begin
      Activar1Click(self);
    end;

    WM_RBUTTONDOWN:;

    WM_RBUTTONUP:
    begin
      PopupMenu1.Popup(CursorPos.x, CursorPos.y);
    end;

    WM_RBUTTONDBLCLK:;

    NIN_BALLOONSHOW:
      ShowMessage('Se ha mostrado el globo emergente.');

    NIN_BALLOONHIDE:
    begin
      ShowMessage('Se ha cerrado el globo manualmente.');
      if quitarIconoCerrarGlobo then
        eliminarIconoBN;
    end;

    NIN_BALLOONTIMEOUT:
    begin
      ShowMessage('Se ha cerrado el globo automáticamente.');
      if quitarIconoCerrarGlobo then
        eliminarIconoBN;
    end;

    NIN_BALLOONUSERCLICK:
    begin
      case accionRealizarClickGlobo of
        1 :
        begin
          clickGlobo();
        end;
      end;
    end;
  end;
end;

procedure TformBotonTitulo.clickGlobo();
begin
  case accionRealizarClickGlobo of
    1 :
    begin
      ShowMessage ('Se ha hecho click en el globo. Ahora se abrirá ' +
          ' la página web http://www.ajpdsoft.com');
      if quitarIconoCerrarGlobo then
        eliminarIconoBN;
      ShellExecute(Handle, Nil, PChar('www.ajpdsoft.com'),
          Nil, Nil, SW_SHOWNORMAL);
    end;
  end;
end;

procedure TformBotonTitulo.insertarIconoBN;
begin 
  IconData.cbSize := SizeOf(IconData); 
  IconData.Wnd := AllocateHWnd(SysTrayIconMsgHandler); 
  IconData.uID := 0; 
  IconData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP; 
  IconData.uCallbackMessage := TRAY_CALLBACK;
  IconData.hIcon := Application.Icon.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; 

procedure TformBotonTitulo.mostrarGlobo 
    (titulo : string; contenido : string);
var 
  TipInfo, TipTitle: string; 
begin 
  IconData.cbSize := SizeOf(IconData); 
  IconData.uFlags := NIF_INFO; 
  TipInfo := contenido;
  strPLCopy(IconData.szInfo, TipInfo, SizeOf(IconData.szInfo) - 1);
  IconData.DUMMYUNIONNAME.uTimeout := 3000;
  TipTitle := titulo;
  strPLCopy(IconData.szInfoTitle, TipTitle, 
      SizeOf(IconData.szInfoTitle) - 1); 
  IconData.dwInfoFlags := NIIF_INFO;
  Shell_NotifyIcon(NIM_MODIFY, @IconData);
  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; 

procedure TformBotonTitulo.eliminarIconoBN;
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; 


//fin para globo emergente



//para botón en barra de título

procedure TformBotonTitulo.DrawTitleButton(imagen:String);
var
  bmap : TBitmap; {imagen de 16 X 16 : 16 Colores}
  XFrame,  {X, Y tamaño del aréa moficiable del Frame}
  YFrame,
  XTtlBit, {X, Y tamaño imangen en caption}
  YTtlBit  : Integer;
  Izquierda : Integer;
begin
  //obtenemos el tamaño del formulario y 
  //la imagen en la barra de título}
  XFrame  := GetSystemMetrics(SM_CXFRAME);
  YFrame  := GetSystemMetrics(SM_CYFRAME);
  XTtlBit := GetSystemMetrics(SM_CXSIZE) -6;
  YTtlBit := GetSystemMetrics(SM_CYSIZE);

  Izquierda := 36;
  if YTtlBit < 20 then
  begin
   Izquierda := 26;       // 30
   YFrame := YFrame + 3;
   XTtlBit := XTtlBit +2; // +1
   YTtlBit := YTtlBit - 6;
  end;

  {$IFNDEF WIN32}
  TitleButton := Bounds(Width - (3 * XTtlBit) - 
     ((XTtlBit div 2) - 2),
     YFrame - 1, XTtlBit + 2, YTtlBit + 2);

  {$ELSE}
  if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
   TitleButton := Bounds(Width - (3 * XTtlBit) - 
       ((XTtlBit div 2) - 2) - Izquierda,
       YFrame - 1, XTtlBit + 2, YTtlBit + 2)
  else
   TitleButton := Bounds(Width - XFrame - 4*XTtlBit + 2,
       XFrame + 2, XTtlBit + 2, YTtlBit + 2);
  {$ENDIF}

  //GetWindowDC recupera un contexto de dispositivo 
  //(DC) para una ventana completa
  Canvas.Handle := GetWindowDC(Self.Handle);
  try
    bmap := TBitmap.Create;
    if YTtlBit < 20 then
      DrawButtonFace(Canvas, TitleButton, 1, bsAutoDetect, 
          False, BotonPulsado, False)
    else
    begin
      if FileExists(imagen) then
        bmap.LoadFromFile(imagen);
    end;
    with TitleButton do
    begin
      {$IFNDEF WIN32}
      Canvas.Draw(Left + 2, Top + 2, bmap);
      {$ELSE}
      if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
        Canvas.Draw(Left + 2, Top + 2, bmap)
      else
        Canvas.StretchDraw(TitleButton, bmap);
     {$ENDIF}
    end;
  finally
    ReleaseDC(Self.Handle, Canvas.Handle);
    bmap.Free;
    Canvas.Handle := 0;
  end;
end;


procedure TformBotonTitulo.WMNCLButtonUp
    (var Msg : TWMNCLButtonUp);
begin
  inherited;
  BotonPulsado := False;
  DrawTitleButton(EstadoIcono);
  if (Msg.HitTest = htTitleBtn) then
  begin
    Hide;
    Application.ShowMainForm := False;
    insertarIconoBN;
  end;
end;

procedure TformBotonTitulo.WMNCMouseMove
    (var Msg : TWMNCMouseMove);
begin
  inherited;
  if (Msg.HitTest <> htTitleBtn) then
  begin
    BotonPulsado := False;
    DrawTitleButton(EstadoIcono);
  end;
end;

procedure TformBotonTitulo.WMNCActivate(var Msg : TWMNCActivate);
begin
  Inherited;
  EstadoIcono := activo;
  DrawTitleButton(EstadoIcono);
end;

procedure TformBotonTitulo.FormResize(Sender: TObject);
begin
  Perform(WM_NCACTIVATE, Word(Active), 0);
end;

procedure TformBotonTitulo.WMNCPaint(var Msg : TWMNCPaint);
begin
  Inherited;
  DrawTitleButton(EstadoIcono);
end;

procedure TformBotonTitulo.WMSetText(var Msg : TWMSetText);
begin
  Inherited;
  DrawTitleButton(EstadoIcono);
end;

procedure TformBotonTitulo.WMNCHitTest
    (var Msg : TWMNCHitTest);
begin
  Inherited;
  BotonPulsado := False;
  with Msg do
  begin
    if PtInRect(TitleButton, Point(XPos - Left, YPos - Top)) then
      Result := htTitleBtn;
  end;
end;

procedure TformBotonTitulo.WMNCLButtonDown
    (var Msg : TWMNCLButtonDown);
begin
  inherited;
  if (Msg.HitTest = htTitleBtn) then
    BotonPulsado := True;
  DrawTitleButton(EstadoIcono);
end;

function TformBotonTitulo.GetVerInfo : DWORD;
var
  verInfo : TOSVERSIONINFO;
begin
  verInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  if GetVersionEx(verInfo) then
    Result := verInfo.dwPlatformID;
  {Devuelve:
     VER_PLATFORM_WIN32s         Win32s on Windows 3.1
     VER_PLATFORM_WIN32_WINDOWS  Win32 on Windows 9X
     VER_PLATFORM_WIN32_NT       Windows NT, 2000, xp}
end;

procedure TformBotonTitulo.AppDeactivate(Sender: TObject);
begin
  EstadoIcono := inactivo;
  DrawTitleButton(EstadoIcono);
end;

procedure TformBotonTitulo.FormCreate(Sender: TObject);
begin
  EstadoIcono := Activo;
  Application.OnDeactivate := AppDeactivate;
end;

procedure TformBotonTitulo.FormDeactivate(Sender: TObject);
begin
  EstadoIcono := inactivo;
  DrawTitleButton(EstadoIcono);
end;

// fin para botón en barra de título



procedure TformBotonTitulo.Cerrar1Click(Sender: TObject);
begin
  Close;
end;

procedure TformBotonTitulo.FormDestroy(Sender: TObject);
begin
  eliminarIconoBN;
end;

procedure TformBotonTitulo.Activar1Click(Sender: TObject);
begin
  eliminarIconoBN;
  Show;
end;

procedure TformBotonTitulo.bMostrarGloboClick(Sender: TObject);
begin
  insertarIconoBN;
  quitarIconoCerrarGlobo := true;
  accionRealizarClickGlobo := 1;
  mostrarGlobo ('Este sería el título del globo',
      'Esto es una prueba del texto que se puede ' +
      'poner en el globo ' +
      'emergente: http://www.ajpdsoft.com');
end;

procedure TformBotonTitulo.bOcultarBNClick(Sender: TObject);
begin
  Hide;
  Application.ShowMainForm := False;
  insertarIconoBN;
end;

procedure TformBotonTitulo.Mostrargloboemergente1Click(Sender: TObject);
begin
  bMostrarGloboClick (Self);
end;

end.


Nota: Truco realizado por Antonio RN de RS.
Anuncios


Enviado el Jueves, 12 octubre a las 17:47:34 por ajpdsoft
Visita nuestro nuevo sitio web con programas y contenidos actualizados: Proyecto A