source: cprs/branches/foia-cprs/CPRS-Chart/fIconLegend.pas@ 491

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

Adding foia-cprs branch

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