Телефон: +7 (926) 245-03-63

Заголовок в DBGrid

Следующая статья: Получение физического пути к таблице.

Как создать шапку в DBGrid?

Решение

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

type
TOnDrawTitleEvent=procedure(ACol: integer; ARect: TRect; var TitleText: string) of object;
TBitDBGrid=class(TDBGrid)
private FBitmapBrowse: TBitmap;
FBitmapEdit: TBitmap;
FBitmapInsert: TBitmap;
FBitmapFill: TBitmap;
FRealTitlefont:TFont;
FOnDrawTitle: TOnDrawTitleEvent;
FResizeFlag: boolean;
procedure SetRealTitleFont(Value : TFont);
procedure UpdateTitlesheight;
protected procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
public
constructor Create(AOwner : TComponent);override;
destructor Destroy; override;
published
property OnDrawTitle : TOnDrawTitleEvent read FOnDrawTitle write FOnDrawTitle;
property RealTitleFont : TFont read FRealTitleFont write SetRealTitleFont;
end;

procedure register;

implementation

var DrawBitmap: TBitmap;
function Max(X, Y: Integer): Integer;
begin
  Result:=Y; if X > Y then Result:=X;
end;

procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer;
const Text: string; Alignment: TAlignment);

const AlignFlags: array [TAlignment] of Integer=
(DT_LEFT
or DT_WORDBREAK
or DT_EXPANDTABS
or DT_NOPREFIX,

DT_RIGHT
or DT_WORDBREAK
or DT_EXPANDTABS
or DT_NOPREFIX,

DT_CENTER
or DT_WORDBREAK
or DT_EXPANDTABS
or DT_NOPREFIX);

var B, R: TRect;
begin
  with DrawBitmap, ARect do
  begin
    width:=Max(width, Right - Left);
    height:=Max(height, Bottom - Top);
    R:=Rect(DX, DY, Right - Left - 1, Bottom - Top - 1);
    B:=Rect(0, 0, Right - Left, Bottom - Top);
  end;
  with DrawBitmap.Canvas do
  begin
    DrawBitmap.Canvas.CopyRect(B, ACanvas, ARect);
    Font:=ACanvas.Font;
    Font.color:=ACanvas.Font.color;
    Brush:=ACanvas.Brush;
    SetBkMode(Handle, TRANSPARENT);
    DrawText(Handle, PChar(Text), Length(Text), R, AlignFlags[Alignment]);
  end;
  ACanvas.CopyRect(ARect, DrawBitmap.Canvas, B);
end;

constructor TBitDBGrid.Create(AOwner: TComponent);
begin
  inherited Create(Aowner);
  FRealTitleFont:=TFont.Create;
  FResizeFlag:=false;
end;

destructor TBitDBGrid.Destroy;
begin
  FRealTitleFont.Free;
  inherited Destroy;
end;

procedure TBitDBGrid.UpdateTitlesheight;
var Loop: integer;
MaxTextheight:integer;
RRect: TRect;
begin
  MaxTextheight:=0;
  for loop:=0 to Columns.Count - 1 do
  begin
    RRect:=CellRect(0,0);
    RRect.Right:=Columns[Loop].width;
    RRect.Left:=0;
    Canvas.Font:=RealTitleFont;
    MaxTextheight:=Max(MaxTextheight,
      DrawText(Canvas.Handle, PChar(Columns[Loop].Title.Caption),
      Length(Columns[Loop].Title.Caption),
      RRect, DT_CALCRECT+DT_WORDBREAK));
  end;
  if TitleFont.height<> -MaxTextheight then TitleFont.height:=- MaxTextheight;
end;

procedure TBitDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if MouseCoord(X, Y).Y=0 then FResizeFlag:=True;
  inherited MouseDown(Button, Shift, X, Y);
end;

procedure TBitDBGrid.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  if FResizeFlag then
  begin
    FResizeFlag:=False;
    UpdateTitlesheight;
  end;
end;

procedure TBitDBGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
var
TitleText: string;
Al: TAlignment;
begin
  if not ((gdFixed in AState) and ((ARow=0) and (dgTitles in Options) and (ACol<>0)))
  then 
    inherited DrawCell(ACol, ARow, ARect, AState)
  else
  begin
    if DefaultDrawing then
    begin
      DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMLEFT);
      DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPRIGHT);
      InflateRect(ARect, -1, -1);
      Canvas.Brush.color:=Fixedcolor; Canvas.FillRect(ARect);
    end;
    TitleText:=Columns[ACol - 1].Title.Caption;
    if Assigned(OnDrawTitle) then OnDrawTitle(ACol, ARect, TitleText);
    if DefaultDrawing and (TitleText <>'') then
    begin
      Canvas.Brush.Style:=bsClear;
      Canvas.Font:=RealTitleFont;
      if ACol > 0
      then
        Al:=Columns[ACol - 1].Title.Alignment
      else
        Al:=Columns[0].Title.DefaultAlig
    end;
  end;
end;
Интересное в интернете: Лучшая кожаная мебель для персонала - выберете свой стиль!