source: cprs/trunk/CPRS-Chart/fAllgyBox.pas@ 1245

Last change on this file since 1245 was 830, checked in by Kevin Toppenberg, 14 years ago

Upgrading to version 27

File size: 5.0 KB
Line 
1unit fAllgyBox;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, fRptBox, StdCtrls, ExtCtrls, ComCtrls, fARTAllgy, ORFn,
8 VA508AccessibilityManager;
9
10type
11 TfrmAllgyBox = class(TfrmReportBox)
12 cmdEdit: TButton;
13 cmdAdd: TButton;
14 cmdInError: TButton;
15 procedure cmdAddClick(Sender: TObject);
16 procedure cmdEditClick(Sender: TObject);
17 procedure cmdInErrorClick(Sender: TObject);
18 private
19 { Private declarations }
20 FAllergyIEN: integer;
21 procedure RefreshText;
22 public
23 { Public declarations }
24 end;
25
26procedure AllergyBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean; AllergyIEN: integer);
27
28var
29 frmAllgyBox: TfrmAllgyBox;
30
31implementation
32
33{$R *.dfm}
34
35uses rCover, fCover, rODAllergy;
36
37const
38 NEW_ALLERGY = True;
39 ENTERED_IN_ERROR = True;
40
41function CreateAllergyBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean): TfrmAllgyBox;
42var
43 i, AWidth, MaxWidth, AHeight: Integer;
44 Rect: TRect;
45 // %$@# buttons!
46 BtnArray: array of TButton;
47 BtnRight: array of integer;
48 BtnLeft: array of integer;
49 j, k: integer;
50 x: string;
51begin
52 Result := TfrmAllgyBox.Create(Application);
53 try
54 with Result do
55 begin
56 k := 0;
57 with pnlButton do for j := 0 to ControlCount - 1 do
58 if Controls[j] is TButton then
59 begin
60 SetLength(BtnArray, k+1);
61 SetLength(BtnRight, k+1);
62 BtnArray[j] := TButton(Controls[j]);
63 BtnRight[j] := ResizeWidth(Font, MainFont, BtnArray[j].Width - BtnArray[j].Width - BtnArray[j].Left);
64 k := k + 1;
65 end;
66 MaxWidth := 350;
67 for i := 0 to ReportText.Count - 1 do
68 begin
69 AWidth := lblFontTest.Canvas.TextWidth(ReportText[i]);
70 if AWidth > MaxWidth then MaxWidth := AWidth;
71 end;
72 MaxWidth := MaxWidth + GetSystemMetrics(SM_CXVSCROLL);
73 AHeight := (ReportText.Count * (lblFontTest.Height + 2)) + pnlbutton.Height;
74 AHeight := HigherOf(AHeight, 250);
75 if AHeight > (Screen.Height - 80) then AHeight := Screen.Height - 80;
76 if MaxWidth > Screen.Width then MaxWidth := Screen.Width;
77 ClientWidth := MaxWidth;
78 ClientHeight := AHeight;
79 Rect := BoundsRect;
80 ForceInsideWorkArea(Rect);
81 BoundsRect := Rect;
82 ResizeAnchoredFormToFont(Result);
83
84 //CQ6889 - force Print & Close buttons to bottom right of form regardless of selected font size
85 cmdClose.Left := (pnlButton.Left+pnlButton.Width)-cmdClose.Width;
86 cmdPrint.Left := (cmdClose.Left-cmdPrint.Width) - 1;
87 //end CQ6889
88
89 Constraints.MinWidth := cmdAdd.Width + cmdEdit.Width + cmdInError.Width + cmdPrint.Width + cmdClose.Width + 20;
90 Constraints.MinHeight := 2*pnlButton.Height + memReport.Height;
91 cmdAdd.Left := 1;
92 cmdEdit.Left := (cmdAdd.Left + cmdAdd.Width) + 1;
93 cmdInError.Left := (cmdEdit.Left + cmdEdit.Width) + 1;
94
95 SetLength(BtnLeft, k);
96 for j := 0 to k - 1 do
97 BtnLeft[j] := pnlButton.Width - BtnArray[j].Width - BtnRight[j];
98 QuickCopy(ReportText, memReport);
99 for i := 1 to Length(ReportTitle) do if ReportTitle[i] = #9 then ReportTitle[i] := ' ';
100 Caption := ReportTitle;
101 memReport.SelStart := 0;
102 cmdPrint.Visible := AllowPrint;
103 cmdAdd.Enabled := True; //IsARTClinicalUser(x); v26.12
104 cmdEdit.Enabled := IsARTClinicalUser(x);
105 cmdInError.Enabled := IsARTClinicalUser(x);
106 end;
107 except
108 KillObj(@Result);
109 raise;
110 end;
111end;
112
113procedure AllergyBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean; AllergyIEN: integer);
114begin
115 frmAllgyBox := CreateAllergyBox(ReportText, ReportTitle, AllowPrint);
116 try
117 with frmAllgyBox do
118 begin
119 FAllergyIEN := AllergyIEN;
120 if not ContainsVisibleChar(memReport.Text) then RefreshText;
121 ShowModal;
122 end;
123 finally
124 frmAllgyBox.Release;
125 end;
126end;
127
128procedure TfrmAllgyBox.cmdAddClick(Sender: TObject);
129var
130 Changed: boolean;
131begin
132 inherited;
133 Visible := False;
134 Changed := EnterEditAllergy(0, NEW_ALLERGY, not ENTERED_IN_ERROR);
135 if not Changed then
136 Close
137 else
138 begin
139 frmCover.UpdateAllergiesList;
140 Close;
141 end
142end;
143
144procedure TfrmAllgyBox.cmdEditClick(Sender: TObject);
145var
146 Changed: boolean;
147begin
148 inherited;
149 Visible := False;
150 Changed := EnterEditAllergy(FAllergyIEN, not NEW_ALLERGY, not ENTERED_IN_ERROR);
151 if Changed then RefreshText;
152 Visible := True;
153end;
154
155procedure TfrmAllgyBox.cmdInErrorClick(Sender: TObject);
156var
157 Changed: boolean;
158begin
159 inherited;
160 Visible := False;
161 Changed := MarkEnteredInError(FAllergyIEN);
162 if Changed then
163 begin
164 frmCover.UpdateAllergiesList;
165 Close;
166 end
167 else Visible := True;
168end;
169
170procedure TfrmAllgyBox.RefreshText;
171begin
172 memReport.Clear;
173 QuickCopy(DetailAllergy(FAllergyIEN), memReport);
174end;
175
176end.
Note: See TracBrowser for help on using the repository browser.