[453] | 1 | unit TntVawrgrid;
|
---|
| 2 |
|
---|
| 3 |
|
---|
| 4 |
|
---|
| 5 | interface
|
---|
| 6 |
|
---|
| 7 | uses
|
---|
| 8 | SysUtils, Windows, Messages, Classes, Graphics, Controls,
|
---|
| 9 | Forms, Dialogs, Grids, TntStdCtrls, TntGrids;
|
---|
| 10 |
|
---|
| 11 | type
|
---|
| 12 | TVAWrapGrid = class(TntStringGrid)
|
---|
| 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 |
|
---|
| 29 | procedure Register;
|
---|
| 30 |
|
---|
| 31 | implementation
|
---|
| 32 |
|
---|
| 33 | constructor TVAWrapGrid.Create(AOwner : TComponent);
|
---|
| 34 | begin
|
---|
| 35 | { Create a TStringGrid }
|
---|
| 36 | inherited Create(AOwner);
|
---|
| 37 | HiddenCols:='';
|
---|
| 38 | {change to bit map someday}
|
---|
| 39 | fHiddenColMap:='';
|
---|
| 40 | end;
|
---|
| 41 |
|
---|
| 42 |
|
---|
| 43 | procedure TVAWrapGrid.SetHiddenCols(value:string);
|
---|
| 44 | var
|
---|
| 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;
|
---|
| 54 | begin
|
---|
| 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;
|
---|
| 84 | end;
|
---|
| 85 |
|
---|
| 86 |
|
---|
| 87 | { This DrawCell procedure wraps text in the grid cell }
|
---|
| 88 | procedure TVAWrapGrid.DrawCell(Col,Row: Longint; Rect: TRect; State: TGridDrawState);
|
---|
| 89 | var
|
---|
| 90 | i, MaxRowHeight, CurrRowHeight, hgt, CellLen :integer;
|
---|
| 91 | CellValue :PChar;
|
---|
| 92 | begin
|
---|
| 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 |
|
---|
| 158 | end;
|
---|
| 159 |
|
---|
| 160 | procedure Register;
|
---|
| 161 | begin
|
---|
| 162 | { You can change Samples to whichever part of the Component Palette you want
|
---|
| 163 | to install this component to }
|
---|
| 164 | RegisterComponents('TntCPRS', [TntVAWrapGrid]);
|
---|
| 165 | end;
|
---|
| 166 |
|
---|
| 167 | end.
|
---|
| 168 |
|
---|