source: cprs/branches/tmg-cprs/BDK32/Source/fVistaBar.pas@ 694

Last change on this file since 694 was 453, checked in by Kevin Toppenberg, 16 years ago

Initial upload of TMG-CPRS 1.0.26.69

File size: 4.8 KB
Line 
1{ **************************************************************
2 Package: XWB - Kernel RPCBroker
3 Date Created: Sept 18, 1997 (Version 1.1)
4 Site Name: Oakland, OI Field Office, Dept of Veteran Affairs
5 Developers: Kevin Meldrum, Travis Hilton, Joel Ivey
6 Description: Basic form for RPCSharedBrokerSessionMgr1.exe.
7 Current Release: Version 1.1 Patch 40 (January 7, 2005))
8*************************************************************** }
9
10unit fVistaBar;
11
12interface
13
14uses
15 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
16 Buttons, StdCtrls, ExtCtrls, Menus, ShellAPI;
17
18const
19 {Support SysTray}
20 wm_IconNotification = wm_User + 100; //System Tray Msg Handle
21 ICON_OFF = 100; //IconId for not connected icon
22 ICON_ON = 101; //IconId for connected icon
23 ICON_OFF_TIP = 'RPCSharedBrokerSessionMgr: no connections'; //Tip when not connected
24 ICON_ON_TIP = 'RPCSharedBrokerSessionMgr'; //Tip when connected
25
26
27
28type
29 TfrmVistABar = class(TForm)
30 pmnSysTray: TPopupMenu;
31 About1: TMenuItem;
32
33 procedure FormActivate(Sender: TObject);
34 procedure FormCreate(Sender: TObject);
35 function AddTrayIcon(iconId : UINT; icon : THandle; tip : string)
36 : Boolean;
37 function DeleteTrayIcon(iconId : UINT) : Boolean;
38 procedure FormDestroy(Sender: TObject);
39 procedure Exit1Click(Sender: TObject);
40 procedure About1Click(Sender: TObject);
41 private
42 { Private declarations }
43 NotifyIconData : TNOTIFYICONDATA;
44 TrayIconId : UINT;
45 TrayIcon : HICON;
46 TrayTip : string;
47 protected
48 procedure WMIconNotification(var Msg : TMessage);
49 message wm_IconNotification;
50 procedure wmQueryEndSession(var Msg : TMessage);
51 message wm_QueryEndSession;
52 public
53 { Public declarations }
54 end;
55
56var
57 frmVistABar: TfrmVistABar;
58
59implementation
60
61uses uSharedBroker1, frmVistAAbout;
62
63{$R *.DFM}
64{$R *.RES}
65
66procedure TfrmVistABar.FormActivate(Sender: TObject);
67begin
68 ShowWindow(Application.Handle, SW_HIDE);
69 Top := 0;
70 Left := (Screen.Width - Width) div 2;
71
72 // Is there a better way to hide this window?
73 // Visible := false; // doesn't work
74 // TODO
75 // Find a way to make the main form non visible
76 Width := 0;
77 Height := 0;
78
79end;
80
81procedure TfrmVistABar.FormCreate(Sender: TObject);
82var
83 I: Integer;
84begin
85 for I := 1 to ParamCount do // Iterate
86 if UpperCase(ParamStr(I)) = 'REGISTER' then
87 Halt;
88 {Setup NotifyIconData fields that won't change}
89 NotifyIconData.cbSize := SizeOf(TNOTIFYICONDATA);
90 NotifyIconData.Wnd := Handle;
91 NotifyIconData.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
92 NotifyIconData.uCallbackMessage := wm_IconNotification;
93
94 {Setup initial icon (= NotConnected) and add it!}
95 TrayIconId := ICON_ON;
96 TrayIcon := LoadIcon(HInstance, 'ICON_ON'); //Loads icon from resource.
97 TrayTip := ICON_ON_TIP;
98 AddTrayIcon(TrayIconId, TrayIcon, TrayTip);
99 SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
100 //ShowWindow(Application.Handle, SW_HIDE);
101end;
102
103function TfrmVistaBar.AddTrayIcon(iconId : UINT; icon : THandle; tip : string)
104 : Boolean;
105begin
106 NotifyIconData.uID := IconID;
107 NotifyIconData.HIcon := icon;
108 if tip <> '' then
109 StrLCopy(NotifyIconData.szTip, PChar(tip), SizeOf(NotifyIconData.szTip))
110 else
111 NotifyIconData.szTip := #0;
112 Result := Shell_NotifyIcon(NIM_ADD, @NotifyIconData);
113end;
114
115{Processes messages to the icon in the System Tray.}
116procedure TfrmVistaBar.WMIconNotification(var Msg : TMessage);
117var
118 MouseMsg : LongInt;
119 Pt: TPoint;
120begin
121 MouseMsg := Msg.LParam;
122
123 case MouseMsg of
124 wm_LButtonDown :
125 ;
126 wm_RButtonUp :
127 begin
128 GetCursorPos(Pt); //Used to locate pop-up menu
129 pmnSysTray.PopUp(Pt.X, Pt.Y); //Displays menu
130 end;
131 wm_LButtonDblClk : //DoubleClick displays form.
132// mitShowClick(Self);
133 end;
134end;
135
136{Event handler sets flag used in FormCloseQuery so that user is }
137procedure TfrmVistaBar.wmQueryEndSession(var Msg : TMessage);
138begin
139// CanAutoClose := True;
140 Msg.Result := 1;
141end;
142
143function TfrmVistaBar.DeleteTrayIcon(iconId : UINT) : Boolean;
144begin
145 NotifyIconData.uID := IconID;
146 Result := Shell_NotifyIcon(NIM_DELETE, @ NotifyIconData);
147 Application.ProcessMessages;
148end;
149
150
151
152procedure TfrmVistABar.FormDestroy(Sender: TObject);
153begin
154 DeleteTrayIcon(TrayIconId);
155end;
156
157procedure TfrmVistABar.Exit1Click(Sender: TObject);
158begin
159 ShowMessage('If the system warns against closing this Application - DON''T CLOSE IT.#13#10Closing this when it shouldn''t be will cause any applications using it to crash');
160 Halt;
161end;
162
163procedure TfrmVistABar.About1Click(Sender: TObject);
164begin
165 ShowAboutBox;
166end;
167
168end.
Note: See TracBrowser for help on using the repository browser.