| [459] | 1 | unit fDateRange; | 
|---|
|  | 2 |  | 
|---|
|  | 3 | interface | 
|---|
|  | 4 |  | 
|---|
|  | 5 | uses | 
|---|
|  | 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, | 
|---|
|  | 7 | fAutoSz, ORCtrls, StdCtrls, ORFn, ORDtTm; | 
|---|
|  | 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. | 
|---|