轻松实现DBGrid的多表头 (0分)

用法：
设置DBGrid的Column的Caption属性
例如：Column1的Caption为111|222
Column2的Caption为111|333
那么Column1和Column2公用一个表头111

unit ADBGrid;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Grids, DBGrids, Math;

type
TADBGrid = class(TDBGrid)
private
{ Private declarations }
BrerLayerTitles, CurLayerTitles: TStringList;
SaveFont: TFont;
function TitleLayerRect(LayerTitles: TStrings; TitleRect: TRect; LayerID, ACol: Integer): TRect;
function ExtractSubTitle(LayerTitles: TStrings; ACol: Integer): Integer;
protected
{ Protected declarations }
procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
procedure Paint; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
end;

implementation

{ TADBGrid }

constructor TADBGrid.Create(AOwner: TComponent);
begin
inherited;
BrerLayerTitles := TStringList.Create;
curLayerTitles := TStringList.Create;
SaveFont := TFont.Create;
end;

destructor TADBGrid.Destroy;
begin
BrerLayerTitles.Free;
curLayerTitles.Free;
SaveFont.Free;
inherited;
end;

procedure TADBGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
AState: TGridDrawState);
var
SubTitleRT, CaptionRt, IndicatorRT: TRect;
Column: TColumn;
SubTitle: string;
i: Integer;
begin
if (ARow = 0) and (ACol > 0) then
begin
ExtractSubTitle(curLayerTitles, RawToDataColumn(ACol));
for i := 0 to curLayerTitles.Count - 1 do
begin
SubTitleRT := TitleLayerRect(curLayerTitles, ARect, i, RawToDataColumn(ACol));
CaptionRt := SubTitleRT;
Canvas.Brush.Color := FixedColor;
Canvas.FillRect(SubTitleRT);

DrawEdge(Canvas.Handle, SubTitleRT, BDR_RAISEDINNER, BF_TOPLEFT);
if i <> CurLayerTitles.Count - 1 then
begin
DrawEdge(Canvas.Handle, SubTitleRT, BDR_RAISEDOUTER, BF_BOTTOM);
Dec(SubTitleRT.Bottom, 2);
end else Dec(SubTitleRT.Bottom, 1);
Canvas.Pen.Color := clWhite;
Dec(SubTitleRT.Right, 1);
Canvas.MoveTo(SubTitleRT.Right, SubTitleRT.Top);
Canvas.LineTo(SubTitleRT.Right, SubTitleRT.Bottom);
Canvas.LineTo(SubTitleRT.Left, SubTitleRT.Bottom);
Column := Columns[RawToDataColumn(ACol)];
SubTitle := '';
if Assigned(Column) then
begin
SubTitle := CurLayerTitles;
SaveFont.Assign(Canvas.Font);
Canvas.Font.Assign(TitleFont);
try
InflateRect(SubTitleRT, -1, -1);
DrawText(Canvas.Handle, PChar(SubTitle), Length(SubTitle),
SubTitleRT, DT_CENTER or DT_SINGLELINE or DT_VCENTER);
finally
Canvas.Font.Assign(SaveFont);
end;
end;
end;
if dgIndicator in Options then
begin
IndicatorRT := Rect(0, 0, IndicatorWidth + 1, RowHeights[0]);
Canvas.FillRect(IndicatorRT);
IndicatorRT.Right := IndicatorRT.Right - 1;
Canvas.Rectangle(IndicatorRT);
IndicatorRT.Right := IndicatorRT.Right + 1;
DrawEdge(Canvas.Handle, IndicatorRT, BDR_RAISEDOUTER, BF_RIGHT);
end;
end
else begin
inherited;
if ACol = 0 then
DrawEdge(Canvas.Handle, ARect, BDR_SUNKENOUTER, BF_BOTTOMRIGHT);
end;
end;

function TADBGrid.ExtractSubTitle(LayerTitles: TStrings;
ACol: Integer): Integer;
var L, P: Integer;
SubTitle: string;
begin
Result := 0;
if Assigned(Columns[ACol]) then
SubTitle := Columns[ACol].Title.Caption
else Exit;
if LayerTitles <> nil then LayerTitles.Clear;
L := 0;
repeat
P := Pos('|', SubTitle);
if P = 0 then
begin
if LayerTitles <> nil then LayerTitles.Add(SubTitle);
end
else begin
if LayerTitles <> nil then LayerTitles.Add(Copy(SubTitle, 1, P - 1));
SubTitle := Copy(SubTitle, P + 1, Length(SubTitle) - P);
end;
L := L + 1;
until P = 0;
Result := L;
end;

procedure TADBGrid.Paint;
var
i, MaxLayer, Layer: Integer;
TM: TTextMetric;
begin
if ([csLoading, csDestroying] * ComponentState) <> [] then Exit;
MaxLayer := 0;
for i := 0 to Columns.Count - 1 do
begin
Layer := ExtractSubTitle(nil, i);
if Layer > MaxLayer then MaxLayer := Layer;
end;
SaveFont.Assign(Canvas.Font);
Canvas.Font.Assign(TitleFont);
try
GetTextMetrics(Canvas.Handle, TM);
RowHeights[0] := (TM.tmHeight + TM.tmInternalLeading + 3) * MaxLayer;
finally
Canvas.Font.Assign(SaveFont);
end;
inherited;
end;

function TADBGrid.TitleLayerRect(LayerTitles: TStrings; TitleRect: TRect;
LayerID, ACol: Integer): TRect;
var
SubTitle: string;
i, j: Integer;
bBrer: Boolean;
begin
Result := TitleRect;
if Assigned(Columns[ACol]) then
SubTitle := Columns[ACol].Title.Caption
else Exit;
ExtractSubTitle(LayerTitles, ACol);
for i := ACol - 1 downto 0 do
begin
ExtractSubTitle(BrerLayerTitles, i);
bBrer := False;
if (BrerLayerTitles.Count = LayerTitles.Count) then
begin
for j := 0 to LayerID do
begin
bBrer := BrerLayerTitles[j] = LayerTitles[j];
if not bBrer then
Break;
end;
end;
if bBrer then
begin
Result.Left := Result.Left - Columns.Width;
if dgColLines in Options then
Result.Left := Result.Left - 1;
end
else Break;
end;
for i := ACol + 1 to Columns.Count - 1 do
begin
ExtractSubTitle(BrerLayerTitles, i);
bBrer := False;
if BrerLayerTitles.Count = LayerTitles.Count then
begin
for j := 0 to LayerID do
begin
bBrer := BrerLayerTitles[j] = LayerTitles[j];
if not bBrer then
Break;
end;
end;
if bBrer then
begin
Result.Right := Result.Right + Columns.Width;
if dgColLines in Options then
Result.Right := Result.Right + 1;
end
else Break;
end;
Result.Top := (RowHeights[0] div LayerTitles.Count) * LayerID;
Result.Bottom := (RowHeights[0] div LayerTitles.Count) * (LayerID + 1);
end;

end.

是不是从那里抄的！！？？ehlib？

學習!

>>>>nathanlee
我不同意你的说法。
就算我明知道是从EHLib里抄的，也要好好欣赏一下。
因为如果没有对VCL一次又一次的学习。
一步又一步的深入研究就没有今天的我。
再也不要被那些装蒜的家伙小看了。
因为我知道了我所用的东西是如何工作的。
而不只是一个个小小的技巧， 让我不知道所以然。
所以，本人大力支持hj0791对DFW所做出的贡献。
本人代表所有菜鸟及VCL的认真研究者向你表示感谢。
再接再励呀。本人也有一些小东西当然比你的没趣多了。
不过也是认真研究的结果呀有空切磋一下吧。
俺的MSN帐号是zhangw022@gis-rs-gps.com
现在都流行用MSN了QQ 已经不用了。
如果看得起的话快来连我吧。
本帖俺存起来了。
近来一直研究VCL，可是工作是必须做的，自己目前又没有机器（回家就能看电视）
还有个马子缠着，真烦。

我要申明一下，不要以为用法相同就认为编码有雷同，说实话我只装过一下Ehlib并没有
仔细用过它，更没有研究它的原码，以上原码可是我自己写的哟！

學習

不管是怎来的，主要是好东西就对你说谢谢。

[red]谢谢你[/red]！

学习中

HJ:
能不能对这几个函数说明一下呀。
给个设计思路什么的，这样会更有意义呀。

楼主不错！

非常感谢 hj0791，是你的劳动我们大家有所收获。
请nathanlee注意了，即使是转贴我们也应该感谢，因为毕竟还有人转贴，
总比什么也不做好得多。

原理比代码更重要啊

好！