☆TStringGridでの縦書き(日本語)

マトリックス表を作るときに、横書きでは、幅が広くなりすぎて見づらいので、 縦書きを試してみました。アルファベット(RENAULT)が反対向いていますが、 今回、処理したかったのは日本語なので良しとしておきます(^^;
（BMWは全角で入力しています）

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
const
  S1 = ',トヨタ,日産,マツダ,ホンダ,スズキ,スバル,三菱';
  S2 = ',ダイハツ,いすゞ,ＢＭＷ,RENAULT,フォード';
var
  I, J: Integer;
  SL: TStringList;
begin
  // サンプルデータの設定
  SL:= TStringList.Create;
  try
    SL.CommaText := S1+S2;
    J := SL.Count;
    StringGrid1.ColCount := J;
    StringGrid1.Rows[0].Assign(SL);

    StringGrid1.RowCount := 3;
    StringGrid1.FixedCols := 1;
    StringGrid1.FixedRows := 1;
    StringGrid1.RowHeights[0] := 80;
    for I := 0 to J -1 do
      StringGrid1.ColWidths[I] := 25;
  finally
    SL.Free;
  end;
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);

  // 縦書きの描画
  procedure VerticalTextDraw(S: String);
  var
    LF: TLogFont;
    I: Integer;
  begin
    StringGrid1.Canvas.Font.Height := 12;
    StringGrid1.Canvas.Font.Name := '@MS UI Gothic';

    GetObject(StringGrid1.Canvas.Font.Handle,SizeOf(LF), @LF);

    LF.lfEscapement := -900;
    StringGrid1.Canvas.Font.Handle := CreateFontIndirect(LF);
    I := ((Rect.Right - Rect.Left) div 2 + StringGrid1.Canvas.TextWidth('W'));
    StringGrid1.Canvas.TextOut(Rect.Left + I, Rect.Top + 5, S);
  end;

begin
  if (ARow = 0) then
  begin
    StringGrid1.Canvas.FillRect(Rect);
    VerticalTextDraw(StringGrid1.Cells[ACol,ARow]);
  end;
end;

end.