|
Programación: Mostrar globo, iconizar, insertar botón en barra de título (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.
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:
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
|
|