[456] | 1 | unit fODLabImmedColl;
|
---|
| 2 |
|
---|
| 3 | interface
|
---|
| 4 |
|
---|
| 5 | uses
|
---|
| 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
| 7 | StdCtrls, ORCtrls, ORDtTm, ExtCtrls, ORFn;
|
---|
| 8 |
|
---|
| 9 | type
|
---|
| 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 |
|
---|
| 29 | function SelectImmediateCollectTime(FontSize: integer; CollTime: string): string;
|
---|
| 30 |
|
---|
| 31 | implementation
|
---|
| 32 |
|
---|
| 33 | {$R *.DFM}
|
---|
| 34 |
|
---|
| 35 | uses rODLab;
|
---|
| 36 |
|
---|
| 37 | const
|
---|
| 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 |
|
---|
| 42 | function SelectImmediateCollectTime(FontSize: integer; CollTime: string): string;
|
---|
| 43 | { displays select form for immediate collect time and returns a record of the selection }
|
---|
| 44 | var
|
---|
| 45 | frmODLabImmedColl: TfrmODLabImmedColl;
|
---|
| 46 | begin
|
---|
| 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;
|
---|
| 59 | end;
|
---|
| 60 |
|
---|
| 61 | procedure TfrmODLabImmedColl.cmdCancelClick(Sender: TObject);
|
---|
| 62 | begin
|
---|
| 63 | FCollTime := '-1' ;
|
---|
| 64 | Close;
|
---|
| 65 | end;
|
---|
| 66 |
|
---|
| 67 | procedure TfrmODLabImmedColl.cmdOKClick(Sender: TObject);
|
---|
| 68 | var
|
---|
| 69 | x: string;
|
---|
| 70 | begin
|
---|
| 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;
|
---|
| 90 | end;
|
---|
| 91 |
|
---|
| 92 |
|
---|
| 93 | procedure TfrmODLabImmedColl.FormShow(Sender: TObject);
|
---|
| 94 | begin
|
---|
| 95 | memImmedCollect.Lines.Assign(ImmediateCollectTimes);
|
---|
| 96 | if Length(FCollTime) > 0 then
|
---|
| 97 | calImmedCollect.Text := FCollTime
|
---|
| 98 | else
|
---|
| 99 | calImmedCollect.FMDateTime := GetDefaultImmCollTime;
|
---|
| 100 | ActiveControl := calImmedCollect;
|
---|
| 101 | end;
|
---|
| 102 |
|
---|
| 103 | procedure TfrmODLabImmedColl.calImmedCollectKeyUp(Sender: TObject;
|
---|
| 104 | var Key: Word; Shift: TShiftState);
|
---|
| 105 | begin
|
---|
| 106 | if Key = VK_ESCAPE then
|
---|
| 107 | begin
|
---|
| 108 | Key := 0;
|
---|
| 109 | cmdCancelClick(cmdCancel);
|
---|
| 110 | end;
|
---|
| 111 | end;
|
---|
| 112 |
|
---|
| 113 | end.
|
---|