source: cprs/branches/GUI-config/CPRS-Lib/Vawrgrid.pas@ 1383

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

New WorldVistA Config Utility

File size: 4.6 KB
Line 
1unit Vawrgrid;
2
3
4
5interface
6
7uses
8 SysUtils, Windows, Messages, Classes, Graphics, Controls,
9 Forms, Dialogs, Grids;
10
11type
12 TVAWrapGrid = class(TStringGrid)
13 private
14 { Private declarations }
15 fHiddenCols: string;
16 fHiddenColMap: string[255];
17 procedure SetHiddenCols(Value:string);
18 protected
19 { Protected declarations }
20 { This DrawCell procedure wraps text in the grid cell }
21 procedure DrawCell(Col, Row : Longint; Rect : TRect; State : TGridDrawState); override ;
22 public
23 constructor Create(AOwner : TComponent); override ;
24 published
25 { Published declarations }
26 property HiddenCols: string read fHiddenCols write SetHiddenCols;
27 end;
28
29procedure Register;
30
31implementation
32
33constructor TVAWrapGrid.Create(AOwner : TComponent);
34begin
35 { Create a TStringGrid }
36 inherited Create(AOwner);
37 HiddenCols:='';
38 {change to bit map someday}
39 fHiddenColMap:='';
40end;
41
42
43procedure TVAWrapGrid.SetHiddenCols(value:string);
44var
45 v,old:string;
46 j:integer;
47 procedure SetCol(val:string);
48 var
49 i:integer;
50 begin
51 i:=strtoint(val) + 1; {offset for 1 based string index}
52 if (i in [1..255]) then fHiddenColMap[i]:='1';
53 end;
54begin
55 old:=fHiddenColMap; {save oldmap image}
56 fHiddenCols:=Value;
57 fHiddenColMap:=''; {reset the map}
58 for j:=1 to 255 do
59 fHiddenColMap:=fHiddenColMap + '0';
60 while pos(',',value)>0 do
61 begin
62 v:=copy(value,1,pos(',',value)-1);
63 SetCol(v);
64 Delete(value,1,pos(',',value));
65 end;
66 if value <> '' then
67 begin
68 SetCol(value); {get the last piece}
69 if not (csDesigning in componentstate) then
70 invalidate;
71 end;
72 if old='' then exit;
73 if (old <> fHiddenColMap) and (not (csDesigning in componentState)) then
74 begin
75 j:=pos('1',old);
76 while j > 0 do
77 begin
78 if fHiddenColMap[j]='0' then
79 if pred(j) < colcount then colwidths[pred(j)]:=defaultcolwidth;
80 old[j]:='0'; {get rid of hit}
81 j:=pos('1',old);
82 end;
83 end;
84end;
85
86
87{ This DrawCell procedure wraps text in the grid cell }
88procedure TVAWrapGrid.DrawCell(Col,Row: Longint; Rect: TRect; State: TGridDrawState);
89var
90 i, MaxRowHeight, CurrRowHeight, hgt, CellLen :integer;
91 CellValue :PChar;
92begin
93 {don't display hidden cols}
94 if RowHeights[Row] = 0 then exit;
95 if (fHiddenColMap[succ(col)] = '1') and (not (csDesigning in componentstate)) then
96 {disappear the column}
97 begin
98 if colwidths[col] > 0 then colwidths[col] := 0;
99 exit;
100 end;
101 with Canvas do {not a hidden col}
102 begin
103 if colwidths[col]=0 then ColWidths[col] := defaultcolwidth;
104 { Initialize the font to be the control's font }
105 Canvas.Font := Font;
106 Canvas.Font.Color := Font.Color;
107 {If this is a fixed cell, then use the fixed color }
108 if gdFixed in State then
109 begin
110 Pen.Color := FixedColor;
111 Brush.Color := FixedColor;
112 font.color := self.font.color;
113 end
114 {if highlighted cell}
115 else if (gdSelected in State) and
116 (not (gdFocused in State) or
117 ([goDrawFocusSelected, goRowSelect] * Options <> [])) then
118 begin
119 Brush.Color := clHighlight;
120 Font.Color := clHighlightText;
121 end
122 {else, use the normal color }
123 else
124 begin
125 Pen.Color := Color;
126 Brush.Color := Color;
127 font.color := self.font.color;
128 end;
129 {Prepaint cell in cell color }
130 FillRect(rect);
131 end;
132
133 CellValue := PChar(cells[col,row]);
134 CellLen := strlen(CellValue);
135
136 {get cell size}
137 Drawtext(canvas.handle,CellValue,CellLen,rect,DT_LEFT or DT_WORdbreak or DT_CALCRECT or DT_NOPREFIX);
138
139 {Draw text in cell}
140 Drawtext(canvas.handle,CellValue,CellLen,rect,DT_LEFT or DT_WORdbreak or DT_NOPREFIX);
141
142 {adjust row heights up OR DOWN}
143 MaxRowHeight := DefaultRowHeight;
144 CurrRowHeight := RowHeights[row];
145 for i := pred(colcount) downto 0 do
146 begin
147 if (not (gdFixed in state)) then
148 begin
149 rect := cellrect(i,row);
150 hgt := Drawtext(canvas.handle,PChar(cells[i,row]),length(cells[i,row]),rect,DT_LEFT or
151 DT_WORdbreak or DT_CALCRECT or DT_NOPREFIX);
152 if hgt > MaxRowHeight then MaxRowHeight := hgt;
153 end;
154 end;
155
156 if MaxRowHeight <> CurrRowHeight then rowheights[row] := MaxRowHeight;
157
158end;
159
160procedure Register;
161begin
162 { You can change Samples to whichever part of the Component Palette you want
163 to install this component to }
164 RegisterComponents('CPRS', [TVAWrapGrid]);
165end;
166
167end.
168
Note: See TracBrowser for help on using the repository browser.