Àêæàí â ñåòè - Íà óðîâåíü ââåðõ(VCL) Õî÷ó øàïêó â TDBGrid. Êàê ñäåëàòü?

Óæå ðåàëèçîâàíî â âèäå âîò ýòîãî êîìïîíåíòà - © Andre

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.

Ilya Andreev

(2:5030/55.28)