source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/rMisc.pas@ 1677

Last change on this file since 1677 was 830, checked in by Kevin Toppenberg, 14 years ago

Upgrading to version 27

File size: 13.2 KB
Line 
1unit rMisc;
2
3interface
4
5uses SysUtils, Windows, Classes, Forms, Controls, ComCtrls, Grids, ORFn, ORNet;
6
7const
8 MAX_TOOLITEMS = 30;
9
10type
11 TToolItem = record
12 Caption: string;
13 Action: string;
14 end;
15
16 TToolItemList = array[0..MAX_TOOLITEMS] of TToolItem;
17
18 {An Object of this Class is Created to Hold the Sizes of Controls(Forms)
19 while the app is running, thus reducing calls to RPCs SAVESIZ and LOADSIZ}
20 TSizeHolder = class(TObject)
21 private
22 FSizeList,FNameList: TStringList;
23 public
24 constructor Create;
25 destructor Destroy; override;
26 function GetSize(AName: String): String;
27 procedure SetSize(AName,ASize: String);
28 procedure AddSizesToStrList(theList: TStringList);
29 end;
30
31function DetailPrimaryCare(const DFN: string): TStrings; //*DFN*
32procedure GetToolMenu(var ToolItems: TToolItemList; var OverLimit: boolean);
33procedure ListSymbolTable(Dest: TStrings);
34function MScalar(const x: string): string;
35procedure SetShareNode(const DFN: string; AHandle: HWND); //*DFN*
36function ServerHasPatch(const x: string): Boolean;
37function ServerVersion(const Option, VerClient: string): string;
38function PackageVersion(const Namespace: string): string;
39
40procedure SaveUserBounds(AControl: TControl);
41procedure SaveUserSizes(SizingList: TStringList);
42procedure SetFormPosition(AForm: TForm);
43procedure SetUserBounds(var AControl: TControl);
44procedure SetUserBounds2(AName: string; var v1, v2, v3, v4: integer);
45procedure SetUserWidths(var AControl: TControl);
46procedure SetUserColumns(var AControl: TControl);
47function StrUserBounds(AControl: TControl): string;
48function StrUserBounds2(AName: string; v1, v2, v3, v4: integer): string;
49function StrUserWidth(AControl: TControl): string;
50function StrUserColumns(AControl: TControl): string;
51function UserFontSize: integer;
52procedure SaveUserFontSize( FontSize: integer);
53
54var
55 SizeHolder : TSizeHolder;
56
57implementation
58
59uses TRPCB, fOrders, math;
60
61var
62 uBounds, uWidths, uColumns: TStringList;
63
64function DetailPrimaryCare(const DFN: string): TStrings; //*DFN*
65begin
66 CallV('ORWPT1 PCDETAIL', [DFN]);
67 Result := RPCBrokerV.Results;
68end;
69
70procedure GetToolMenu(var ToolItems: TToolItemList; var OverLimit: boolean);
71var
72 i: Integer;
73 x: string;
74 LoopIndex: integer;
75begin
76 for i := 0 to MAX_TOOLITEMS do with ToolItems[i] do
77 begin
78 Caption := '';
79 Action := '';
80 end;
81 CallV('ORWU TOOLMENU', [nil]);
82 OverLimit := (MAX_TOOLITEMS < RPCBrokerV.Results.Count - 1);
83 LoopIndex := Min(MAX_TOOLITEMS, RPCBrokerV.Results.Count - 1);
84 with RPCBrokerV do for i := 0 to LoopIndex do with ToolItems[i] do
85 begin
86 x := Piece(Results[i], U, 1);
87 Caption := Piece(x, '=', 1);
88 Action := Copy(x, Pos('=', x) + 1, Length(x));
89 end;
90end;
91
92procedure ListSymbolTable(Dest: TStrings);
93var
94 i: Integer;
95 x: string;
96begin
97 Dest.Clear;
98 CallV('ORWUX SYMTAB', [nil]);
99 i := 0;
100 with RPCBrokerV.Results do while i < Count do
101 begin
102 x := Strings[i] + '=';
103 Inc(i);
104 if i < Count then x := x + Strings[i];
105 Dest.Add(x);
106 Inc(i);
107 end;
108end;
109
110function MScalar(const x: string): string;
111begin
112 with RPCBrokerV do
113 begin
114 ClearParameters := True;
115 RemoteProcedure := 'XWB GET VARIABLE VALUE';
116 Param[0].Value := x;
117 Param[0].PType := reference;
118 CallBroker;
119 Result := Results[0];
120 end;
121end;
122
123function ServerHasPatch(const x: string): Boolean;
124begin
125 Result := sCallV('ORWU PATCH', [x]) = '1';
126end;
127
128function ServerVersion(const Option, VerClient: string): string;
129begin
130 Result := sCallV('ORWU VERSRV', [Option, VerClient]);
131end;
132
133function PackageVersion(const Namespace: string): string;
134begin
135 Result := sCallV('ORWU VERSION', [Namespace]);
136end;
137
138function UserFontSize: integer;
139begin
140 Result := StrToIntDef(sCallV('ORWCH LDFONT', [nil]),8);
141 If Result = 24 then Result := 18; // CQ #12322 removed 24 pt font
142end;
143
144procedure LoadSizes;
145var
146 i, p: Integer;
147begin
148 uBounds := TStringList.Create;
149 uWidths := TStringList.Create;
150 uColumns := TStringList.Create;
151 CallV('ORWCH LOADALL', [nil]);
152 with RPCBrokerV do
153 begin
154 for i := 0 to Results.Count - 1 do // change '^' to '='
155 begin
156 p := Pos(U, Results[i]);
157 if p > 0 then Results[i] := Copy(Results[i], 1, p - 1) + '=' +
158 Copy(Results[i], p + 1, Length(Results[i]));
159 end;
160 ExtractItems(uBounds, RPCBrokerV.Results, 'Bounds');
161 ExtractItems(uWidths, RPCBrokerV.Results, 'Widths');
162 ExtractItems(uColumns, RPCBrokerV.Results, 'Columns');
163 end;
164end;
165
166procedure SetShareNode(const DFN: string; AHandle: HWND); //*DFN*
167begin
168 // sets node that allows other apps to see which patient is currently selected
169 sCallV('ORWPT SHARE', [DottedIPStr, IntToHex(AHandle, 8), DFN]);
170end;
171
172procedure SetUserBounds(var AControl: TControl);
173var
174 x: string;
175begin
176 if uBounds = nil then LoadSizes;
177 x := AControl.Name;
178 if not (AControl is TForm) and (Assigned(AControl.Owner)) then x := AControl.Owner.Name + '.' + x;
179 x := uBounds.Values[x];
180 if (x = '0,0,0,0') and (AControl is TForm)
181 then TForm(AControl).WindowState := wsMaximized
182 else
183 begin
184 AControl.Left := HigherOf(StrToIntDef(Piece(x, ',', 1), AControl.Left), 0);
185 AControl.Top := HigherOf(StrToIntDef(Piece(x, ',', 2), AControl.Top), 0);
186 if Assigned( AControl.Parent ) then
187 begin
188 AControl.Width := LowerOf(StrToIntDef(Piece(x, ',', 3), AControl.Width), AControl.Parent.Width - AControl.Left);
189 AControl.Height := LowerOf(StrToIntDef(Piece(x, ',', 4), AControl.Height), AControl.Parent.Height - AControl.Top);
190 end
191 else
192 begin
193 AControl.Width := StrToIntDef(Piece(x, ',', 3), AControl.Width);
194 AControl.Height := StrToIntDef(Piece(x, ',', 4), AControl.Height);
195 end;
196 end;
197 //if (x = '0,0,' + IntToStr(Screen.Width) + ',' + IntToStr(Screen.Height)) and
198 // (AControl is TForm) then TForm(AControl).WindowState := wsMaximized;
199end;
200
201procedure SetUserBounds2(AName: string; var v1, v2, v3, v4: integer);
202var
203 x: string;
204begin
205 if uBounds = nil then LoadSizes;
206 x := uBounds.Values[AName];
207 v1 := StrToIntDef(Piece(x, ',', 1), 0);
208 v2 := StrToIntDef(Piece(x, ',', 2), 0);
209 v3 := StrToIntDef(Piece(x, ',', 3), 0);
210 v4 := StrToIntDef(Piece(x, ',', 4), 0);
211end;
212
213
214procedure SetUserWidths(var AControl: TControl);
215var
216 x: string;
217begin
218 if uWidths = nil then LoadSizes;
219 x := AControl.Name;
220 if not (AControl is TForm) and (Assigned(AControl.Owner)) then x := AControl.Owner.Name + '.' + x;
221 x := uWidths.Values[x];
222 if Assigned (AControl.Parent) then
223 AControl.Width := LowerOf(StrToIntDef(x, AControl.Width), AControl.Parent.Width - AControl.Left)
224 else
225 AControl.Width := StrToIntDef(x, AControl.Width);
226end;
227
228procedure SetUserColumns(var AControl: TControl);
229var
230 x: string;
231 i, AWidth: Integer;
232 couldSet: boolean;
233begin
234 couldSet := False;
235 if uColumns = nil then LoadSizes;
236 x := AControl.Name;
237 if not (AControl is TForm) and (Assigned(AControl.Owner)) then x := AControl.Owner.Name + '.' + x;
238 if AnsiCompareText(x,'frmOrders.hdrOrders')=0 then
239 couldSet := True;
240 x := uColumns.Values[x];
241 if AControl is THeaderControl then with THeaderControl(AControl) do
242 for i := 0 to Sections.Count - 1 do
243 begin
244 //Make sure all of the colmumns fit, even if it means scrunching the last ones.
245 AWidth := LowerOf(StrToIntDef(Piece(x, ',', i + 1), 0), HigherOf(ClientWidth - (Sections.Count - i)*5 - Sections.Items[i].Left, 5));
246 if AWidth > 0 then Sections.Items[i].Width := AWidth;
247 if couldSet and (i=0) and (AWidth>0) then
248 frmOrders.EvtColWidth := AWidth;
249 end;
250 if AControl is TCustomGrid then {nothing for now};
251end;
252
253procedure SaveUserBounds(AControl: TControl);
254var
255 x: string;
256begin
257 if (AControl is TForm) and (TForm(AControl).WindowState = wsMaximized) then
258 x := '0,0,0,0'
259 else
260 with AControl do
261 x := IntToStr(Left) + ',' + IntToStr(Top) + ',' +
262 IntToStr(Width) + ',' + IntToStr(Height);
263// CallV('ORWCH SAVESIZ', [AControl.Name, x]);
264 SizeHolder.SetSize(AControl.Name, x);
265end;
266
267procedure SaveUserSizes(SizingList: TStringList);
268begin
269 CallV('ORWCH SAVEALL', [SizingList]);
270end;
271
272procedure SaveUserFontSize( FontSize: integer);
273begin
274 CallV('ORWCH SAVFONT', [IntToStr(FontSize)]);
275end;
276
277procedure SetFormPosition(AForm: TForm);
278var
279 x: string;
280 Rect: TRect;
281begin
282// x := sCallV('ORWCH LOADSIZ', [AForm.Name]);
283 x := SizeHolder.GetSize(AForm.Name);
284 if x = '' then Exit; // allow default bounds to be passed in, else screen center?
285 if (x = '0,0,0,0') then
286 AForm.WindowState := wsMaximized
287 else
288 begin
289 AForm.SetBounds(StrToIntDef(Piece(x, ',', 1), AForm.Left),
290 StrToIntDef(Piece(x, ',', 2), AForm.Top),
291 StrToIntDef(Piece(x, ',', 3), AForm.Width),
292 StrToIntDef(Piece(x, ',', 4), AForm.Height));
293 Rect := AForm.BoundsRect;
294 ForceInsideWorkArea(Rect);
295 AForm.BoundsRect := Rect;
296 end;
297end;
298
299function StrUserBounds(AControl: TControl): string;
300var
301 x: string;
302begin
303 x := AControl.Name;
304 if not (AControl is TForm) and (Assigned(AControl.Owner)) then x := AControl.Owner.Name + '.' + x;
305 with AControl do Result := 'B' + U + x + U + IntToStr(Left) + ',' + IntToStr(Top) + ',' +
306 IntToStr(Width) + ',' + IntToStr(Height);
307 if (AControl is TForm) and (TForm(AControl).WindowState = wsMaximized)
308 then Result := 'B' + U + x + U + '0,0,0,0';
309end;
310
311function StrUserBounds2(AName: string; v1, v2, v3, v4: integer): string;
312begin
313 Result := 'B' + U + AName + U + IntToStr(v1) + ',' + IntToStr(v2) + ',' +
314 IntToStr(v3) + ',' + IntToStr(v4);
315end;
316
317function StrUserWidth(AControl: TControl): string;
318var
319 x: string;
320begin
321 x := AControl.Name;
322 if not (AControl is TForm) and (Assigned(AControl.Owner)) then x := AControl.Owner.Name + '.' + x;
323 with AControl do Result := 'W' + U + x + U + IntToStr(Width);
324end;
325
326function StrUserColumns(AControl: TControl): string;
327var
328 x: string;
329 i: Integer;
330 shouldSave: boolean;
331begin
332 shouldSave := False;
333 x := AControl.Name;
334 if not (AControl is TForm) and (Assigned(AControl.Owner)) then x := AControl.Owner.Name + '.' + x;
335 if AnsiCompareText(x,'frmOrders.hdrOrders') = 0 then
336 shouldSave := True;
337 Result := 'C' + U + x + U;
338 if AControl is THeaderControl then with THeaderControl(AControl) do
339 for i := 0 to Sections.Count - 1 do
340 begin
341 if shouldSave and (i = 0) then
342 Result := Result + IntToStr(frmOrders.EvtColWidth) + ','
343 else
344 Result := Result + IntToStr(Sections.Items[i].Width) + ',';
345 end;
346 if AControl is TCustomGrid then {nothing for now};
347 if CharAt(Result, Length(Result)) = ',' then Result := Copy(Result, 1, Length(Result) - 1);
348end;
349
350{ TSizeHolder }
351
352procedure TSizeHolder.AddSizesToStrList(theList: TStringList);
353{Adds all the Sizes in the TSizeHolder Object to theList String list parameter}
354var
355 i: integer;
356begin
357 for i := 0 to FNameList.Count-1 do begin
358 if Piece(FNameList[i],U,1) = 'C' then
359 theList.Add(FNameList[i] + U + FSizeList[i])
360 else
361 theList.Add('B' + U + FNameList[i] + U + FSizeList[i]);
362 end;
363end;
364
365constructor TSizeHolder.Create;
366begin
367 inherited;
368 FNameList := TStringList.Create;
369 FSizeList := TStringList.Create;
370end;
371
372
373destructor TSizeHolder.Destroy;
374begin
375 FNameList.Free;
376 FSizeList.Free;
377 inherited;
378end;
379
380function TSizeHolder.GetSize(AName: String): String;
381{Fuctions returns a String of the Size(s) Of the Name parameter passed,
382 if the Size(s) are already loaded into the object it will return those,
383 otherwise it will make the apropriate RPC call to LOADSIZ}
384var
385 rSizeVal: String; //return Size value
386 nameIndex: integer;
387begin
388 rSizeVal := '';
389 nameIndex := FNameList.IndexOf(AName);
390 if nameIndex = -1 then //Currently Not in the NameList
391 begin
392 rSizeVal := sCallV('ORWCH LOADSIZ', [AName]);
393 if rSizeVal <> '' then
394 begin
395 FNameList.Add(AName);
396 FSizeList.Add(rSizeVal);
397 end;
398 end
399 else //Currently is in the NameList
400 rSizeVal := FSizeList[nameIndex];
401 if (rSizeVal = '') and (Piece(AName,U,1) = 'C') then begin
402 if not Assigned(uColumns) then LoadSizes;
403 rSizeVal := uColumns.Values[Piece(AName,U,2)];
404 end;
405 result := rSizeVal;
406end;
407
408procedure TSizeHolder.SetSize(AName, ASize: String);
409{Store the Size(s) Of the ASize parameter passed, Associate it with the AName
410 Parameter. This only stores the sizes in the objects member variables.
411 to Store on the MUMPS Database call SendSizesToDB()}
412var
413 nameIndex: integer;
414begin
415 nameIndex := FNameList.IndexOf(AName);
416 if nameIndex = -1 then //Currently Not in the NameList
417 begin
418 FNameList.Add(AName);
419 FSizeList.Add(ASize);
420 end
421 else //Currently is in the NameList
422 FSizeList[nameIndex] := ASize;
423end;
424
425initialization
426 // nothing for now
427
428finalization
429 if uBounds <> nil then uBounds.Free;
430 if uWidths <> nil then uWidths.Free;
431 if uColumns <> nil then uColumns.Free;
432
433end.
Note: See TracBrowser for help on using the repository browser.