Как изменить ориентацию текста в ячейках в фиксированных строках в Delphi TStringGrid

Question

У меня есть стандартный TStringGrid в форме. У меня есть одна фиксированная строка в сетке, которая содержит несколько столбцов, которые являются объектами TGridColumns. Я установил заголовки столбцов, используя инспектор объектов, а ориентация по умолчанию - горизонтальная. Есть ли способ сделать ориентацию вертикальной (как вы можете в ячейках в Excel)?

Answer 1

Вот как сделать текст первой строки вертикально в Lazarus:

unit Unit1; 

{$mode objfpc}{$H+} 

interface 

uses 
    Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Grids, 
    StdCtrls; 

type 
    TStringGrid = class(Grids.TStringGrid) 
    protected 
    procedure DrawCellText(ACol, ARow: Integer; ARect: TRect; 
     AState: TGridDrawState; AText: String); override; 
    end; 

type 
    TForm1 = class(TForm) 
    Button1: TButton; 
    StringGrid1: TStringGrid; 
    procedure Button1Click(Sender: TObject); 
    private 
    { private declarations } 
    public 
    { public declarations } 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.lfm} 

procedure TStringGrid.DrawCellText(ACol, ARow: Integer; ARect: TRect; 
    AState: TGridDrawState; AText: String); 
var 
    TextPosition: TPoint; 
begin 
    if ARow = 0 then 
    begin 
    Canvas.Font.Orientation := 900; 
    TextPosition.X := ARect.Left + 
     ((ARect.Right - ARect.Left - Canvas.TextHeight(AText)) div 2); 
    TextPosition.Y := ARect.Bottom - 
     ((ARect.Bottom - ARect.Top - Canvas.TextWidth(AText)) div 2); 
    Canvas.TextOut(TextPosition.X, TextPosition.Y, AText); 
    end 
    else 
    inherited DrawCellText(ACol, ARow, ARect, AState, AText); 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
var 
    I: Integer; 
    GridColumn: TGridColumn; 
begin 
    for I := 0 to 4 do 
    begin 
    GridColumn := StringGrid1.Columns.Add; 
    GridColumn.Width := 24; 
    GridColumn.Title.Font.Orientation := 900; 
    GridColumn.Title.Layout := tlBottom; 
    GridColumn.Title.Caption := 'Column no. ' + IntToStr(I); 
    end; 
    StringGrid1.RowHeights[0] := 80; 
end; 

end. 

Вот как сделать текст в первой строки из TStringGrid вертикально в Delphi:

Я предпочел бы использовать перекрываться DrawCell потому что мне кажется, что это самый простой способ, потому что, если вы хотите сделать текст просто на мероприятии OnDrawCell, тогда вы должны подумать:

• , если у вас будет DefaultDrawing, установленный в True, тогда текст будет отображаться при запуске события OnDrawCell, поэтому здесь я бы рекомендовал, например. для хранения ячеек в отдельной переменной, а не в Cells, поэтому текст не будет отображаться, и вы можете нарисовать свои собственные сохраненные титры по вертикали
• , если у вас будет DefaultDrawing, установленный на False, тогда вам придется рисовать вся клетка по своему усмотрению, в том числе 3D границы, что ИМХО не так круто, и я лично предпочитаю, чтобы контроль рисует фон для нас
  

Вот код Delphi, который использует перекрываться DrawCell процедура. Текст центрируется внутри прямоугольника ячейки; обратите внимание, что я не использовал DrawTextEx для измерения размера текста, потому что эта функция не учитывает измененную ориентацию шрифта.

unit Unit1; 

interface 

uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, StdCtrls, Grids; 

type 
    TStringGrid = class(Grids.TStringGrid) 
    protected 
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; 
     AState: TGridDrawState); override; 
    end; 

type 
    TForm1 = class(TForm) 
    Button1: TButton; 
    StringGrid1: TStringGrid; 
    procedure Button1Click(Sender: TObject); 
    private 
    { Private declarations } 
    public 
    { Public declarations } 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.dfm} 

procedure TStringGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; 
    AState: TGridDrawState); 
var 
    LogFont: TLogFont; 
    TextPosition: TPoint; 
    NewFontHandle: HFONT; 
    OldFontHandle: HFONT; 
begin 
    if ARow = 0 then 
    begin 
    GetObject(Canvas.Font.Handle, SizeOf(LogFont), @LogFont); 
    LogFont.lfEscapement := 900; 
    LogFont.lfOrientation := LogFont.lfEscapement; 
    NewFontHandle := CreateFontIndirect(LogFont); 
    OldFontHandle := SelectObject(Canvas.Handle, NewFontHandle); 
    TextPosition.X := ARect.Left + 
     ((ARect.Right - ARect.Left - Canvas.TextHeight(Cells[ACol, ARow])) div 2); 
    TextPosition.Y := ARect.Bottom - 
     ((ARect.Bottom - ARect.Top - Canvas.TextWidth(Cells[ACol, ARow])) div 2); 
    Canvas.TextRect(ARect, TextPosition.X, TextPosition.Y, Cells[ACol, ARow]); 
    NewFontHandle := SelectObject(Canvas.Handle, OldFontHandle); 
    DeleteObject(NewFontHandle); 
    end 
    else 
    inherited DrawCell(ACol, ARow, ARect, AState); 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
var 
    I: Integer; 
begin 
    for I := 0 to StringGrid1.ColCount - 1 do 
    begin 
    StringGrid1.ColWidths[I] := 24; 
    StringGrid1.Cells[I, 0] := 'Column no. ' + IntToStr(I); 
    end; 
    StringGrid1.RowHeights[0] := 80; 
end; 

end. 

А вот как это выглядит: