| [459] | 1 | unit Vawrgrid;
 | 
|---|
 | 2 | 
 | 
|---|
 | 3 | 
 | 
|---|
 | 4 | 
 | 
|---|
 | 5 | interface
 | 
|---|
 | 6 | 
 | 
|---|
 | 7 | uses
 | 
|---|
 | 8 |   SysUtils, Windows, Messages, Classes, Graphics, Controls,
 | 
|---|
 | 9 |   Forms, Dialogs, Grids;
 | 
|---|
 | 10 | 
 | 
|---|
 | 11 | type
 | 
|---|
 | 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 | 
 | 
|---|
 | 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('CPRS', [TVAWrapGrid]);
 | 
|---|
 | 165 | end;
 | 
|---|
 | 166 | 
 | 
|---|
 | 167 | end.
 | 
|---|
 | 168 | 
 | 
|---|