source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/fIconLegend.pas@ 1722

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

Upgrading to version 27

File size: 5.9 KB
Line 
1unit fIconLegend;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, dShared,
7 ComCtrls, StdCtrls, ExtCtrls, ImgList, mImgText, Menus, FAutoSz,
8 VA508AccessibilityManager;
9
10type
11 TIconLegendType = (ilLast, ilNotes, ilTemplates, ilReminders, ilConsults, ilSurgery);
12
13 TfrmIconLegend = class(TfrmAutoSz)
14 pcMain: TPageControl;
15 pnlBottom: TPanel;
16 Templates: TTabSheet;
17 Reminders: TTabSheet;
18 btnOK: TButton;
19 fraImgText1: TfraImgText;
20 fraImgText2: TfraImgText;
21 fraImgText3: TfraImgText;
22 fraImgText4: TfraImgText;
23 fraImgText5: TfraImgText;
24 fraImgText6: TfraImgText;
25 fraImgText7: TfraImgText;
26 fraImgText12: TfraImgText;
27 Panel1: TPanel;
28 fraImgText8: TfraImgText;
29 fraImgText10: TfraImgText;
30 fraImgText15: TfraImgText;
31 fraImgText16: TfraImgText;
32 fraImgText17: TfraImgText;
33 fraImgText13: TfraImgText;
34 fraImgText14: TfraImgText;
35 Panel2: TPanel;
36 fraImgText22: TfraImgText;
37 fraImgText20: TfraImgText;
38 fraImgText19: TfraImgText;
39 fraImgText18: TfraImgText;
40 fraImgText21: TfraImgText;
41 fraImgText11: TfraImgText;
42 fraImgText9: TfraImgText;
43 fraImgText23: TfraImgText;
44 fraImgText24: TfraImgText;
45 Label1: TLabel;
46 Label2: TLabel;
47 Label3: TLabel;
48 Notes: TTabSheet;
49 fraImgText25: TfraImgText;
50 fraImgText26: TfraImgText;
51 fraImgText27: TfraImgText;
52 fraImgText28: TfraImgText;
53 fraImgText29: TfraImgText;
54 fraImgText30: TfraImgText;
55 fraImgText31: TfraImgText;
56 fraImgText32: TfraImgText;
57 fraImgText33: TfraImgText;
58 fraImgText34: TfraImgText;
59 Consults: TTabSheet;
60 Panel3: TPanel;
61 fraImgText35: TfraImgText;
62 fraImgText36: TfraImgText;
63 fraImgText43: TfraImgText;
64 Panel4: TPanel;
65 Label5: TLabel;
66 fraImgText41: TfraImgText;
67 fraImgText37: TfraImgText;
68 fraImgText38: TfraImgText;
69 fraImgText39: TfraImgText;
70 fraImgText40: TfraImgText;
71 Label4: TLabel;
72 fraImgText44: TfraImgText;
73 Surgery: TTabSheet;
74 fraImgText42: TfraImgText;
75 fraImgText45: TfraImgText;
76 fraImgText46: TfraImgText;
77 fraImgText47: TfraImgText;
78 fraImgText48: TfraImgText;
79 fraImgText49: TfraImgText;
80 fraImgText50: TfraImgText;
81 fraImgText51: TfraImgText;
82 fraImgText52: TfraImgText;
83 fraImgText53: TfraImgText;
84 fraImgText54: TfraImgText;
85 fraImgText55: TfraImgText;
86 fraImgText56: TfraImgText;
87 fraImgText57: TfraImgText;
88 fraImgText58: TfraImgText;
89 fraImgText59: TfraImgText;
90 fraImgText60: TfraImgText;
91 fraImgText61: TfraImgText;
92 procedure btnOKClick(Sender: TObject);
93 procedure FormClose(Sender: TObject; var Action: TCloseAction);
94 procedure FormDestroy(Sender: TObject);
95 procedure FormKeyDown(Sender: TObject; var Key: Word;
96 Shift: TShiftState);
97 private
98 procedure ShowTab(tb: TIconLegendType);
99 procedure SnapLabels;
100 public
101 class procedure SetFontSize( NewFontSize: integer);
102 end;
103
104procedure ShowIconLegend(IconType: TIconLegendType; Restart: boolean = FALSE);
105
106implementation
107
108uses
109 fFrame, uConst, ORFn;
110
111{$R *.DFM}
112
113var
114 frmIconLegend: TfrmIconLegend = nil;
115 LastX, LastY: integer;
116 FirstSize: boolean = TRUE;
117
118procedure ShowIconLegend(IconType: TIconLegendType; Restart: boolean = FALSE);
119begin
120 if assigned(frmIconLegend) and Restart then
121 FreeAndNil(frmIconLegend);
122 if not assigned(frmIconLegend) then
123 begin
124 frmIconLegend := TfrmIconLegend.Create(Application);
125 frmIconLegend.Surgery.TabVisible := frmFrame.TabExists(CT_SURGERY);
126 end;
127 frmIconLegend.ShowTab(IconType);
128 TfrmIconLegend.SetFontSize( MainFontSize );
129 frmIconLegend.Show;
130end;
131
132procedure TfrmIconLegend.btnOKClick(Sender: TObject);
133begin
134 Close;
135end;
136
137procedure TfrmIconLegend.ShowTab(tb: TIconLegendType);
138begin
139 case tb of
140 ilTemplates: pcMain.ActivePage := Templates;
141 ilReminders: pcMain.ActivePage := Reminders;
142 ilNotes: pcMain.ActivePage := Notes;
143 ilConsults: pcMain.ActivePage := Consults;
144 ilSurgery: pcMain.ActivePage := Surgery;
145 end;
146end;
147
148procedure TfrmIconLegend.FormClose(Sender: TObject;
149 var Action: TCloseAction);
150begin
151 Action := caFree;
152
153end;
154
155procedure TfrmIconLegend.FormDestroy(Sender: TObject);
156begin
157 LastX := Left;
158 LastY := Top;
159 frmIconLegend := nil;
160end;
161
162class procedure TfrmIconLegend.SetFontSize( NewFontSize: integer);
163begin
164 if Assigned(frmIconLegend) then begin
165 if FirstSize or (frmIconLegend.Font.Size <> NewFontSize) then begin
166 ResizeFormToFont(frmIconLegend);
167 frmIconLegend.Font.Size := NewFontSize;
168 frmIconLegend.SnapLabels;
169 FirstSize := FALSE;
170 LastX := (Screen.Width - frmIconLegend.Width) div 2;
171 LastY := (Screen.Height - frmIconLegend.Height) div 2;
172 end;
173 frmIconLegend.Left := LastX;
174 frmIconLegend.Top := LastY;
175 end;
176end;
177
178procedure TfrmIconLegend.SnapLabels;
179var
180 i: integer;
181begin
182 for i := 0 to ComponentCount-1 do
183 if Components[i] is TfraImgText then
184 with TfraImgText(Components[i]).lblText do
185 if (AutoSize and WordWrap) then begin
186 {Snap width to fit. We turn autosize off and on to snap height, too.
187 If we don't tweak AutoSize, it tends to give the frame a vertical
188 scroll bar.}
189 AutoSize := False;
190 Width := Parent.Width - Left - ScrollBarWidth;
191 AutoSize := True;
192 end;
193end;
194
195procedure TfrmIconLegend.FormKeyDown(Sender: TObject; var Key: Word;
196 Shift: TShiftState);
197begin
198 inherited;
199 if (Key = VK_TAB) then begin
200 if (ssCtrl in Shift) then begin
201 if not (ActiveControl is TCustomMemo) or not TMemo(ActiveControl).WantTabs then begin
202 pcMain.SelectNextPage( not (ssShift in Shift));
203 Key := 0;
204 end;
205 end;
206 end;
207end;
208
209end.
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
Note: See TracBrowser for help on using the repository browser.