Componente DBZebraGrid

[Eder Moraes]

Bom este componente eu mesmo adaptei para meus programas, andei por ai pesquisando muito mais não encontrei nada que se adequace para minhas aplicações, e todo dbgrid que eu coloca-se em um formulario eu teria que fazer alterações no próprio ou fazer chamadas a funções para alterar o grafico e o modo de uso do componente então decidi fazer o meu próprio. Espero que vocês gostem.

Tem uma função para organizar as colunas nos tamanhos exatos para os campos e seus conteudos, assim como no excel quando você clica duas vezes na barra de indicadores entre as colunas ou linhas, coisa que você não encontra com facilidade por ai.

Basta clicar uma vez no title do grid, e pronto as colunas são organizadas automaticamente evitando a fadiga de organizá-las manualmente.

Após a abertura da tabela ou consulta você pode executar a organização assim:

DBZebraGrid1.OnTitleClick(DBZebraGrid1.Columns[x]); //o X pode ser qualquer coluna da grade de 0 a ...;

Tem outra para copiar o conteúdo da linha selecionada para área de transferencia do windows e pode ser colada em outro programa como o Word, Excel ou Notepad.

Pode setar a cor da seleção de uma linha, e também as cores para zebra.

{
     Todos os direitos reservados para http://linformatica.com.br
     Autor: Eder Moraes de Castro
     Ano: 2006 -- 2012 
}

unit dbZebraGrid;

interface

uses
  Windows, Forms, DBGrids, DB, DBTables, Grids, WinTypes, Classes,
  SysUtils, Math, Dialogs, Graphics, Controls, ClipBrd;

type

  TDBZebraGrid = class (TDBGrid)

  private
    zb,cp,al:boolean;
    zsel,z1,z2:TColor;
    function getCP:Boolean;
    function getAL:Boolean;
    function getZebrar:Boolean;
    function getZebra1Color: TColor;
    function getZebra2Color: TColor;
    function getZebraSelColor: TColor;
    procedure setCP(const value:Boolean);
    procedure setAL(const value:Boolean);
    procedure setZebrar(const value:Boolean);
    procedure setZebra1Color(const Value: TColor);
    procedure setZebra2Color(const Value: TColor);
    procedure setZebraSelColor(const Value: TColor);
  protected
    procedure DrawDataCell(const Rect: TRect; Field: TField; State:TGridDrawState); override;
    procedure TitleClick(Column: TColumn); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
  public
    constructor Create(AOwner : TComponent); override;
    procedure copiaConteudo;
  published
    property DefaultDrawing default false;
    property ZAlarg_Columns : Boolean read getAL write setAL;
    property ZCtrlC_CopiaLinha : Boolean read getCP write setCP;
    property Zebra : Boolean read getZebrar write setZebrar;
    property ZebraSelColor : TColor read getZebraSelColor write SetZebraSelColor;
    property Zebra1Color : TColor read getZebra1Color write setZebra1Color;
    property Zebra2Color : TColor read getZebra2Color write setZebra2Color;
  end;


procedure Register;

implementation


constructor TDBZebraGrid.Create(AOwner : TComponent);
begin
  inherited Create (AOwner);
    DefaultDrawing := false;
    FixedColor := $00E9E9E9;
    TitleFont.Style := [fsBold];
    TitleFont.Color := $00804000;
    al := True;
    cp := True;
    Zebra := True;
    ZebraSelColor := $00FFC959;
    Zebra1Color := $00FFFBF0;
    Zebra2Color := $00FFF5DF;
    Options := [dgRowSelect,dgTitles,dgColumnResize,dgColLines,dgTabs,dgConfirmDelete,dgCancelOnExit];
end;

procedure TDBZebraGrid.DrawDataCell(const Rect: TRect; Field: TField;
  State: TGridDrawState);
begin
  inherited;
  if not zb then begin DefaultDrawing := true; Exit; end else begin DefaultDrawing := false; 
    with Canvas do begin
      if (DataSource.DataSet.RecordCount = 0) then Exit;
      if gdSelected in State then begin
        Brush.Color := zsel;
        Font.Color := $00804000;
      end else begin
        if odd(DataSource.DataSet.RecNo) then begin
          Font.Color:= clBlack;
          Brush.Color:= z1;
        end else begin
          Font.Color:= clBlack;
          Brush.Color:= z2;
        end;
      end;
      FillRect(Rect);
      TextOut(Rect.Left+2,Rect.Top,Field.AsString);
    end;
  end;
end;

procedure TDBZebraGrid.TitleClick(Column: TColumn);
var I,X:integer;
    valc:string;
begin
  inherited;
    if al then
    with DataSource.DataSet do begin
      if recordCount = 0 then Exit;
      valc := Fields[0].AsString;
      DisableControls;
        if Active then begin
          for i := 0 to FieldCount -1 do begin
            First; X := Length(Fields[i].DisplayText);
            while not Eof do begin
              X := Max(Length(Fields[i].DisplayText),X);
              Next;
            end;
            Fields[i].DisplayWidth := X+3;
          end;
          Locate(Fields[0].DisplayName,valc,[]);
        end;
      EnableControls;
    end;
end;

procedure TDBZebraGrid.KeyUp(var Key: Word; Shift: TShiftState);
begin
  case key of
    67: begin
      if GetKeyState(17) and 128 > 0 then begin
        if (DataSource.DataSet.RecordCount = 0) then Exit;
        if cp then
        copiaConteudo;
      end;
    end;
  end;
end;

function TDBZebraGrid.getZebra1Color: TColor;
begin
  Result := z1;
end;

function TDBZebraGrid.getZebra2Color: TColor;
begin
  Result := z2;
end;

function TDBZebraGrid.getZebraSelColor: TColor;
begin
  Result := zsel;
end;

function TDBZebraGrid.getZebrar: Boolean;
begin
  Result := zb;
end;

function TDBZebraGrid.getCP: Boolean;
begin
  Result := cp;
end;

function TDBZebraGrid.getAL: Boolean;
begin
  Result := al;
end;

procedure TDBZebraGrid.setZebra1Color(const Value: TColor);
begin
  if z1 <> Value then begin
    z1 := Value;
    Changed;
  end;
end;

procedure TDBZebraGrid.setZebra2Color(const Value: TColor);
begin
  if z2 <> Value then begin
    z2 := Value;
    Changed;
  end;
end;

procedure TDBZebraGrid.SetZebraSelColor(const Value: TColor);
begin
  if zsel <> Value then begin
    zsel := Value;
    Changed;
  end;
end;


procedure TDBZebraGrid.setZebrar(const value: Boolean);
begin
  if zb <> Value then begin
    zb := Value;
    Changed;
  end;
end;

procedure TDBZebraGrid.setCP(const value: boolean);
begin
  if cp <> value then begin
    cp := value;
    Changed;
  end;
end;

procedure TDBZebraGrid.setAL(const value: Boolean);
begin
  if al <> value then begin
    al := value;
    Changed;
  end;
end;

procedure Register;
begin
  RegisterComponents('Custom', [TDBZebraGrid]);
end;

end.

Visiti-nos!

Linformatica - Hosting services

Editado Julho 23, 2012 por Eder Moraes