DBGrid Tunado - com zebra, sort, altura de linha, ....

unit interceptor_TDBGrid;

// Esta é uma classe interceptadora que acrescenta funcionalidades ao DBGrid.
// Como usar: basicamente voce coloca a unit interceptor_TDBGrid na uses de seu form
//   (tem que ser posterior a DBGrids, Grids para não haver problemas) e não precisa de
//   mais nada, magicamente seus DGGrids herdarão as features abaixo:
// Zebra: o famoso cor sim e cor não ;-)
// LinesPerRow: Quantidade de linhas para acomodar melhor campos memos e strings longas
// Campo de Imagem: Qualquer imagem suportada pelo TGraphicField será exibido.
// Faz a ordenação ao clicar no titulo da coluna, também ao passar o mouse pelo titulo
//    das colunas, o cursor  modifica-se para HandPoint para indicar uma ação disponível
// Se quer desativar as personalizações que essa classe de interceptação faz, então use:
//   dbgrid1.DoAll:=false; // volta a ser um DBGrid comum
// Se for trabalhar com memos ou strings longas com quebra de linhas então defina:
//   dbgrid1.LinesPerRow:=3; // 3 linhas de altura
// Zebrar um grid é o default, mas você pode personalizar as cores ou até desligar a zebra:
//   dbgrid1.ColorPair:=$00EFEDED;
//   dbgrid1.ColorOdd:=$00D3D3D3;
//   dbgrid1.ColorFont:=clWhite;
//   dbgrid1.ColorSelection:=clWebCornFlowerBlue;
//   dbgrid1.Zebra:=true;
// Todo: Capacitar o TitleClick para fazer a ordenação também em ClientDataset, atualmente
//   só faz em Datasets baseado em Firedac (FDQuery e FDMemTable)
// By Hamacker (sirhamacker [em] gmail.com)

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls,
  ExtCtrls, Menus, RegularExpressions, StrUtils, VCL.DBGrids, VCL.Grids, Data.DB, FireDAC.Comp.Client;

type
  TDBGrid = class(Vcl.DBGrids.TDBGrid)
  private
    FColorPair: TColor;
    FColorOdd: TColor;
    FColorFont: TColor;
    FColorForSelection: TColor;
    FZebra:Boolean;
    FLinesPerRow: Integer;
    FBoldForSelection: Boolean;
    FDoAll: Boolean;
    FSendKeyDownTo:TWinControl;
    procedure SetLinesPerRow (Value: Integer);
    function ReverseColorBW(BackGroundColor : TColor):TColor;
    procedure OrdenarGrid(Column: TColumn);
    procedure SetDoAll(const Value: Boolean);
  protected
    procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
      Column: TColumn; State: TGridDrawState); override;
    procedure TitleClick(Column: TColumn); override;
    procedure  LayoutChanged; override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
 published
    property LinesPerRow: Integer  read FLinesPerRow write SetLinesPerRow default 1;
    property ColorPair:TColor read FColorPair write FColorPair;
    property ColorOdd:TColor read FColorOdd write FColorOdd;
    property ColorFont:TColor read FColorFont write FColorFont;
    property ColorSelection:TColor read FColorForSelection write FColorForSelection;
    property Zebra:Boolean read FZebra write FZebra;
    property BoldForSelection:Boolean read FBoldForSelection write FBoldForSelection;
    property DoAll:Boolean read FDoAll write SetDoAll;
    //property OnDrawColumnCell;
    //property OnTitleClick;
  end;


implementation


{ TDBGrid }
constructor TDBGrid.Create(AOwner: TComponent);
begin
  inherited ;
  FColorPair:=$00EFEDED;
  FColorOdd:=$00D3D3D3;
  FColorFont:=clWhite;
  FColorForSelection:=clWebCornFlowerBlue;
  FZebra:=true;
  FBoldForSelection:=true;
  FLinesPerRow:=1;
  FDoAll:=true;
end;

procedure TDBGrid.TitleClick(Column: TColumn);
begin
  if Assigned(OnTitleClick) then
  begin
    inherited OnTitleClick(Column);
    Invalidate;
  end
  else
  begin
    OrdenarGrid(Column);
  end;
end;

procedure TDBGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  pt: TGridcoord;
begin
  pt:= MouseCoord(x, y);

  if pt.y=0 then
    Cursor:=crHandPoint
  else
    Cursor:=crDefault;
  inherited MouseMove(Shift,X, Y);
end;

// A ordenação está preparada para usar Firedac, outro tipo de componente não terá qualquer efeito
procedure TDBGrid.OrdenarGrid(Column: TColumn);
  procedure BoldTitle;
  var i:Integer;
  begin
    for i:=0 to Pred(Self.Columns.Count)
      do  Self.Columns[i].Title.Font.Style:=[];
    Column.Title.Font.Style:=[fsBold];
  end;
begin
  try
    if Column.Grid.DataSource.DataSet is TFDQuery then
    begin
      if not(Column.Field.FieldKind in [fkData, fkInternalCalc]) then
      begin
        Application.MessageBox(pChar('Campo ['+Column.FieldName+'] calculado.' + #13#10 + 'Não é possivel ordenação.'), pChar('Erro:'),MB_OK+MB_ICONERROR);
        exit;
      end;
      if TFDQuery(Column.Grid.DataSource.DataSet).IndexFieldNames = Column.FieldName then
      begin
        TFDQuery(Column.Grid.DataSource.DataSet).IndexFieldNames := Column.FieldName + ':d';
        BoldTitle;
      end
      else
      begin
        TFDQuery(Column.Grid.DataSource.DataSet).IndexFieldNames := Column.FieldName;
        BoldTitle;
      end;
    end
    else
      if Column.Grid.DataSource.DataSet is TFDMemTable then
      begin
        if TFDMemTable(Column.Grid.DataSource.DataSet).IndexFieldNames = Column.FieldName then
        begin
          TFDMemTable(Column.Grid.DataSource.DataSet).IndexFieldNames := Column.FieldName + ':d';
          BoldTitle;
        end
        else
        begin
          TFDMemTable(Column.Grid.DataSource.DataSet).IndexFieldNames := Column.FieldName;
          BoldTitle;
        end;
      end;
  except
    on E: Exception
      do Application.MessageBox(pChar(e.Message), pChar('Erro:'),MB_OK+MB_ICONERROR);
  end;
end;

// ReverseColorBW: Retorna uma cor branca ou preta que faz contraste com a cor especificada.
// Com isso posso garantir que não importa a cor que use com o Brush, sempre terei a cor
// da fonte fazendo contraste.
function TDBGrid.ReverseColorBW(BackGroundColor : TColor):TColor;
const
 cHalfBrightness = ((0.3 * 255.0) + (0.59 * 255.0) + (0.11 * 255.0)) / 2.0;
var
 Brightness : double;
begin
 with TRGBQuad(BackGroundColor)
   do BrightNess := (0.3 * rgbRed) + (0.59 * rgbGreen) + (0.11 * rgbBlue);
 if (Brightness>cHalfBrightNess)
   then result := clblack
   else result := clwhite;
end;

procedure TDBGrid.SetDoAll(const Value: Boolean);
begin
  if Value <> FDoAll then
  begin
    FDoAll := Value;
    LayoutChanged;
  end;
end;

procedure TDBGrid.SetLinesPerRow(Value: Integer);
begin
  if Value <> FLinesPerRow then
  begin
    FLinesPerRow := Value;
    LayoutChanged;
  end;
end;

procedure TDBGrid.LayOutChanged;
var
  PixelsPerRow, PixelsTitle, I: Integer;
begin
  inherited LayOutChanged;

  Canvas.Font := Font;
  PixelsPerRow := Canvas.TextHeight('Wg') + 3;
  if dgRowLines in Options then
    Inc (PixelsPerRow, GridLineWidth);

  Canvas.Font := TitleFont;
  PixelsTitle := Canvas.TextHeight('Wg') + 4;
  if dgRowLines in Options then
    Inc (PixelsTitle, GridLineWidth);

  // set number of rows
  RowCount := 1 + (Height - PixelsTitle) div (PixelsPerRow * FLinesPerRow);

  // set the height of each row
  DefaultRowHeight := PixelsPerRow * FLinesPerRow;
  RowHeights [0] := PixelsTitle;
  for I := 1 to RowCount - 1 do
    RowHeights [I] := PixelsPerRow * FLinesPerRow;

  // send a WM_SIZE message to let the base component recompute
  // the visible rows in the private UpdateRowCount method
  PostMessage (Handle, WM_SIZE, 0, MakeLong(Width, Height));
end;

procedure TDBGrid.DrawColumnCell (const Rect: TRect; DataCol: Integer;
  Column: TColumn; State: TGridDrawState);
var
  Bmp: TBitmap;
  OutRect: TRect;
  bDone:Boolean;
  DefAlign:Integer;
begin
  if (not FDoAll) and Assigned(OnDrawColumnCell) then
  begin
    inherited DrawColumnCell(Rect, DataCol, Column, State);
    Invalidate;
    Exit;
  end;
  if (FDoAll) then
  begin

    if (gdSelected in state) then
    begin
      Canvas.Brush.Color := FColorForSelection;
      Canvas.Font.Color := ReverseColorBW(FColorForSelection);
      if FBoldForSelection
        then Canvas.Font.Style:=[fsBold];
    end
    else
    begin
      if Odd(DataSource.Dataset.RecNo)
        then Canvas.Brush.Color := FColorPair
        else Canvas.Brush.Color := FColorOdd;
      if FBoldForSelection
        then Canvas.Font.Style:=[];
      //inherited;
      if Assigned(OnDrawColumnCell)
        then OnDrawColumnCell(Self, Rect, DataCol, Column, State);
    end;

    // limpa a area
    Canvas.FillRect (Rect);
    // copy the rectangle
    OutRect := Rect;
    // restringir a saida
    InflateRect (OutRect, -2, -2);
    bDone:=false;
    DefAlign:=DT_LEFT;
    if Column.Field.Alignment=taLeftJustify then DefAlign:=DT_LEFT;
    if Column.Field.Alignment=taRightJustify then DefAlign:=DT_RIGHT;
    if Column.Field.Alignment=taCenter then DefAlign:=DT_CENTER;

    if (not bDone) and (Column.Field is TGraphicField) then
    begin
      Bmp := TBitmap.Create;
      try
        Bmp.Assign (Column.Field);
        Canvas.StretchDraw (OutRect, Bmp);
      finally
        Bmp.Free;
      end;
      bDone:=true;
    end;

    if (not bDone) and (Column.Field is TMemoField) then
    begin
      DrawText (Canvas.Handle, PChar (Column.Field.AsString),
        Length (Column.Field.AsString), OutRect, dt_WordBreak or dt_NoPrefix);
      bDone:=true;
    end;

    // String
    if (not bDone) and ((Column.Field is TStringField) ) then
    begin
      //DrawText (Canvas.Handle, PChar (Column.Field.DisplayText),
      //  Length (Column.Field.DisplayText), OutRect,
      //  dt_vcenter or DefAlign or dt_SingleLine or dt_NoPrefix);
      DrawText (Canvas.Handle, PChar (Column.Field.DisplayText),
        Length (Column.Field.DisplayText), OutRect, dt_WordBreak or dt_NoPrefix);

      bDone:=true;
    end;

    // valores numericos - a direita
    if (not bDone) and (
       (Column.Field is TBCDField) or
       (Column.Field is TCurrencyField) or
       (Column.Field is TFloatField)) then
    begin
      DrawText (Canvas.Handle, PChar (Column.Field.DisplayText),
        Length (Column.Field.DisplayText), OutRect,
        dt_vcenter or DT_RIGHT or dt_SingleLine or dt_NoPrefix);
      bDone:=true;
    end;

    // inteiros - centralizados
    if (not bDone) and (
       (Column.Field is TIntegerField) or
       (Column.Field is TSmallintField) or
       (Column.Field is TLargeintField) or
       (Column.Field is TWordField)) then
    begin
      DrawText (Canvas.Handle, PChar (Column.Field.DisplayText),
        Length (Column.Field.DisplayText), OutRect,
        dt_vcenter or DT_CENTER or dt_SingleLine or dt_NoPrefix);
      bDone:=true;
    end;

    // data e hora - centralizados
    if (not bDone) and (
       (Column.Field is TDateField) or
       (Column.Field is TTimeField) or
       (Column.Field is TDateTimeField)) then
    begin
      DrawText (Canvas.Handle, PChar (Column.Field.DisplayText),
        Length (Column.Field.DisplayText), OutRect,
        dt_vcenter or DT_CENTER or dt_SingleLine or dt_NoPrefix);
      bDone:=true;
    end;

    // Para todos os demais tipos desenha-se uma linha simples verticalmente centralizada
    if (not bDone) then
    begin
      DrawText (Canvas.Handle, PChar (Column.Field.DisplayText),
        Length (Column.Field.DisplayLabel), OutRect,
        dt_vcenter or DefAlign or dt_SingleLine or dt_NoPrefix);
      bDone:=true;
    end;

  end;
end;

end.