source: cprs/branches/tmg-cprs/CPRS-Chart/fAllgyBox.pas@ 770

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

Initial upload of TMG-CPRS 1.0.26.69

File size: 4.4 KB
Line 
1//kt -- Modified with SourceScanner on 7/8/2007
2unit fAllgyBox;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
8 Dialogs, fRptBox, StdCtrls, ExtCtrls, ComCtrls, fARTAllgy, ORFn, DKLang;
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 SetLength(BtnLeft, k);
84 for j := 0 to k - 1 do
85 BtnLeft[j] := pnlButton.Width - BtnArray[j].Width - BtnRight[j];
86 memReport.Lines.Assign(ReportText);
87 for i := 1 to Length(ReportTitle) do if ReportTitle[i] = #9 then ReportTitle[i] := ' ';
88 Caption := ReportTitle;
89 memReport.SelStart := 0;
90 cmdPrint.Visible := AllowPrint;
91 cmdAdd.Enabled := True; //IsARTClinicalUser(x); v26.12
92 cmdEdit.Enabled := IsARTClinicalUser(x);
93 cmdInError.Enabled := IsARTClinicalUser(x);
94 end;
95 except
96 KillObj(@Result);
97 raise;
98 end;
99end;
100
101procedure AllergyBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean; AllergyIEN: integer);
102begin
103 frmAllgyBox := CreateAllergyBox(ReportText, ReportTitle, AllowPrint);
104 try
105 with frmAllgyBox do
106 begin
107 FAllergyIEN := AllergyIEN;
108 if not ContainsVisibleChar(memReport.Text) then RefreshText;
109 ShowModal;
110 end;
111 finally
112 frmAllgyBox.Release;
113 end;
114end;
115
116procedure TfrmAllgyBox.cmdAddClick(Sender: TObject);
117var
118 Changed: boolean;
119begin
120 inherited;
121 Visible := False;
122 Changed := EnterEditAllergy(0, NEW_ALLERGY, not ENTERED_IN_ERROR);
123 if not Changed then
124 Close
125 else
126 begin
127 frmCover.UpdateAllergiesList;
128 Close;
129 end
130end;
131
132procedure TfrmAllgyBox.cmdEditClick(Sender: TObject);
133var
134 Changed: boolean;
135begin
136 inherited;
137 Visible := False;
138 Changed := EnterEditAllergy(FAllergyIEN, not NEW_ALLERGY, not ENTERED_IN_ERROR);
139 if Changed then RefreshText;
140 Visible := True;
141end;
142
143procedure TfrmAllgyBox.cmdInErrorClick(Sender: TObject);
144var
145 Changed: boolean;
146begin
147 inherited;
148 Visible := False;
149 Changed := MarkEnteredInError(FAllergyIEN);
150 if Changed then
151 begin
152 frmCover.UpdateAllergiesList;
153 Close;
154 end
155 else Visible := True;
156end;
157
158procedure TfrmAllgyBox.RefreshText;
159begin
160 memReport.Clear;
161 memReport.Lines.Assign(DetailAllergy(FAllergyIEN));
162end;
163
164end.
Note: See TracBrowser for help on using the repository browser.