lazarus - Delphi TStringGrid の固定行のセルのテキストの向きを変更するにはどうすればよいですか

Question

フォームに標準の TStringGrid があります。グリッドには、すべて TGridColumns オブジェクトである多数の列を含む固定行が 1 つあります。オブジェクト インスペクタを使用して列のタイトルを設定しました。デフォルトの向きは水平です。方向を垂直にする方法はありますか (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.

TStringGridDelphiで最初の行のテキストを垂直方向にレンダリングする方法は次のとおりです。

イベントでテキストを単純にレンダリングしたい場合は、次のことを検討する必要があるため、オーバーライドされたDrawCellプロシージャを使用するのが最も簡単な方法であると思われるため、使用したいと思います。OnDrawCell

• をDefaultDrawing設定するとTrue、イベントが発生したときにテキストが既にレンダリングされるOnDrawCellため、ここでは、セルのキャプションをCellsプロパティではなく別の変数に格納して、テキストがレンダリングされないようにすることをお勧めします。保存した独自のキャプションを垂直に描画する
• DefaultDrawingを設定する場合Falseは、3D境界線を含め、セル全体を自分で描画する必要があります。IMHOはそれほどクールではありません。個人的には、コントロールに背景を描画させたいと思います。
  

これは、オーバーライドされたDrawCellプロシージャを使用するDelphiコードです。テキストはセルの長方形の内側の中央に配置されています。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.

そして、これがどのように見えるかです：