encabezado en un grid

[ecfisa]

Hola will_ramone.

Fijate si lo que estas buscando es algo como esto:

Código Delphi [-]
unit DBGridTitVert;

interface

uses Windows, Types, Graphics, Grids, DBGrids;

type
  TDBGrid = class(DBGrids.TDBGrid)
  private
    FColsHeight : Integer;
    procedure SetColsHeight(const Value: Integer);
  protected
    procedure DrawCell(ACol, ARow: Integer; ARect: TRect; State: TGridDrawState); override;
  public
    property ColsHeight: Integer read FColsHeight write SetColsHeight;
  end;

implementation

{ TDBGrid }
procedure TDBGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
  State: TGridDrawState);
var
  LF         : LOGFONT;
  CurrentCol : TColumn;
  FontName   : string;
begin
  if (ARow = FixedRows-1) and (ACol >= Integer(dgIndicator in Options)) then
  begin
    CurrentCol := Columns[ACol-1];
    FontName   := CurrentCol.Title.Font.Name;
    ZeroMemory(@LF, SizeOf(LF));
    LF.lfHeight        := Canvas.Font.Height ;
    LF.lfWidth         := Canvas.Font.Size;
    LF.lfEscapement    := 10 * 90;
    LF.lfCharSet       := CurrentCol.Font.Charset;
    Move(FontName, LF.lfFaceName, Length(FontName));
    Canvas.Brush.Color := CurrentCol.Title.Color;
    Canvas.Brush.Style := bsSolid;
    Canvas.FillRect(ARect);
    Canvas.Font.Handle:= CreateFontIndirect(LF);
    Canvas.TextOut(ARect.Left + (ARect.Right - ARect.Left) div 2 - LF.lfWidth,
      ARect.Bottom + LF.lfHeight, CurrentCol.Title.Caption);
  end
  else
    inherited;
end;

procedure TDBGrid.SetColsHeight(const Value: Integer);
begin
  if Value <> FColsHeight then
    if Value > 30 then // (el alto que consideres razonable)
    begin
      FColsHeight := Value;
      TStringGrid(self).DefaultRowHeight := Value;
    end;
end;

end.

Uso del ejemplo:

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, ...,  DBGrids, DBGridTitVert; //  incluir último !!

...

procedure TForm1.FormCreate(Sender: TObject);
begin
  DBGrid1.ColsHeight := 90;
end;
...

Muestra:


Saludos

[[fjcg02]]

Ecfisa,

eres un puto maestro.


Saludos

[ecfisa]

Hayyyy ¡ A cuantos le diras lo mismo !

Saludos

[[AgustinOrtu]]

No quiero ser aguafiestas, pero el amigo wil_ramone hablaba de un TStringGrid no de un TDBGrid

es un stringGrid

este es el código que uso para los títulos

_verRporte.stgReportes.Cells[0,0]:='ZONA';
_verRporte.stgReportes.Cells[1,0]:='SUP. ZONA';
_verRporte.stgReportes.Cells[2,0]:='No.';
_verRporte.stgReportes.Cells[3,0]:='SITIO';
_verRporte.stgReportes.Cells[4,0]:='SUCURSAL';
_verRporte.stgReportes.Cells[5,0]:='FECHA DE REGISTRO';

es el que necesito que cambie de orientación

y este es el que utilizo para darle color desde el evento OnDrawCell

if (ARow=0) and (ACol<=5) then begin
Canvas.Brush.Color := clBlack;
canvas.Font.Style:=[FsBold];
canvas.Font.Color:=clWhite;
Canvas.TextRect(Rect, Rect.Left + 3, Rect.Top + 2, cells[Acol, Arow]);
Canvas.FrameRect(Rect);
end;

[ecfisa]

Hola Agustín.

Empezado por AgustinOrtu

No quiero ser aguafiestas, pero el amigo wil_ramone hablaba de un TStringGrid no de un TDBGrid

Tenes razón , en ese caso:

Código Delphi [-]
unit SGTitVert;

interface

uses Windows, Types, Classes, Graphics, Grids;


type
  TStringGrid = class(Grids.TStringGrid)
  private
    FTitleHeight   : Integer;
    procedure SetTitleHeight(const Value: Integer);
  protected
    procedure DrawCell(ACol, ARow: Integer; ARect: TRect; State: TGridDrawState); override;
  public
    property TitleHeight: Integer read FTitleHeight write SetTitleHeight default 30;
  end;

implementation

procedure TStringGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
  State: TGridDrawState);
var
  LF         : LOGFONT;
  FontName   : string;
begin
  if ARow = FixedRows-1 then
  begin
    ZeroMemory(@LF, SizeOf(LF));
    LF.lfHeight        := Canvas.Font.Height ;
    LF.lfWidth         := Canvas.Font.Size;
    LF.lfEscapement    := 10 * 90;
    LF.lfCharSet       := DEFAULT_CHARSET;
    FontName           := Font.Name;
    Move(FontName, LF.lfFaceName, Length(FontName));
    Canvas.Brush.Color := FixedColor;
    Canvas.Brush.Style := bsSolid;
    Canvas.FillRect(ARect);
    Canvas.Font.Handle:= CreateFontIndirect(LF);
    Canvas.TextOut(ARect.Left + (ARect.Right - ARect.Left) div 2 - LF.lfWidth,
      ARect.Bottom + LF.lfHeight, Cells[ACol,ARow]);
  end
  else
    inherited;
end;

procedure TStringGrid.SetTitleHeight(const Value: Integer);
begin
  if Value <> FTitleHeight then
    if Value > 30 then
    begin
      FTitleHeight := Value;
      RowHeights[FixedRows-1] := Value;
    end;
end;

end.

Ejemplo de uso:

Código Delphi [-]
...

uses ..., SGTitVert; //  incluir último !!

type 
  TForm1 = class(...

...
implementation

procedure TForm1.FormCreate(Sender: TObject);
var
  sg: TStringGrid;
  s : string;
  c, r: Integer;
begin
  sg := StringGrid1;
  // los títulos de columna...
  for c := 0 to sg.ColCount-1 do  s := s + Format('Titulo%d,', [c+1]);
  sg.Rows[sg.FixedRows-1].DelimitedText := s;

  // cargar unos valores...
  for r := sg.FixedRows to sg.RowCount-1 do
    for c := 0 to sg.ColCount-1 do
      sg.Cells[c,r] := Format('Celda %d',[r+c])

  // alto de título
  sg.TitleHeight   := 90;
end;
...

Muestra:


Saludos

[[fjcg02]]

Ecfisa,

eres el re-puto maestro. O el P.A. ( puto amo)

Y no. últimamente no se lo digo a casi nadie...

Gracias

[[newtron]]

Empezado por fjcg02

Ecfisa,

eres el re-puto maestro. O el P.A. ( puto amo)

Totalmente de acuerdo. Yo hasta le estoy cogiendo manía.