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