source: cprs/branches/tmg-cprs/CPRS-Chart/Encounter/fPCEBaseGrid.pas@ 1742

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

Initial upload of TMG-CPRS 1.0.26.69

File size: 5.3 KB
Line 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit fPCEBaseGrid;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 fPCEBase, ComCtrls, StdCtrls, ORCtrls, ExtCtrls, Buttons, ORFn, DKLang;
9
10type
11 TfrmPCEBaseGrid = class(TfrmPCEBase)
12 pnlGrid: TPanel;
13 lbGrid: TORListBox;
14 hcGrid: THeaderControl;
15 procedure FormCreate(Sender: TObject);
16 procedure hcGridSectionResize(HeaderControl: THeaderControl;
17 Section: THeaderSection);
18 procedure pnlGridResize(Sender: TObject);
19 private
20 FSel: string;
21 FGridHeaderSyncing: boolean;
22 function GetGridIndex: integer;
23 procedure SetGridIndex(const Value: integer);
24 protected
25 FSectionGap: integer;
26 procedure UpdateControls; virtual;
27 procedure SaveGridSelected;
28 procedure RestoreGridSelected;
29 public
30 procedure SyncGridHeader(FromHeader: boolean);
31 procedure SyncGridData;
32 procedure ClearGrid;
33 property GridIndex: integer read GetGridIndex write SetGridIndex;
34 end;
35
36var
37 frmPCEBaseGrid: TfrmPCEBaseGrid;
38
39implementation
40
41{$R *.DFM}
42
43const
44 JustificationGap = 5;
45
46procedure TfrmPCEBaseGrid.FormCreate(Sender: TObject);
47begin
48 inherited;
49 lbGrid.Color := ReadOnlyColor;
50 lbGrid.ItemTipColor := ReadOnlyColor;
51 FSectionGap := 15;
52 SyncGridHeader(TRUE);
53end;
54
55procedure TfrmPCEBaseGrid.SyncGridHeader(FromHeader: boolean);
56var
57 i, w, wd, wp, Gap: integer;
58 txt: string;
59
60begin
61 if(not FGridHeaderSyncing) then
62 begin
63 Gap := JustificationGap;
64 FGridHeaderSyncing := TRUE;
65 try
66 if(FromHeader) then
67 begin
68 txt := '';
69 w := 0;
70 for i := 0 to hcGrid.Sections.Count-2 do
71 begin
72 if(i > 0) then
73 txt := txt + ',';
74 inc(w,(hcGrid.Sections[i].Width div 2)*2);
75 txt := txt + IntToStr(w + Gap);
76 Gap := 0;
77 end;
78 lbGrid.TabPositions := txt;
79 end
80 else
81 begin
82 txt := lbGrid.TabPositions;
83 wd := 0;
84 for i := 0 to hcGrid.Sections.Count-2 do
85 begin
86 wp := StrToIntDef(Piece(txt,',',i+1),hcGrid.Sections[i].MinWidth);
87 w := wp - wd;
88 hcGrid.Sections[i].Width := w - Gap;
89 Gap := 0;
90 wd := wp;
91 end;
92 end;
93 w := 0;
94 for i := 0 to hcGrid.Sections.Count-2 do
95 inc(w,hcGrid.Sections[i].Width);
96 hcGrid.Sections[hcGrid.Sections.Count-1].Width := pnlGrid.Width - w;
97 finally
98 FGridHeaderSyncing := FALSE;
99 end;
100 end;
101end;
102
103procedure TfrmPCEBaseGrid.hcGridSectionResize(
104 HeaderControl: THeaderControl; Section: THeaderSection);
105begin
106 inherited;
107 SyncGridHeader(TRUE);
108end;
109
110procedure TfrmPCEBaseGrid.pnlGridResize(Sender: TObject);
111begin
112 inherited;
113 SyncGridHeader(TRUE);
114end;
115
116procedure TfrmPCEBaseGrid.SyncGridData;
117var
118 tp, ltp, i, j, tlen: integer;
119 max: array[0..9] of integer; // more than 10 header sections will cause this to explode
120 tmp: string;
121
122begin
123 if(lbGrid.Items.Count > 0) then
124 begin
125 for j := 0 to hcGrid.Sections.Count-2 do max[j] := 0;
126 for i := 0 to lbGrid.Items.Count-1 do
127 begin
128 tmp := lbGrid.Items[i];
129 for j := 0 to hcGrid.Sections.Count-2 do
130 begin
131 tlen := Canvas.TextWidth(Piece(tmp,U,j+1)) + FSectionGap;
132 if(max[j] < tlen) then
133 max[j] := tlen;
134 end;
135 end;
136 ltp := 0;
137 tmp := lbGrid.TabPositions;
138 for i := 0 to hcGrid.Sections.Count-2 do
139 begin
140 if(max[i] < hcGrid.Sections[i].MinWidth) then
141 max[i] := hcGrid.Sections[i].MinWidth;
142 tp := StrToIntDef(Piece(tmp,',',i+1),0);
143 tlen := tp - ltp;
144 ltp := tp;
145 if(max[i] < tlen) then
146 max[i] := tlen;
147 end;
148 for i := 1 to hcGrid.Sections.Count-2 do
149 inc(max[i], max[i-1]);
150 tmp := '';
151 for i := 0 to hcGrid.Sections.Count-2 do
152 tmp := tmp + ',' + inttostr(max[i]);
153 delete(tmp,1,1);
154 if(lbGrid.TabPositions <> tmp) then
155 begin
156 SaveGridSelected;
157 lbGrid.TabPositions := tmp;
158 RestoreGridSelected;
159 end;
160 SyncGridHeader(FALSE);
161 end;
162end;
163
164function TfrmPCEBaseGrid.GetGridIndex: integer;
165var
166 i: integer;
167
168begin
169 Result := -1;
170 if(lbGrid.SelCount > 0) then
171 begin
172 for i := 0 to lbGrid.Items.Count-1 do
173 if(lbGrid.Selected[i]) then
174 begin
175 Result := i;
176 exit;
177 end;
178 end;
179end;
180
181procedure TfrmPCEBaseGrid.SetGridIndex(const Value: integer);
182var
183 i: integer;
184
185begin
186 for i := 0 to lbGrid.Items.Count-1 do
187 lbGrid.Selected[i] := (i = Value);
188 UpdateControls;
189end;
190
191procedure TfrmPCEBaseGrid.ClearGrid;
192var
193 i: integer;
194
195begin
196 if lbGrid.SelCount > 0 then
197 begin
198 for i := 0 to lbGrid.Items.Count-1 do
199 lbGrid.Selected[i] := FALSE;
200 end;
201 UpdateControls;
202end;
203
204procedure TfrmPCEBaseGrid.UpdateControls;
205begin
206end;
207
208procedure TfrmPCEBaseGrid.RestoreGridSelected;
209var
210 i: integer;
211
212begin
213 for i := 0 to lbGrid.Items.Count-1 do
214 lbGrid.Selected[i] := (copy(FSel,i+1,1) = BOOLCHAR[TRUE]);
215end;
216
217procedure TfrmPCEBaseGrid.SaveGridSelected;
218var
219 i: integer;
220begin
221 FSel := '';
222 for i := 0 to lbGrid.Items.Count-1 do
223 FSel := FSel + BOOLCHAR[lbGrid.Selected[i]];
224end;
225
226end.
Note: See TracBrowser for help on using the repository browser.