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