| 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.
 | 
|---|