轻松实现DBGrid的多表头

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;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents(''''Samples'''', [TADBGrid]);
end;

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[i];
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;
//获取表头最大层数

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有