Ver Mensaje Individual
  #13  
Antiguo 12-11-2015
Avatar de ecfisa
ecfisa ecfisa is offline
Moderador
 
Registrado: dic 2005
Ubicación: Tres Arroyos, Argentina
Posts: 10.508
Reputación: 36
ecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to behold
Hola Agustín.
Cita:
Empezado por AgustinOrtu Ver Mensaje
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
__________________
Daniel Didriksen

Guía de estilo - Uso de las etiquetas - La otra guía de estilo ....

Última edición por ecfisa fecha: 12-11-2015 a las 00:49:06.
Responder Con Cita