Ver Mensaje Individual
  #9  
Antiguo 11-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 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
__________________
Daniel Didriksen

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

Última edición por ecfisa fecha: 11-11-2015 a las 23:52:17.
Responder Con Cita