Systray - componente especifico para Win2000 NT |
Top Previous Next |
|
unit TrayComp; (* Modified by Stewart Moss 21-Feb-2002 ------------------------
Original Copyright information is still intact.
The Show in Taskbar code changed to work under Windows 2000 / NT.
*)
{************* FREEWARE ******************} {****************************************************} {************* copyright (c) ******************} {************* Alexander Rodigin ******************} {************* ras@ras.udm.ru ******************} {************* May 6 1999 Russia ******************} {***************************************************** TrayComponent is a mix of two components: Stealth by Janus N. Tøndering 1998 [j@nus.person.dk] with thanks to... Eric Lawrence [deltagrp@juno.com] John Molyneux [jaymol@hotmail.com] copyright © Amigreen Software 1998 and TrayIcon by Pete Ness Compuserve ID: 102347,710 Internet: 102347.710@compuserve.com http:\\ourworld.compuserve.com\homepages\peteness. Some properties were modified. Also some new properties were added : 1)ShowInTaskBar allow not to minimize the form onto TaskBar; 2)ShowForm allow completely hide the form from the user and Alt-Tab Menu; 3)RunMinimized disallow application's start-up in minimized state because minimized form will appear onto Task Bar; 4)DefRClick and DefLClick activates the form if ShowForm = true and no code assigned to these eventhandlers; 5)the Icon by default is the application's icon; 6)HideApp doesn't conflict with Windows NT now;
The first time you try TTrayComponent just put it onto the form and run app to test default options.
Any changes,bugs and suggestions please report to ras@ras.udm.ru } interface /////////////////////////////////// uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ShellAPI, Menus, Dialogs, CommCtrl; /////////////////////////////////// const WM_FROMTRAYICON = WM_USER + 59; WM_RESETTOOLTIP = WM_USER + 61; /////////////////////////////////// type TTrayComp = class(TComponent) private { Private declarations } { general } FhWnd: hWnd; FhLib: hInst; { for hiding } FHideApp: Boolean; FShowForm: Boolean; FShowInTaskBar: Boolean; FRunMinimized: Boolean; OldWndProc: TFarProc; NewWndProc: Pointer; { for icon } IconData: TNOTIFYICONDATA; FIcon: TIcon; FToolTip: string; FShowIcon: Boolean; FPopupMenu: TPopupMenu; FDefRClick: Boolean; FDefLClick: Boolean; FOnLeftClick: TNotifyEvent; FOnRightClick: TMouseEvent; FOnMouseMove: TNotifyEvent;
{ for hiding } procedure SetHideApp(Value: Boolean); procedure SetShowForm(Value: Boolean); procedure SetShowInTaskBar(Value: Boolean); procedure InsertHook; procedure RemoveHook; procedure OurWndProc(var M: TMessage); { for icon } function PlaceIcon: Boolean; function ReplaceIcon: Boolean; function EraseIcon: Boolean; procedure SetShowIcon(Value: Boolean); procedure SetIcon(Value: TIcon); procedure SetToolTip(Value: string); procedure FillIconData; procedure DoRightClick(Sender: TObject); procedure DoLeftClick(Sender: TObject); procedure DoMouseMove(Sender: TObject); protected { Protected declarations } { for hiding } procedure Loaded; override; procedure DoHiding; public { Public declarations } constructor Create(AOwner: TComponent); override; destructor Destroy; override; published { Published declarations } { for hiding } property HideApp: Boolean read FHideApp write SetHideApp; property ShowForm: Boolean read FShowForm write SetShowForm default True; property ShowInTaskBar: Boolean read FShowInTaskBar write SetShowInTaskBar default False; property RunMinimized: Boolean read FRunMinimized write FRunMinimized default False; { for icon } property ShowIcon: boolean read FShowIcon write SetShowIcon; property Icon: TIcon read FIcon write SetIcon; property ToolTip: string read FTooltip write SetToolTip; property PopupMenu: TPopupMenu read fPopupMenu write fPopupMenu; property DefRClick: Boolean read FDefRClick write FDefRClick default False; property DefLClick: Boolean read FDefLClick write FDefLClick default True; property OnLeftClick: TNotifyEvent read FOnLeftClick write FOnLeftClick; property OnRightClick: TMouseEvent read FOnRightClick write FonRightClick; property OnMouseMove: TNotifyEvent read FOnMouseMove write FOnMouseMove;
end; procedure Register; /////////////////////////////////// implementation ///////////////////////////////////
var XWndLong: Integer;
constructor TTrayComp.Create(AOwner: TComponent); var i: Integer; Already: Byte; begin inherited Create(AOwner); { for hiding } FHideApp := True; FShowForm := True; FShowInTaskBar := False; FRunMinimized := False; NewWndProc := nil; OldWndProc := nil; Already := 0; if (csDesigning in ComponentState) then if (AOwner is TForm) then with (AOwner as TForm) do begin for i := 0 to ComponentCount - 1 do if Components[i] is TTrayComp then Inc(Already); if Already > 1 then raise Exception.Create('You can''t create a second TTrayComp on the same form!'); end else raise Exception.Create('You can create a TTrayComp only on the form!'); { for icon } FIcon := TIcon.Create; FShowIcon := True; FDefRClick := False; FDefLClick := True; if (csDesigning in ComponentState) then SetIcon(Application.Icon); end; { TTrayComp.Create } ///////////////////////////////////
destructor TTrayComp.Destroy; begin { for hiding } RemoveHook; { for icon } if not (csDesigning in ComponentState) then if FShowIcon then EraseIcon; FIcon.Free; inherited Destroy; end; { destructor TTrayComp.Destroy } ///////////////////////////////////
procedure TTrayComp.Loaded; begin inherited Loaded; FhWnd := (Owner as TForm).Handle; { terminate if minimized not allowed } if IsIconic(FhWnd) and not FRunMinimized then Application.Terminate; InsertHook; { hide the form at start-up if needed } if not FShowForm then begin (Owner as TForm).Visible := False; Application.ShowMainForm := False; end; end; { procedure TTrayComp.Loaded } ///////////////////////////////////
procedure TTrayComp.DoHiding; begin if not (csDesigning in ComponentState) then
// Modified by Stewart Moss // For Windows NT / 2000 Support // 21-Feb-2002 if not FShowInTaskBar then SetWindowLong(Application.Handle, GWL_EXSTYLE, XWndLong or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW or WS_EX_TOPMOST) else SetWindowLong(Application.Handle, GWL_EXSTYLE, XWndLong);
ShowWindow(FindWindow(nil, @Application.Title[1]), SW_HIDE); end; { procedure TTrayComp.DoHiding } ///////////////////////////////////
procedure TTrayComp.SetShowInTaskBar(Value: Boolean); begin FShowInTaskBar := Value; DoHiding; end; { procedure TTrayComp.SetShowInTaskBar } ///////////////////////////////////
procedure TTrayComp.InsertHook; begin if Owner <> nil then begin OldWndProc := TFarProc(GetWindowLong(FhWnd, GWL_WNDPROC)); NewWndProc := MakeObjectInstance(OurWndProc); SetWindowLong(FhWnd, GWL_WNDPROC, Integer(NewWndProc)); end; end; { procedure TTrayComp.RemoveHook } ///////////////////////////////////
procedure TTrayComp.RemoveHook; begin if (Owner <> nil) and Assigned(OldWndProc) then SetWindowLong(FhWnd, GWL_WNDPROC, Integer(OldWndProc)); if Assigned(NewWndProc) then FreeObjectInstance(NewWndProc); NewWndProc := nil; OldWndProc := nil; end; { procedure TTrayComp.RemoveHook } ///////////////////////////////////
procedure TTrayComp.OurWndProc(var M: TMessage); begin if Owner <> nil then case M.Msg of { *** } WM_ACTIVATE: if (M.WParamLo <> WA_INACTIVE) then DoHiding; { *** } WM_SYSCOMMAND: if (M.WParam = SC_MINIMIZE) and not ShowInTaskBar then begin M.Msg := WM_SHOWWINDOW; M.WParam := SW_HIDE; end; { *** } WM_FROMTRAYICON: begin case M.LParam of WM_LBUTTONUP: DoLeftClick(Self); WM_RBUTTONUP: DoRightClick(Self); WM_MOUSEMOVE: DoMouseMove(Self); end; Exit end; { *** } WM_RESETTOOLTIP: begin SetToolTip(FToolTip); Exit end end; M.Result := CallWindowProc(OldWndProc, FhWnd, M.Msg, M.WParam, M.LParam); end; { procedure TTrayComp.OurWndProc } ///////////////////////////////////
procedure TTrayComp.SetHideApp(Value: Boolean); type Proc = procedure(PID, T: DWord); stdcall; var RegProc: Proc; begin if Value <> FHideApp then FHideApp := Value; if not (csDesigning in ComponentState) then begin if FhLib = 0 then FhLib := GetModuleHandle(PChar('kernel32.dll')); if FhLib = 0 then Exit; @RegProc := GetProcAddress(FhLib, PChar('RegisterServiceProcess')); if @RegProc <> nil then begin if Value then RegProc(GetCurrentProcessID, 1) else RegProc(GetCurrentProcessID, 0); end else FHideApp := False; end; end;
procedure TTrayComp.SetShowForm(Value: Boolean); begin if not (csDesigning in ComponentState) then if Value then ShowWindow(FhWnd, SW_SHOW) else ShowWindow(FhWnd, SW_HIDE); if Value and not (Owner as TForm).Visible then (Owner as TForm).Visible := True; if FShowForm <> Value then FShowForm := Value; DoHiding; end; { procedure TTrayComp.SetShowForm } ///////////////////////////////////
procedure TTrayComp.FillIconData; begin with IconData do begin cbSize := sizeof(TNOTIFYICONDATA); wnd := (Owner as TForm).Handle; uID := 0; uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP; hIcon := FIcon.Handle; StrPCopy(szTip, FToolTip); uCallbackMessage := WM_FROMTRAYICON; end; end; { procedure TTrayComp.FillIconData } ///////////////////////////////////
procedure TTrayComp.SetToolTip(Value: string); begin // This routine ALWAYS re-sets the field value and re-loads the // icon. This is so the ToolTip can be set blank when the component // is first loaded. If this is changed, the icon will be blank on // the tray when no ToolTip is specified. if Length(Value) > 62 then Value := Copy(Value, 1, 62); FToolTip := Value; ReplaceIcon; end; { procedure TTrayComp.SetToolTip } ///////////////////////////////////
function TTrayComp.PlaceIcon: Boolean; begin FillIconData; Result := Shell_NotifyIcon(NIM_ADD, @IconData); // For some reason, if there is no tool tip set up, then the icon // doesn't display. This fixes that. if FToolTip = '' then PostMessage((Owner as TForm).Handle, WM_RESETTOOLTIP, 0, 0); end; { function TTrayComp.PlaceIcon } ///////////////////////////////////
function TTrayComp.ReplaceIcon: Boolean; begin FillIconData; if FShowIcon then Result := Shell_NotifyIcon(NIM_MODIFY, @IconData) else Result := True; end; { function TTrayComp.ReplaceIcon } ///////////////////////////////////
function TTrayComp.EraseIcon: Boolean; begin Result := Shell_NotifyIcon(NIM_DELETE, @IconData); end; { function TTrayComp.DeleteIcon } ///////////////////////////////////
procedure TTrayComp.SetShowIcon(Value: Boolean); begin if not (csdesigning in ComponentState) then begin if Value then PlaceIcon else EraseIcon end; if Value <> FShowIcon then FShowIcon := Value; end; { procedure TTrayComp.SetShowIcon } ///////////////////////////////////
procedure TTrayComp.SetIcon(Value: TIcon); begin if Value <> FIcon then begin FIcon.Assign(Value); ReplaceIcon; end; end; { procedure TTrayComp.SetIcon } ///////////////////////////////////
procedure TTrayComp.DoRightClick(Sender: TObject); var Coord: TPoint; begin GetCursorPos(Coord); if Assigned(FOnRightClick) then FOnRightClick(Self, mbRight, [], Coord.X, Coord.Y) else if FDefRClick and FShowForm then begin ShowWindow(FhWnd, SW_SHOW); SetActiveWindow(FhWnd); end; if Assigned(FPopupMenu) then begin SetActiveWindow((Owner as TForm).Handle); FPopupMenu.PopUp(Coord.X, Coord.Y); end end; { procedure TTrayComp.DoRightClick } ///////////////////////////////////
procedure TTrayComp.DoLeftClick(Sender: TObject); begin if Assigned(FOnLeftClick) then FOnLeftClick(Self) else if DefLClick and FShowForm then begin ShowWindow(FhWnd, SW_SHOW); SetActiveWindow(FhWnd); end; end; { procedure TTrayComp.DoLeftClick } ///////////////////////////////////
procedure TTrayComp.DoMouseMove(Sender: TObject); begin if Assigned(FOnMouseMove) then FOnMouseMove(Self) end; { procedure TTrayComp.DoMouseMove } ///////////////////////////////////
procedure Register; begin RegisterComponents('RAS', [TTrayComp]); end;
initialization XWndLong := GetWindowLong(Application.Handle, GWL_EXSTYLE); end. |