{ TaskBar Icon Component By: Rayed Al-Rashed Icon : Icon to show in the taskbar Hint : Taskbar Icon hint **** THINGS TO ADD **** - Popup menu. - More events. } unit ishell; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs ,shellapi,menus; const UWM_ICON = WM_USER +50; type TShell = class(TCustomControl) private { Private declarations } FActive:Boolean; FIcon: TIcon; FHint: String; FPopupMenu: TPopupMenu; FHandle: THandle; FOnClick: TNotifyEvent; FOnDblClick: TNotifyEvent; FOnMouseMove: TMouseMoveEvent; procedure SetActive (a:Boolean); procedure SetIcon (I:TIcon); procedure SetHint (S:String); procedure SetPopUp ( p:TPopupMenu); procedure ModifyIcon (Sender:TOBject); protected { Protected declarations } procedure Paint ; override; procedure UWMICON (var msg:TMSG); message UWM_ICON; public { Public declarations } constructor Create (AOwner: TComponent) ; override; destructor Destroy ; override; published { Published declarations } property Active:Boolean read FActive write SetActive default False; property Icon:TIcon read FIcon write SetIcon; property Hint:string read FHint write SetHint; property PopupMenu:TPopupMenu read FPopupMenu write SetPopup; { events } property OnClick:TNotifyEvent read FOnClick write FOnClick; property OnDblClick:TNotifyEvent read FOnDblClick write FOnDblClick; property OnMouseMove:TMouseMoveEvent read FOnMouseMove write FOnMouseMove; end; procedure Register; implementation procedure Register; begin RegisterComponents('Samples', [TShell]); end; constructor TShell.Create (AOwner: TComponent) ; begin inherited Create (AOwner); FIcon := TIcon.Create; FIcon.OnChange := ModifyIcon; width :=34; height :=34; end; destructor TShell.Destroy ; var tnid: TNOTIFYICONDATA; begin if FActive and not (csDesigning in ComponentState) then begin tnid.cbSize := sizeof(TNOTIFYICONDATA); tnid.Wnd := FHandle; tnid.uID := 1; Shell_NotifyIcon(NIM_DELETE, @tnid); end; FIcon.Free; inherited destroy; end; procedure TShell.Paint; begin width:= 34; height:= 34; if csDesigning in ComponentState then with inherited canvas do begin if FIcon.empty then draw (1 ,1 ,application.icon) else draw (1 ,1 ,FIcon); pen.style:= psDash; brush.style:= bsClear; rectangle(0,0,width,height); end else visible:= false; end; procedure TShell.UWMICON (var msg:TMSG); var p:Tpoint; begin case Msg.wParam of WM_LBUTTONUP: if assigned(OnClick) then OnClick (Self); WM_LBUTTONDBLCLK: if assigned(OnDblClick) then OnDblClick (Self); WM_RBUTTONUP: if FPopupMenu <> nil then begin GetCursorPos (p); FPopupMenu.popup ( p.x, p.y ); end; WM_MOUSEMOVE: if assigned(OnMouseMove) then OnMouseMove (Self ,[] ,LOWORD(msg.lParam) ,HiWORD(msg.lParam)); end; end; procedure TShell.SetActive ( a:Boolean); var tnid: TNOTIFYICONDATA; begin if FActive = a then exit; FActive:= a; if not (csDesigning in ComponentState) then begin tnid.cbSize := sizeof(TNOTIFYICONDATA); tnid.Wnd := handle; tnid.uID := 1; if FActive then begin tnid.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP; tnid.uCallbackMessage := UWM_ICON; if FIcon.empty then tnid.hIcon := application.icon.handle else tnid.hIcon := FIcon.handle; StrPCopy (tnid.szTip, FHint); Shell_NotifyIcon(NIM_ADD, @tnid); FHandle:= handle; end else Shell_NotifyIcon(NIM_DELETE, @tnid); end; end; procedure TShell.SetIcon (I:TIcon); begin FIcon.assign (I); ModifyIcon (Self); end; procedure TShell.SetHint (S:String); begin FHint:= S; ModifyIcon (Self); end; procedure TShell.SetPopUp ( p:TPopupMenu); begin FPopupMenu := p; end; procedure TShell.ModifyIcon (Sender:TOBject); var tnid: TNOTIFYICONDATA; begin RePaint; if not (csDesigning in ComponentState) then begin tnid.cbSize := sizeof(TNOTIFYICONDATA); tnid.Wnd := handle; tnid.uID := 1; tnid.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP; tnid.uCallbackMessage := UWM_ICON; if Icon.empty then tnid.hIcon := application.icon.handle else tnid.hIcon := FIcon.handle; strPCopy (tnid.szTip, FHint); Shell_NotifyIcon(NIM_MODIFY, @tnid); end; end; end.