source: cprs/trunk/CPRS-Chart/Orders/fODGen.pas

Last change on this file was 1679, checked in by healthsevak, 9 years ago

Updating the working copy to CPRS version 28
File size: 25.1 KB
Line 
1unit fODGen;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 fODBase, ComCtrls, ExtCtrls, StdCtrls, ORDtTm, ORCtrls, ORFn, rODBase, fBase508Form,
8 VA508AccessibilityManager;
9
10type
11 TDialogCtrl = class
12 ID: string;
13 DataType: Char;
14 Required: Boolean;
15 Preserve: Boolean;
16 Prompt: TStaticText;
17 Editor: TWinControl;
18 IHidden: string;
19 EHidden: string;
20 end;
21
22 TfrmODGen = class(TfrmODBase)
23 sbxMain: TScrollBox;
24 lblOrderSig: TLabel;
25 VA508CompMemOrder: TVA508ComponentAccessibility;
26 procedure FormCreate(Sender: TObject);
27 procedure FormClose(Sender: TObject; var Action: TCloseAction);
28 procedure cmdAcceptClick(Sender: TObject);
29 procedure VA508CompMemOrderStateQuery(Sender: TObject; var Text: string);
30 private
31 FilterOut: boolean;
32 TsID: string; //treating specialty id
33 TSDomain: string;
34 AttendID: string;
35 AttendDomain: string;
36 procedure ControlChange(Sender: TObject);
37 procedure LookupNeedData(Sender: TObject; const StartFrom: string;
38 Direction, InsertAt: Integer);
39 procedure PlaceControls;
40 procedure PlaceDateTime(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
41 procedure PlaceFreeText(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
42 procedure PlaceHidden(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
43 procedure PlaceNumeric(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
44 procedure PlaceSetOfCodes(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
45 procedure PlaceYesNo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
46 procedure PlaceLookup(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
47 procedure PlaceMemo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
48 procedure PlaceLabel(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
49 procedure TrimAllMemos;
50 function SetComponentName(Editor: TWinControl; Index: Integer; DialogCtrl: TDialogCtrl): Boolean;
51 protected
52 FFormCloseCalled : Boolean;
53 FCharHt: Integer;
54 FCharWd: Integer;
55 FDialogItemList: TList;
56 FDialogCtrlList: TList;
57 FEditorLeft: Integer;
58 FEditorTop: Integer;
59 FFirstCtrl: TWinControl;
60 FLabelWd: Integer;
61 procedure InitDialog; override;
62 procedure SetDialogIEN(Value: Integer); override;
63 procedure Validate(var AnErrMsg: string); override;
64 procedure UpdateAccessabilityActions(var Actions: TAccessibilityActions); override;
65 public
66 procedure SetupDialog(OrderAction: Integer; const ID: string); override;
67 end;
68
69var
70 frmODGen: TfrmODGen;
71
72implementation
73
74{$R *.DFM}
75
76uses rCore, rOrders, uConst;
77
78const
79 HT_FRAME = 8;
80 HT_LBLOFF = 3;
81 HT_SPACE = 6;
82 WD_MARGIN = 6;
83 TX_STOPSTART = 'The stop date must be after the start date.';
84
85procedure TfrmODGen.FormCreate(Sender: TObject);
86var
87 TheEvtType: string;
88 IDs,TSstr, AttendStr: string;
89begin
90 FFormCloseCalled := false;
91 inherited;
92 FilterOut := True;
93 if Self.EvtID < 1 then
94 FilterOut := False;
95 if Self.EvtID > 0 then
96 begin
97 TheEvtType := Piece(EventInfo1(IntToStr(Self.EvtId)), '^', 1);
98 if (TheEvtType = 'A') or (TheEvtType = 'T') or (TheEvtType = 'M') or (TheEvtType = 'O') then
99 FilterOut := False;
100 end;
101 FillerID := 'OR'; // does 'on Display' order check **KCM**
102 IDs := GetPromptIDs;
103 TSstr := Piece(IDs,'~',1);
104 TsDomain := Piece(TSstr,'^', 1);
105 TsID := Piece(TSstr,'^', 2);
106 AttendStr := Piece(IDs,'~',2);
107 AttendDomain := Piece(AttendStr,'^',1);
108 AttendID := Piece(AttendStr,'^',2);
109 FDialogItemList := TList.Create;
110 FDialogCtrlList := TList.Create;
111end;
112
113procedure TfrmODGen.FormClose(Sender: TObject; var Action: TCloseAction);
114var
115 i: Integer;
116 DialogCtrl: TDialogCtrl;
117begin
118 with FDialogItemList do for i := 0 to Count - 1 do TDialogItem(Items[i]).Free;
119 with FDialogCtrlList do for i := 0 to Count - 1 do
120 begin
121 DialogCtrl := TDialogCtrl(Items[i]);
122 with DialogCtrl do
123 begin
124 if Prompt <> nil then Prompt.Free;
125 if Editor <> nil then case DataType of
126 'D': TORDateBox(Editor).Free;
127 'F': TEdit(Editor).Free;
128 'N': TEdit(Editor).Free;
129 'P': TORComboBox(Editor).Free;
130 'R': TORDateBox(Editor).Free;
131 'S': TORComboBox(Editor).Free;
132 'W': TMemo(Editor).Free;
133 'Y': TORComboBox(Editor).Free;
134 else Editor.Free;
135 end;
136 Free;
137 end;
138 end;
139 FDialogItemList.Free;
140 FDialogCtrlList.Free;
141 FFormCloseCalled := true;
142 inherited;
143end;
144
145procedure TfrmODGen.SetDialogIEN(Value: Integer);
146{ Sets up a generic ordering dialog on the fly. Called before SetupDialog. }
147var
148 DialogNames: TDialogNames;
149begin
150 inherited;
151 StatusText('Loading Dialog Definition');
152 IdentifyDialog(DialogNames, DialogIEN);
153 Caption := DialogNames.Display;
154 Responses.Dialog := DialogNames.BaseName; // loads formatting info
155 LoadOrderPrompting(FDialogItemList, DialogNames.BaseIEN); // loads prompting info
156 PlaceControls;
157 StatusText('');
158end;
159
160procedure TfrmODGen.SetupDialog(OrderAction: Integer; const ID: string);
161var
162 i: Integer;
163 theEvtInfo: string;
164 thePromptIen: integer;
165 AResponse: TResponse;
166 AnEvtResponse: TResponse;
167begin
168 inherited;
169 if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses do
170 begin
171 Changing := True;
172 // for copy & edit, SetDialogIEN hasn't been called yet
173 if (Length(ID) > 0) and (DialogIEN = 0) then SetDialogIEN(DialogForOrder(ID));
174 with FDialogCtrlList do for i := 0 to Count -1 do with TDialogCtrl(Items[i]) do
175 begin
176 if (ID = 'EVENT') and ( Responses.EventIFN > 0 ) then
177 begin
178 thePromptIen := GetIENForPrompt(ID);
179 if thePromptIen = 0 then
180 thePromptIen := GetEventPromptID;
181 AResponse := FindResponseByName('EVENT', 1);
182 if AResponse <> nil then
183 begin
184 theEvtInfo := EventInfo1(AResponse.IValue);
185 AResponse.EValue := Piece(theEvtInfo,'^',4);
186 end;
187 if AResponse = nil then
188 begin
189 AnEvtResponse := TResponse.Create;
190 AnEvtResponse.PromptID := 'EVENT';
191 AnEvtResponse.PromptIEN := thePromptIen;
192 AnEvtResponse.Instance := 1;
193 AnEvtResponse.IValue := IntToStr(Responses.EventIFN);
194 theEvtInfo := EventInfo1(AnEvtResponse.IValue);
195 AnEvtResponse.EValue := Piece(theEvtInfo,'^',4);
196 Responses.TheList.Add(AnEvtResponse);
197 end;
198 end;
199 if Editor <> nil then SetControl(Editor, ID, 1);
200 if DataType = 'H' then
201 begin
202 AResponse := FindResponseByName(ID, 1);
203 if AResponse <> nil then
204 begin
205 IHidden := AResponse.IValue;
206 EHidden := AResponse.EValue;
207 end; {if AResponse}
208 end; {if DataType}
209 end; {with TDialogCtrl}
210 Changing := False;
211 end; {if OrderAction}
212 UpdateColorsFor508Compliance(Self);
213 ControlChange(Self);
214 if (FFirstCtrl <> nil) and (FFirstCtrl.Enabled) then SetFocusedControl(FFirstCtrl);
215end;
216
217procedure TfrmODGen.UpdateAccessabilityActions(
218 var Actions: TAccessibilityActions);
219begin
220 exclude(Actions, aaColorConversion);
221end;
222
223procedure TfrmODGen.InitDialog;
224var
225 i: Integer;
226begin
227 inherited; // inherited does a ClearControls (probably never called since always quick order)
228 {NEED TO CLEAR CONTROLS HERE OR CHANGE ClearControls so can clear children of container}
229 with FDialogCtrlList do for i := 0 to Count -1 do
230 with TDialogCtrl(Items[i]) do if (Editor <> nil) and not Preserve then
231 begin
232 // treat the list & combo boxes differently so their lists aren't cleared
233 if (Editor is TListBox) then TListBox(Editor).ItemIndex := -1
234 else if (Editor is TComboBox) then
235 begin
236 TComboBox(Editor).Text := '';
237 TComboBox(Editor).ItemIndex := -1;
238 end
239 else if (Editor is TORComboBox) then
240 begin
241 TORComboBox(Editor).Text := '';
242 TORComboBox(Editor).ItemIndex := -1;
243 end
244 else ClearControl(Editor);
245 end;
246 if FFirstCtrl <> nil then ActiveControl := FFirstCtrl;
247end;
248
249procedure TfrmODGen.VA508CompMemOrderStateQuery(Sender: TObject;
250 var Text: string);
251begin
252 inherited;
253 Text := memOrder.Text;
254end;
255
256procedure TfrmODGen.Validate(var AnErrMsg: string);
257var
258 i: Integer;
259 ALabel, AMsg: string;
260 AResponse: TResponse;
261 DialogCtrl: TDialogCtrl;
262 StartDT, StopDT: TFMDateTime;
263
264 procedure SetError(const x: string);
265 begin
266 if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
267 AnErrMsg := AnErrMsg + x;
268 end;
269
270begin
271 inherited;
272 with FDialogCtrlList do for i := 0 to Count -1 do
273 begin
274 DialogCtrl := TDialogCtrl(Items[i]);
275 with DialogCtrl do
276 begin
277 if Prompt <> nil then ALabel := Piece(Prompt.Caption, ':', 1) else ALabel := '<Unknown>';
278 if Required then
279 begin
280 AResponse := Responses.FindResponseByName(ID, 1);
281 if (AResponse = nil) or ((AResponse <> nil) and (AResponse.EValue = ''))
282 then SetError(ALabel + ' is required.');
283 end;
284 if ((DataType = 'D') or (DataType = 'R')) and (Editor <> nil) then
285 begin
286 TORDateBox(Editor).Validate(AMsg);
287 if Length(AMsg) > 0 then SetError('For ' + ALabel + ': ' + AMsg);
288 end;
289 if (DataType = 'N') then
290 begin
291 AResponse := Responses.FindResponseByName(ID, 1);
292 if (AResponse <> nil) and (Length(AResponse.EValue) > 0) then with AResponse do
293 begin
294 ValidateNumericStr(EValue, Piece(TEdit(Editor).Hint, '|', 2), AMsg);
295 if Length(AMsg) > 0 then SetError('For ' + ALabel + ': ' + AMsg);
296 end; {if AResponse}
297 end; {if DataType}
298 end; {with DialogCtrl}
299 end; {with FDialogCtrlList}
300 with Responses do
301 begin
302 AResponse := FindResponseByName('START', 1);
303 if AResponse <> nil then StartDT := StrToFMDateTime(AResponse.EValue) else StartDT := 0;
304 AResponse := FindResponseByName('STOP', 1);
305 if AResponse <> nil then StopDT := StrToFMDateTime(AResponse.EValue) else StopDT := 0;
306 if (StopDT > 0) and (StopDT <= StartDT) then SetError(TX_STOPSTART);
307 end;
308end;
309
310procedure TfrmODGen.PlaceControls;
311var
312 i: Integer;
313 DialogItem: TDialogItem;
314 DialogCtrl: TDialogCtrl;
315begin
316 FCharHt := MainFontHeight;
317 FCharWd := MainFontWidth;
318 FEditorTop := HT_SPACE;
319 FLabelWd := 0;
320 with FDialogItemList do for i := 0 to Count - 1 do with TDialogItem(Items[i]) do
321 if not Hidden then FLabelWd := HigherOf(FLabelWd, Canvas.TextWidth(Prompt));
322 FEditorLeft := FLabelWd + (WD_MARGIN * 2);
323 with FDialogItemList do for i := 0 to Count - 1 do
324 begin
325 DialogItem := TDialogItem(Items[i]);
326 if FilterOut then
327 begin
328 if ( compareText(TsID,DialogItem.Id)=0 ) or ( compareText(TSDomain,DialogItem.Domain)=0) then
329 Continue;
330 if (Pos('primary',LowerCase(DialogItem.Prompt)) > 0) then
331 Continue;
332 if (compareText(AttendID,DialogItem.ID) = 0) or ( compareText(AttendDomain,DialogItem.Domain)=0 ) then
333 Continue;
334 end;
335 DialogCtrl := TDialogCtrl.Create;
336 DialogCtrl.ID := DialogItem.ID;
337 DialogCtrl.DataType := DialogItem.DataType;
338 DialogCtrl.Required := DialogItem.Required;
339 DialogCtrl.Preserve := Length(DialogItem.EDefault) > 0;
340 case DialogItem.DataType of
341 'D': PlaceDateTime(DialogCtrl, DialogItem, I);
342 'F': PlaceFreeText(DialogCtrl, DialogItem, i);
343 'H': PlaceHidden(DialogCtrl, DialogItem);
344 'N': PlaceNumeric(DialogCtrl, DialogItem, i);
345 'P': PlaceLookup(DialogCtrl, DialogItem, i);
346 'R': PlaceDateTime(DialogCtrl, DialogItem, i);
347 'S': PlaceSetOfCodes(DialogCtrl, DialogItem, i);
348 'W': PlaceMemo(DialogCtrl, DialogItem, i);
349 'Y': PlaceYesNo(DialogCtrl, DialogItem, i);
350 end;
351 FDialogCtrlList.Add(DialogCtrl);
352 if (DialogCtrl.Editor <> nil) and (FFirstCtrl = nil) then FFirstCtrl := DialogCtrl.Editor;
353 end;
354end;
355
356procedure TfrmODGen.PlaceDateTime(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
357const
358 NUM_CHAR = 22;
359begin
360 with DialogCtrl do
361 begin
362 Editor := TORDateBox.Create(Self);
363 Editor.Parent := sbxMain;
364 Editor.SetBounds(FEditorLeft, FEditorTop, NUM_CHAR * FCharWd, HT_FRAME * FCharHt);
365 TORDateBox(Editor).DateOnly := Pos('T', DialogItem.Domain) = 0;
366 with TORDateBox(Editor) do RequireTime := (not DateOnly) and (Pos('R', DialogItem.Domain) > 0); //v26.48 - RV PSI-05-002
367 SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
368 // TORDateBox(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
369 TORDateBox(Editor).Text := DialogItem.EDefault;
370 TORDateBox(Editor).Hint := DialogItem.HelpText;
371 TORDateBox(Editor).Caption := DialogItem.Prompt;
372 if Length(DialogItem.HelpText) > 0 then TORDateBox(Editor).ShowHint := True;
373 TORDateBox(Editor).OnExit := ControlChange;
374 PlaceLabel(DialogCtrl, DialogItem);
375 FEditorTop := FEditorTop + HT_FRAME + FCharHt + HT_SPACE;
376 end;
377end;
378
379procedure TfrmODGen.PlaceFreeText(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
380begin
381 with DialogCtrl do
382 begin
383 Editor := TCaptionEdit.Create(Self);
384 Editor.Parent := sbxMain;
385 Editor.SetBounds(FEditorLeft, FEditorTop,
386 sbxMain.Width - FEditorLeft - WD_MARGIN - GetSystemMetrics(SM_CXVSCROLL),
387 HT_FRAME * FCharHt);
388 TEdit(Editor).MaxLength := StrToIntDef(Piece(DialogItem.Domain, ':', 2), 0);
389 SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
390 // TCaptionEdit(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
391 TEdit(Editor).Text := DialogItem.EDefault;
392 TEdit(Editor).Hint := DialogItem.HelpText;
393 TCaptionEdit(Editor).Caption := DialogItem.Prompt;
394 if Length(DialogItem.HelpText) > 0 then TEdit(Editor).ShowHint := True;
395 TEdit(Editor).OnChange := ControlChange;
396 PlaceLabel(DialogCtrl, DialogItem);
397 FEditorTop := FEditorTop + HT_FRAME + FCharHt + HT_SPACE;
398 end;
399end;
400
401procedure TfrmODGen.PlaceNumeric(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
402const
403 NUM_CHAR = 16;
404begin
405 with DialogCtrl do
406 begin
407 Editor := TCaptionEdit.Create(Self);
408 Editor.Parent := sbxMain;
409 Editor.SetBounds(FEditorLeft, FEditorTop, NUM_CHAR * FCharWd, HT_FRAME * FCharHt);
410 TEdit(Editor).MaxLength := NUM_CHAR;
411 SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
412 // TCaptionEdit(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
413 TEdit(Editor).Text := DialogItem.EDefault;
414 TEdit(Editor).Hint := DialogItem.HelpText + '|' + DialogItem.Domain;
415 TCaptionEdit(Editor).Caption := DialogItem.Prompt;
416 if Length(DialogItem.HelpText) > 0 then TEdit(Editor).ShowHint := True;
417 TEdit(Editor).OnChange := ControlChange;
418 PlaceLabel(DialogCtrl, DialogItem);
419 FEditorTop := FEditorTop + HT_FRAME + FCharHt + HT_SPACE;
420 end;
421end;
422
423procedure TfrmODGen.PlaceSetOfCodes(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
424const
425 NUM_CHAR = 32;
426var
427 x, y: string;
428begin
429 with DialogCtrl do
430 begin
431 Editor := TORComboBox.Create(Self);
432 Editor.Parent := sbxMain;
433 TORComboBox(Editor).Style := orcsDropDown;
434 TORComboBox(Editor).ListItemsOnly := True;
435 TORComboBox(Editor).Pieces := '2';
436 SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
437 // TORComboBox(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
438 Editor.SetBounds(FEditorLeft, FEditorTop, NUM_CHAR * FCharWd, HT_FRAME * FCharHt);
439 x := DialogItem.Domain;
440 repeat
441 y := Piece(x, ';', 1);
442 Delete(x, 1, Length(y) + 1);
443 y := Piece(y, ':', 1) + U + Piece(y, ':', 2);
444 TORComboBox(Editor).Items.Add(y);
445 until Length(x) = 0;
446 TORComboBox(Editor).SelectByID(DialogItem.IDefault);
447 //TORComboBox(Editor).Text := DialogItem.EDefault;
448 TORComboBox(Editor).RpcCall := DialogItem.HelpText;
449 if Length(DialogItem.HelpText) > 0 then TORComboBox(Editor).ShowHint := True;
450 TORComboBox(Editor).OnChange := ControlChange;
451 PlaceLabel(DialogCtrl, DialogItem);
452 FEditorTop := FEditorTop + HT_FRAME + FCharHt + HT_SPACE;
453 end;
454end;
455
456procedure TfrmODGen.PlaceYesNo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
457const
458 NUM_CHAR = 9;
459begin
460 with DialogCtrl do
461 begin
462 Editor := TORComboBox.Create(Self);
463 Editor.Parent := sbxMain;
464 TORComboBox(Editor).Style := orcsDropDown;
465 TORComboBox(Editor).ListItemsOnly := True;
466 TORComboBox(Editor).Pieces := '2';
467 SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
468 //TORComboBox(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
469 Editor.SetBounds(FEditorLeft, FEditorTop, NUM_CHAR * FCharWd, HT_FRAME * FCharHt);
470 TORComboBox(Editor).Items.Add('0^No');
471 TORComboBox(Editor).Items.Add('1^Yes');
472 TORComboBox(Editor).SelectByID(DialogItem.IDefault);
473 //TORComboBox(Editor).Text := DialogItem.EDefault;
474 TORComboBox(Editor).RpcCall := DialogItem.HelpText;
475 if Length(DialogItem.HelpText) > 0 then TORComboBox(Editor).ShowHint := True;
476 TORComboBox(Editor).OnChange := ControlChange;
477 PlaceLabel(DialogCtrl, DialogItem);
478 FEditorTop := FEditorTop + HT_FRAME + FCharHt + HT_SPACE;
479 end;
480end;
481
482procedure TfrmODGen.PlaceLookup(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
483const
484 NUM_CHAR = 32;
485var
486 idx,defidx,evtChars: integer;
487 GblRef, XRef: string;
488 TopTSList: TStringList;
489begin
490 with DialogCtrl do
491 begin
492 GblRef := DialogItem.Domain;
493 if CharAt(GblRef, 1) in ['0'..'9','.']
494 then GblRef := GlobalRefForFile(Piece(GblRef, ':', 1))
495 else GblRef := Piece(GblRef, ':', 1);
496 if CharAt(GblRef, 1) <> U then GblRef := U + GblRef;
497 if Length(DialogItem.CrossRef) > 0 then XRef := DialogItem.CrossRef else XRef := 'B';
498 XRef := GblRef + '"' + XRef + '")';
499 Editor := TORComboBox.Create(Self);
500 Editor.Parent := sbxMain;
501 TORComboBox(Editor).Style := orcsDropDown;
502 TORComboBox(Editor).ListItemsOnly := True;
503 TORComboBox(Editor).Pieces := '2';
504 TORComboBox(Editor).LongList := True;
505 SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
506 // TORComboBox(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
507 // 2nd bar piece of hint is not visible, hide xref, global ref, & screen code in tab pieces
508 TORComboBox(Editor).RpcCall := DialogItem.HelpText + '|' + XRef + #9 + GblRef + #9 +
509 DialogItem.ScreenRef;
510 if ( compareText(TsID,DialogItem.Id)=0 ) or (compareText(TSDomain,DialogItem.Domain)=0)then
511 begin
512 TopTSList := TStringList.Create;
513 DialogItem.IDefault := Piece(GetDefaultTSForEvt(Self.EvtID),'^',1);
514 GetTSListForEvt(TStrings(TopTSList),Self.EvtID);
515 if TopTSList.Count > 0 then
516 begin
517 if Length(DialogItem.IDefault)>0 then
518 begin
519 defidx := -1;
520 for idx := 0 to topTSList.Count - 1 do
521 if Piece(TopTSList[idx],'^',1)= DialogItem.IDefault then
522 begin
523 defidx := idx;
524 break;
525 end;
526 if defidx >= 0 then
527 topTSList.Move(defidx,0);
528 end;
529 with TORComboBox(Editor) do
530 begin
531 FastAddStrings(TStrings(TopTSList), TORComboBox(Editor).Items);
532 LongList := false;
533 end;
534 end else
535 TORComboBox(Editor).OnNeedData := LookupNeedData;
536 if Length(DialogItem.IDefault)<1 then
537 DialogItem.IDefault := '0';
538 end else
539 TORComboBox(Editor).OnNeedData := LookupNeedData;
540 Editor.SetBounds(FEditorLeft, FEditorTop, NUM_CHAR * FCharWd, HT_FRAME * FCharHt);
541 TORComboBox(Editor).InitLongList(DialogItem.EDefault);
542 TORComboBox(Editor).SelectByID(DialogItem.IDefault);
543 if Length(DialogItem.HelpText) > 0 then TORComboBox(Editor).ShowHint := True;
544 TORComboBox(Editor).OnChange := ControlChange;
545 if ( AnsiCompareText(ID,'EVENT')=0 ) and (Self.EvtID>0)then
546 begin
547 evtChars := length(Responses.EventName);
548 if evtChars > NUM_CHAR then
549 Editor.SetBounds(FEditorLeft, FEditorTop, (evtChars + 6) * FCharWd, HT_FRAME * FCharHt);
550 TORComboBox(Editor).Enabled := False;
551 end;
552 PlaceLabel(DialogCtrl, DialogItem);
553 FEditorTop := FEditorTop + HT_FRAME + FCharHt + HT_SPACE;
554 end;
555end;
556
557procedure TfrmODGen.LookupNeedData(Sender: TObject; const StartFrom: string;
558 Direction, InsertAt: Integer);
559var
560 XRef, GblRef, ScreenRef: string;
561begin
562 inherited;
563 XRef := Piece(TORComboBox(Sender).RpcCall, '|', 2);
564 GblRef := Piece(XRef, #9, 2);
565 ScreenRef := Piece(XRef, #9, 3);
566 XRef := Piece(XRef, #9, 1);
567 TORComboBox(Sender).ForDataUse(SubsetOfEntries(StartFrom, Direction, XRef, GblRef, ScreenRef));
568end;
569
570procedure TfrmODGen.PlaceMemo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
571const
572 NUM_LINES = 3;
573begin
574 with DialogCtrl do
575 begin
576 Editor := TCaptionMemo.Create(Self);
577 Editor.Parent := sbxMain;
578 Editor.SetBounds(FEditorLeft, FEditorTop,
579 sbxMain.Width - FEditorLeft - WD_MARGIN - GetSystemMetrics(SM_CXVSCROLL),
580 (FCharHt * NUM_LINES) + HT_FRAME);
581 SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
582 // TCaptionMemo(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
583 TMemo(Editor).Text := DialogItem.EDefault;
584 TMemo(Editor).Hint := DialogItem.HelpText;
585 TCaptionMemo(Editor).Caption := DialogItem.Prompt;
586 if Length(DialogItem.HelpText) > 0 then TMemo(Editor).ShowHint := True;
587 TMemo(Editor).ScrollBars := ssVertical;
588 TMemo(Editor).OnChange := ControlChange;
589 PlaceLabel(DialogCtrl, DialogItem);
590 FEditorTop := FEditorTop + HT_FRAME + (FCharHt * 3) + HT_SPACE;
591 end;
592end;
593
594procedure TfrmODGen.PlaceHidden(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
595begin
596 DialogCtrl.IHidden := DialogItem.IDefault;
597 DialogCtrl.EHidden := DialogItem.EDefault;
598end;
599
600procedure TfrmODGen.PlaceLabel(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
601var
602 ht: integer;
603begin
604 with DialogCtrl do
605 begin
606 Prompt := TStaticText.Create(Self);
607 Prompt.Parent := sbxMain;
608 Prompt.Caption := DialogItem.Prompt;
609 ht := Prompt.Height; // CQ#15849
610 if ht < FCharHt then
611 ht := FCharHt;
612 Prompt.AutoSize := False;
613 Prompt.SetBounds(WD_MARGIN, FEditorTop + HT_LBLOFF, FLabelWd, ht);
614 Prompt.Alignment := taRightJustify;
615 Prompt.Visible := True;
616 end;
617end;
618
619procedure TfrmODGen.TrimAllMemos;
620var
621 i : integer;
622 Memo : TMemo;
623begin
624 if FFormCloseCalled then Exit; //it is possible for TrimAllMemos to get called after FormClose
625 if Not Assigned(FDialogCtrlList) then Exit;
626 for i := 0 to FDialogCtrlList.Count - 1 do
627 if TDialogCtrl(FDialogCtrlList.Items[i]).Editor is TMemo then begin
628 Memo := TMemo(TDialogCtrl(FDialogCtrlList.Items[i]).Editor);
629 Memo.Lines.Text := Trim(Memo.Lines.Text);
630 end;
631end;
632
633procedure TfrmODGen.cmdAcceptClick(Sender: TObject);
634begin
635 inherited;
636 TrimAllMemos;
637 Application.ProcessMessages;
638end;
639
640procedure TfrmODGen.ControlChange(Sender: TObject);
641var
642 i: Integer;
643begin
644 inherited;
645 if Changing then Exit;
646 with FDialogCtrlList do for i := 0 to Count - 1 do with TDialogCtrl(Items[i]) do
647 begin
648 case DataType of
649 'D': Responses.Update(ID, 1, FloatToStr(TORDateBox(Editor).FMDateTime),
650 TORDateBox(Editor).Text);
651 'F': Responses.Update(ID, 1, TEdit(Editor).Text, TEdit(Editor).Text);
652 'H': Responses.Update(ID, 1, IHidden, EHidden);
653 'N': Responses.Update(ID, 1, TEdit(Editor).Text, TEdit(Editor).Text);
654 'P': Responses.Update(ID, 1, TORComboBox(Editor).ItemID, TORComboBox(Editor).Text);
655 'R': Responses.Update(ID, 1, TORDateBox(Editor).Text, TORDateBox(Editor).Text);
656 'S': Responses.Update(ID, 1, TORComboBox(Editor).ItemID, TORComboBox(Editor).Text);
657 'W': Responses.Update(ID, 1, TX_WPTYPE, TMemo(Editor).Text);
658 'Y': Responses.Update(ID, 1, TORComboBox(Editor).ItemID, TORComboBox(Editor).Text);
659 end;
660 end;
661 memOrder.Text := Responses.OrderText;
662end;
663
664function TfrmODGen.SetComponentName(Editor: TWinControl; Index: Integer; DialogCtrl: TDialogCtrl): Boolean;
665Var
666 I: Integer;
667 SaveName: String;
668begin
669 //strip all non alphanumeric characters to create the save name
670 SaveName := '';
671 //Check for blank id
672 if DialogCtrl.ID = '' then DialogCtrl.ID := 'EMPTY';
673
674 for i := 1 to length(DialogCtrl.ID) do begin
675 if (DialogCtrl.ID[i] in ['A'..'Z']) or (DialogCtrl.ID[i] in ['a'..'z']) or (DialogCtrl.ID[i] in ['0'..'9']) then
676 SaveName := SaveName + DialogCtrl.ID[i];
677 end;
678 SaveName := SaveName + '_' + IntToStr(Index);
679
680 //extra backup - make sure that the component name doesn't already exist
681 //Now set up the component name
682 try
683 Editor.Name := SaveName;
684 except
685 Editor.Name := SaveName + '_' + IntToStr(Index);
686 end;
687end;
688
689end.
690
Note: See TracBrowser for help on using the repository browser.