| 1 | unit fDateRange; | 
|---|
| 2 |  | 
|---|
| 3 | interface | 
|---|
| 4 |  | 
|---|
| 5 | uses | 
|---|
| 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, | 
|---|
| 7 | fAutoSz, ORCtrls, StdCtrls, ORFn, ORDtTm, VA508AccessibilityManager; | 
|---|
| 8 |  | 
|---|
| 9 | type | 
|---|
| 10 | TfrmDateRange = class(TfrmAutoSz) | 
|---|
| 11 | txtStart: TORDateBox; | 
|---|
| 12 | txtStop: TORDateBox; | 
|---|
| 13 | lblStart: TLabel; | 
|---|
| 14 | lblStop: TLabel; | 
|---|
| 15 | cmdOK: TButton; | 
|---|
| 16 | cmdCancel: TButton; | 
|---|
| 17 | lblInstruct: TOROffsetLabel; | 
|---|
| 18 | procedure cmdOKClick(Sender: TObject); | 
|---|
| 19 | procedure cmdCancelClick(Sender: TObject); | 
|---|
| 20 | procedure FormCreate(Sender: TObject); | 
|---|
| 21 | private | 
|---|
| 22 | OKPressed: Boolean; | 
|---|
| 23 | Flags: string; | 
|---|
| 24 | end; | 
|---|
| 25 |  | 
|---|
| 26 | function ExecuteDateRange(var Start, Stop: string; const AFlag, ATitle, Instruct, | 
|---|
| 27 | StartLabel, StopLabel: string): Boolean; | 
|---|
| 28 |  | 
|---|
| 29 | implementation | 
|---|
| 30 |  | 
|---|
| 31 | {$R *.DFM} | 
|---|
| 32 |  | 
|---|
| 33 | uses rCore; | 
|---|
| 34 |  | 
|---|
| 35 | const | 
|---|
| 36 | TX_INVALID_DATE = 'The date/time entered could not be validated.'; | 
|---|
| 37 | TC_INVALID_DATE = 'Unable to interpret date/time entry.'; | 
|---|
| 38 |  | 
|---|
| 39 | function ExecuteDateRange(var Start, Stop: string; const AFlag, ATitle, Instruct, | 
|---|
| 40 | StartLabel, StopLabel: string): Boolean; | 
|---|
| 41 | var | 
|---|
| 42 | frmDateRange: TfrmDateRange; | 
|---|
| 43 | begin | 
|---|
| 44 | Result := False; | 
|---|
| 45 | frmDateRange := TfrmDateRange.Create(Application); | 
|---|
| 46 | try | 
|---|
| 47 | ResizeFormToFont(TForm(frmDateRange)); | 
|---|
| 48 | with frmDateRange do | 
|---|
| 49 | begin | 
|---|
| 50 | if Flags      <> '' then Flags := AFlag; | 
|---|
| 51 | if ATitle     <> '' then Caption := ATitle; | 
|---|
| 52 | if Instruct   <> '' then lblInstruct.Caption := Instruct; | 
|---|
| 53 | if StartLabel <> '' then lblStart.Caption := StartLabel; | 
|---|
| 54 | if StopLabel  <> '' then lblStop.Caption := StopLabel; | 
|---|
| 55 | txtStart.Text := Start; | 
|---|
| 56 | txtStop.Text  := Stop; | 
|---|
| 57 | ShowModal; | 
|---|
| 58 | if OKPressed then | 
|---|
| 59 | begin | 
|---|
| 60 | Start := txtStart.Text; | 
|---|
| 61 | Stop  := txtStop.Text; | 
|---|
| 62 | Result := True; | 
|---|
| 63 | end; | 
|---|
| 64 | end; | 
|---|
| 65 | finally | 
|---|
| 66 | frmDateRange.Release; | 
|---|
| 67 | end; | 
|---|
| 68 | end; | 
|---|
| 69 |  | 
|---|
| 70 | procedure TfrmDateRange.FormCreate(Sender: TObject); | 
|---|
| 71 | begin | 
|---|
| 72 | inherited; | 
|---|
| 73 | OKPressed := False; | 
|---|
| 74 | end; | 
|---|
| 75 |  | 
|---|
| 76 | procedure TfrmDateRange.cmdOKClick(Sender: TObject); | 
|---|
| 77 | const | 
|---|
| 78 | TX_BAD_START   = 'The start date is not valid.'; | 
|---|
| 79 | TX_BAD_STOP    = 'The stop date is not valid.'; | 
|---|
| 80 | TX_STOPSTART   = 'The stop date must be after the start date.'; | 
|---|
| 81 | var | 
|---|
| 82 | x, ErrMsg: string; | 
|---|
| 83 | begin | 
|---|
| 84 | inherited; | 
|---|
| 85 | ErrMsg := ''; | 
|---|
| 86 | txtStart.Validate(x); | 
|---|
| 87 | if Length(x) > 0   then ErrMsg := ErrMsg + TX_BAD_START + CRLF; | 
|---|
| 88 | with txtStop do | 
|---|
| 89 | begin | 
|---|
| 90 | Validate(x); | 
|---|
| 91 | if Length(x) > 0 then ErrMsg := ErrMsg + TX_BAD_STOP + CRLF; | 
|---|
| 92 | if (Length(Text) > 0) and (FMDateTime <= txtStart.FMDateTime) | 
|---|
| 93 | then ErrMsg := ErrMsg + TX_STOPSTART; | 
|---|
| 94 | end; | 
|---|
| 95 | if Length(ErrMsg) > 0 then | 
|---|
| 96 | begin | 
|---|
| 97 | InfoBox(ErrMsg, TC_INVALID_DATE, MB_OK); | 
|---|
| 98 | Exit; | 
|---|
| 99 | end; | 
|---|
| 100 |  | 
|---|
| 101 | //  if ((Length(txtStart.Text) > 0) and (ValidDateTimeStr(txtStart.Text, Flags) < 0)) | 
|---|
| 102 | //  or ((Length(txtStop.Text)  > 0) and (ValidDateTimeStr(txtStop.Text, Flags)  < 0)) then | 
|---|
| 103 | //  begin | 
|---|
| 104 | //    InfoBox(TX_INVALID_DATE, TC_INVALID_DATE, MB_OK); | 
|---|
| 105 | //    Exit; | 
|---|
| 106 | //  end; | 
|---|
| 107 |  | 
|---|
| 108 | OKPressed := True; | 
|---|
| 109 | Close; | 
|---|
| 110 | end; | 
|---|
| 111 |  | 
|---|
| 112 | procedure TfrmDateRange.cmdCancelClick(Sender: TObject); | 
|---|
| 113 | begin | 
|---|
| 114 | inherited; | 
|---|
| 115 | Close; | 
|---|
| 116 | end; | 
|---|
| 117 |  | 
|---|
| 118 | end. | 
|---|