Шапка в TDBGrid

=== Шапка в TDBGrid ===
Уже реализовано в виде вот этого компонента
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;
 { Private declarations }
 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;
 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
 Indicator: TBitmap;
 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.DefaultAlignment;
 WriteText(Canvas, ARect, 2, 2, TitleText, Al);
 end;
 end;
end;
procedure TBitDBGrid.SetRealTitleFont(Value: TFont);
begin
 FRealTitleFont.Assign(Value);
 Repaint;
end;
procedure Register;
begin
 RegisterComponents('Andre VCL', [TBitDBGrid]);
end;
initialization
 DrawBitmap := TBitmap.Create;
finalization
 DrawBitmap.Free;
end.
Source: Взято с http://delphiworld.narod.ru
ID: 03046
Category:Базы данных
Category:DBGrid