Как вы можете изменить ориентацию текста в ячейках фиксированных строк в 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.

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