Советы по Delphi. Версия 1.4.3 от 1.1.2001

 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;
 { Protected declarations }
 public
 constructor Create(AOwner : TComponent);override;
 destructor Destroy; override;
 { Public declarations }
 published
 property OnDrawTitle : TOnDrawTitleEvent read FOnDrawTitle write FOnDrawTitle;
 property RealTitleFont : TFont read FRealTitleFont write SetRealTitleFont;
 { Published declarations }
 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);
// © Borland function :)
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;
 I, Left: Integer;
begin
 with DrawBitmap, ARect do { Use offscreen bitmap to eliminate flicker and }
 begin { brush origin tics in painting / scrolling. }
 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;