Module

fDateRange

Path

C:\CPRS\CPRS30\fDateRange.pas

Last Modified

7/15/2014 3:26:36 PM

Units Used in Interface

Name Comments
fAutoSz -

Units Used in Implementation

Name Comments
rCore -

Classes

Name Comments
TfrmDateRange -

Procedures

Name Owner Declaration Scope Comments
cmdCancelClick TfrmDateRange procedure cmdCancelClick(Sender: TObject); Public/Published -
cmdOKClick TfrmDateRange procedure cmdOKClick(Sender: TObject); Public/Published -
FormCreate TfrmDateRange procedure FormCreate(Sender: TObject); Public/Published -

Functions

Name Owner Declaration Scope Comments
ExecuteDateRange - function ExecuteDateRange(var Start, Stop: string; const AFlag, ATitle, Instruct, StartLabel, StopLabel: string): Boolean; Interfaced -

Constants

Name Declaration Scope Comments
TC_INVALID_DATE 'Unable to interpret date/time entry.' Global -
TX_INVALID_DATE 'The date/time entered could not be validated.' Global -


Module Source

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.

Module Calls (2 levels)


fDateRange
 └fAutoSz
   └fBase508Form

Module Called-By (2 levels)


    fDateRange
fOrdersRenew┘ 
   fOrders┤   
     fMeds┘