source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fODLabImmedColl.pas@ 792

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

Initial upload of TMG-CPRS 1.0.26.69

File size: 3.5 KB
Line 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit fODLabImmedColl;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 StdCtrls, ORCtrls, ORDtTm, ExtCtrls, ORFn, DKLang;
9
10type
11 TfrmODLabImmedColl = class(TForm)
12 memImmedCollect: TCaptionMemo;
13 calImmedCollect: TORDateBox;
14 cmdOK: TORAlignButton;
15 cmdCancel: TORAlignButton;
16 pnlBase: TORAutoPanel;
17 lblImmedColl: TOROffsetLabel;
18 DKLanguageController1: TDKLanguageController;
19 procedure cmdCancelClick(Sender: TObject);
20 procedure cmdOKClick(Sender: TObject);
21 procedure FormShow(Sender: TObject);
22 procedure calImmedCollectKeyUp(Sender: TObject; var Key: Word;
23 Shift: TShiftState);
24 private
25 FCollTime: string;
26 { Private declarations }
27 public
28 { Public declarations }
29 end;
30
31function SelectImmediateCollectTime(FontSize: integer; CollTime: string): string;
32
33implementation
34
35{$R *.DFM}
36
37uses rODLab;
38
39//const
40//TX_NOTIME_TEXT = 'Enter or select a collection time or press Cancel.'; <-- original line. //kt 8/8/2007
41//TX_NOTIME_CAP = 'Missing Date/Time'; <-- original line. //kt 8/8/2007
42//TX_BADTIME_CAP = 'Invalid Immediate Collect Time'; <-- original line. //kt 8/8/2007
43
44var
45 TX_NOTIME_TEXT : string; //kt
46 TX_NOTIME_CAP : string; //kt
47 TX_BADTIME_CAP : string; //kt
48
49
50procedure SetupVars;
51//kt Added entire function to replace constant declarations 8/8/2007
52begin
53 TX_NOTIME_TEXT := DKLangConstW('fODLabImmedColl_Enter_or_select_a_collection_time_or_press_Cancelx');
54 TX_NOTIME_CAP := DKLangConstW('fODLabImmedColl_Missing_DatexTime');
55 TX_BADTIME_CAP := DKLangConstW('fODLabImmedColl_Invalid_Immediate_Collect_Time');
56end;
57
58function SelectImmediateCollectTime(FontSize: integer; CollTime: string): string;
59{ displays select form for immediate collect time and returns a record of the selection }
60var
61 frmODLabImmedColl: TfrmODLabImmedColl;
62begin
63 frmODLabImmedColl := TfrmODLabImmedColl.Create(Application);
64 try
65 ResizeAnchoredFormToFont(frmODLabImmedColl);
66 with frmODLabImmedColl do
67 begin
68 FCollTime := CollTime;
69 ShowModal;
70 Result := FCollTime;
71 end;
72 finally
73 frmODLabImmedColl.Release;
74 end;
75end;
76
77procedure TfrmODLabImmedColl.cmdCancelClick(Sender: TObject);
78begin
79 FCollTime := '-1' ;
80 Close;
81end;
82
83procedure TfrmODLabImmedColl.cmdOKClick(Sender: TObject);
84var
85 x: string;
86begin
87 SetupVars; //kt added 8/8/2007 to replace constants with vars.
88 if calImmedCollect.FMDateTime = 0 then
89 begin
90 InfoBox(TX_NOTIME_TEXT, TX_NOTIME_CAP, MB_OK or MB_ICONWARNING);
91 Exit;
92 end;
93 if calImmedCollect.FMDateTime > 0 then
94 begin
95 x := ValidImmCollTime(calImmedCollect.FMDateTime);
96 if Piece(x ,U, 1) = '1' then
97 FCollTime := calImmedCollect.Text
98 else
99 begin
100 InfoBox(MixedCase(Piece(x ,U, 2)), TX_BADTIME_CAP, MB_OK or MB_ICONWARNING);
101 Exit;
102 end;
103 end
104 else
105 FCollTime := '-1';
106 Close;
107end;
108
109
110procedure TfrmODLabImmedColl.FormShow(Sender: TObject);
111begin
112 memImmedCollect.Lines.Assign(ImmediateCollectTimes);
113 if Length(FCollTime) > 0 then
114 calImmedCollect.Text := FCollTime
115 else
116 calImmedCollect.FMDateTime := GetDefaultImmCollTime;
117 ActiveControl := calImmedCollect;
118end;
119
120procedure TfrmODLabImmedColl.calImmedCollectKeyUp(Sender: TObject;
121 var Key: Word; Shift: TShiftState);
122begin
123 if Key = VK_ESCAPE then
124 begin
125 Key := 0;
126 cmdCancelClick(cmdCancel);
127 end;
128end;
129
130end.
Note: See TracBrowser for help on using the repository browser.