source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fODLabImmedColl.pas@ 1797

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

Adding foia-cprs branch

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