source: cprs/trunk/CPRS-Chart/Encounter/fPCEBaseGrid.pas@ 493

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

Initial Upload of Official WV CPRS 1.0.26.76

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