|
| Enhanced Tray Icon and Task Bar Component |  
|
|---|
| Works under Windows 2000 and NT | Product:
Delphi all versions | Category:
GUI | Skill Level:
 | Scoring:  | Last Update:
02/21/2002 | Search Keys:
delphi delphi3000 article borland vcl code-snippet tray task-bar tray-icon windows-2000 windows-nt | Times Scored:
3 | Visits:
3575 | Uploader: Stewart Moss
Company: New Heights Software Developme | Reference: http:\\ourworld.compuserve.com\homepages\peteness | | | Question/Problem/Abstract:
How can I hide the program icon on the TaskBar under Windows 2000 or Windows NT | Answer:
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.
|
|
|
| |
Sign up to consume product discounts for Bronze memberships !
|
|
| |
Community Ad of
D. Souchard |
|
| |
|
|
|
Sign Up
