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