Author: Boris Benjamin Wittfoth
The standard Delphi-StringGrid can only hold one color for all cells. How to create
an multiple colored Stringgrid ?
Answer:
I's easier than you assumed. You must simply override the DrawCell and manuelly
draw some data on the canvas of the Stringgrid-Cell .
Feel free to copy and reuse this sweet tiny component....
I hope this article is helpful for you ....
1 TBWStringGrid = class(TStringGrid)
2 private
3 protected
4 procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
5 AState: TGridDrawState); override;
6 public
7 { just hold some data for each cell }
8 CellColor: array of array of TColor;
9 CellFontColor: array of array of TColor;
10 CellData: array of array of REAL;
11 procedure RebuildDynColorArray; // net gut !!!!
12 procedure ResizeGrid(ColCount: Integer; RowCount: Integer; ClearAllFields:
13 Boolean =
14 TRUE);
15 procedure ResetGridCellData;
16 procedure ResetGrid;
17 procedure UnselectAll;
18 published
19 end;
20
21 function InvertColor(Color: TColor): TColor;
22
23 { TBWStringGrid }
24
25 //>Created at 05-Jul-2002 (14:12:19 ) by benjamin wittfoth
26 procedure TBWStringGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
27 AState: TGridDrawState);
28 begin
29 inherited;
30 if CellColor[ACol, ARow] = clBlack then
31 EXIT;
32 with Canvas do
33 begin
34 if (gdSelected in AState) then
35 begin // wenn selektiert -> INVERTIEREN
36 Font.Color := InvertColor(CellFontColor[ACol, ARow]);
37 Brush.Color := InvertColor(CellColor[ACol, ARow]);
38 end
39 else
40 begin // Ansonsten nicht !
41 Brush.Color := CellColor[ACol, ARow];
42 Font.Color := CellFontColor[ACol, ARow];
43 end;
44 Brush.Style := bsSolid;
45 FillRect(ARect);
46 TextRect(ARect, ARect.left + 2, ARect.top + 2, Cells[ACol, ARow]);
47 end;
48 end;
49
50 //>Created at 05-Jul-2002 (14:56:33 ) by benjamin wittfoth
51 procedure TBWStringGrid.RebuildDynColorArray;
52 begin
53 SetLength(CellColor, ColCount, RowCount);
54 SetLength(CEllFontColor, ColCount, RowCount);
55 SetLength(CellData, ColCount, RowCount);
56 end;
57 //>Created at 10-Jul-2002 (08:11:25 ) by benjamin wittfoth
58 procedure TBWStringGrid.ResizeGrid(ColCount: Integer; RowCount: Integer;
59 ClearAllFields: Boolean = TRUE);
60 begin
61 Self.RowCount := RowCount;
62 Self.ColCount := ColCount;
63 RebuildDynColorArray;
64 if ClearAllFields then
65 ResetGrid;
66 end;
67 //>Created at 10-Jul-2002 (08:11:29 ) by benjamin wittfoth
68 procedure TBWStringGrid.ResetGridCellData;
69 var
70 X, Y: Integer;
71 begin
72 for Y := 0 to RowCount - 1 do
73 for X := 0 to ColCount - 1 do
74 CellData[X, Y] := 0;
75 end;
76 //>Created at 09-Jul-2002 (16:54:43 ) by benjamin wittfoth
77 procedure TBWStringGrid.ResetGrid;
78 var
79 X, Y: Integer;
80 begin
81 for Y := 0 to RowCount - 1 do
82 begin
83 for X := 0 to ColCount - 1 do
84 begin
85 CellData[X, Y] := 0;
86 CellColor[X, Y] := clWhite;
87 CellFontColor[X, Y] := clBlack;
88 Cells[X, Y] := '';
89 end;
90 end;
91 end;
92
93 //>Created at 09-Jul-2002 (11:08:35 ) by benjamin wittfoth
94 procedure TBWStringGrid.UnselectAll;
95 var
96 ARect: TGridRect;
97 begin
98 ARect.Left := 0;
99 ARect.Top := 0;
100 ARect.Right := 0;
101 ARect.Bottom := 0;
102 Selection := ARect;
103 end;
104
105 function InvertColor(Color: TColor): TColor;
106 begin
107 case Color of
108 clAqua: RESULT := clTeal;
109 clBlack: RESULT := clWhite;
110 clBlue: RESULT := clMaroon;
111 clDkGray: RESULT := clFuchsia;
112 clFuchsia: RESULT := clDkGray;
113 // clGray : RESULT:=clPurple;
114 clGreen: RESULT := clRed;
115 clLime: RESULT := clSilver; //clYellow;
116 clLtGray: RESULT := clLime;
117 clMaroon: RESULT := clOlive; //clBlue;
118 clNavy: RESULT := clNavy;
119 clOlive: RESULT := clMaroon; //clNavy;
120 clPurple: RESULT := clGray;
121 clRed: RESULT := clYellow; //clGreen;
122 // clSilver : RESULT:=clLtGray;
123 clTeal: RESULT := clAqua;
124 clWhite: RESULT := clBlack;
125 clYellow: RESULT := clRed; //clLime;
126 end;
127 end;
|
