source: cprs/branches/foia-cprs/CPRS-Chart/Consults/fConsultBD.pas@ 755

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

Adding foia-cprs branch

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