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