source: cprs/branches/tmg-cprs/CPRS-Chart/Consults/fConsultBD.pas@ 1742

Last change on this file since 1742 was 453, checked in by Kevin Toppenberg, 16 years ago

Initial upload of TMG-CPRS 1.0.26.69

File size: 3.6 KB
RevLine 
[453]1unit fConsultBD;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORFN,
7 StdCtrls, ExtCtrls, ORCtrls, ORDtTm, uConsults, DKLang;
8
9type
10 TfrmConsultsByDate = class(TForm)
11 pnlBase: TORAutoPanel;
12 lblBeginDate: TLabel;
13 calBeginDate: TORDateBox;
14 lblEndDate: TLabel;
15 calEndDate: TORDateBox;
16 radSort: TRadioGroup;
17 cmdOK: TButton;
18 cmdCancel: TButton;
19 DKLanguageController1: TDKLanguageController;
20 procedure cmdOKClick(Sender: TObject);
21 procedure cmdCancelClick(Sender: TObject);
22 procedure calBeginDateKeyPress(Sender: TObject; var Key: Char);
23 procedure calEndDateKeyPress(Sender: TObject; var Key: Char);
24 private
25 FChanged: Boolean;
26 FBeginDate: string;
27 FEndDate: string;
28 FAscending: Boolean;
29 end;
30
31 TConsultDateRange = record
32 Changed: Boolean;
33 BeginDate: string;
34 EndDate: string;
35 Ascending: Boolean;
36 end;
37
38function SelectConsultDateRange(FontSize: Integer; CurrentContext: TSelectContext; var ConsultDateRange: TConsultDateRange): boolean;
39
40implementation
41
42{$R *.DFM}
43
44uses rCore, rConsults;
45
46const
47 TX_DATE_ERR = 'Enter valid beginning and ending dates or press Cancel.';
48 TX_DATE_ERR_CAP = 'Error in Date Range';
49
50function SelectConsultDateRange(FontSize: Integer; CurrentContext: TSelectContext; var ConsultDateRange: TConsultDateRange): boolean;
51{ displays date range select form for progress Consults and returns a record of the selection }
52var
53 frmConsultsByDate: TfrmConsultsByDate;
54 W, H: Integer;
55 CurrentBegin, CurrentEnd: string;
56begin
57 frmConsultsByDate := TfrmConsultsByDate.Create(Application);
58 try
59 with frmConsultsByDate do
60 begin
61 Font.Size := FontSize;
62 W := ClientWidth;
63 H := ClientHeight;
64 ResizeToFont(FontSize, W, H);
65 ClientWidth := W; pnlBase.Width := W;
66 ClientHeight := H; pnlBase.Height := H;
67 FChanged := False;
68 with radSort do {if SortConsultsAscending then ItemIndex := 0 else} ItemIndex := 1;
69 CurrentBegin := CurrentContext.BeginDate;
70 CurrentEnd := CurrentContext.EndDate;
71 if CurrentBegin <> '' then
72 calBeginDate.Text := CurrentBegin;
73 if CurrentEnd <> '' then
74 calEndDate.Text := CurrentEnd;
75 if calEndDate.Text = '' then calEndDate.Text := 'TODAY';
76 ShowModal;
77 with ConsultDateRange do
78 begin
79 Changed := FChanged;
80 BeginDate := FBeginDate;
81 EndDate := FEndDate;
82 Ascending := FAscending;
83 Result := Changed ;
84 end; {with ConsultDateRange}
85 end; {with frmConsultsByDate}
86 finally
87 frmConsultsByDate.Release;
88 end;
89end;
90
91procedure TfrmConsultsByDate.cmdOKClick(Sender: TObject);
92var
93 bdate, edate: TFMDateTime;
94begin
95 bdate := StrToFMDateTime(calBeginDate.Text);
96 edate := StrToFMDateTime(calEndDate.Text);
97 if ((bdate > 0) and (edate > 0)) and (bdate <= edate) then
98 begin
99 FChanged := True;
100 FBeginDate := calBeginDate.Text;
101 FEndDate := calEndDate.Text;
102 FAscending := radSort.ItemIndex = 0;
103 Close;
104 end else
105 begin
106 InfoBox(TX_DATE_ERR, TX_DATE_ERR_CAP, MB_OK or MB_ICONWARNING);
107 Exit;
108 end;
109end;
110
111procedure TfrmConsultsByDate.cmdCancelClick(Sender: TObject);
112begin
113 Close;
114end;
115
116procedure TfrmConsultsByDate.calBeginDateKeyPress(Sender: TObject;
117 var Key: Char);
118begin
119 if (Key = #13) then cmdOKClick(Self);
120end;
121
122procedure TfrmConsultsByDate.calEndDateKeyPress(Sender: TObject;
123 var Key: Char);
124begin
125 if (Key = #13) then cmdOKClick(Self);
126end;
127
128end.
Note: See TracBrowser for help on using the repository browser.