如何在 Delphi 的 TStringGrid 中更改固定行中单元格的文本方向

Question

我在表单上有一个标准的TStringGrid。 表格中有一行是固定的，包含多列，这些列都是TGridColumns对象。我已经使用对象检查器设置了列标题，并且默认方向是水平的。你可以像Excel单元格中一样使方向垂直吗？

- user1174918

---

你好，你的意思是类似于这个吗？无论如何，你使用的Delphi版本是什么？我用的是D2009，但里面没有TGridColumns类。 - TLama

@TLama，TGridColumns集合是FCL类，在VCL中还引入了类似的类，用于TDBGrid。OP，请澄清一下Excel部分。 - OnTheFly

http://lazarus-ccr.sourceforge.net/docs/lcl/grids/tgridcolumns.html - OnTheFly

@TLama，我认为在OnDrawCell事件中简单地绘制这些“header”单元格不会有问题（除了矩形计算外，这对于旋转字体来说相当特殊）http://i.imgur.com/m9Ja0.png - OnTheFly

@TLama，啊，我明白你的意思了！是的，重新发明绘画（包括主题）是不现实的。 - OnTheFly

请检查我的回答的第一部分；如果那篇帖子对您有帮助，请不要忘记接受它。并且请清除您在这里的评论...我已经删除了我的评论，所以这里的对话变得毫无意义:) 谢谢 - TLama

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.

以下是如何在Delphi中垂直渲染TStringGrid第一行文本的方法：

我建议使用重写的DrawCell过程，因为这似乎是最简单的方法。如果您想要在OnDrawCell事件中仅呈现文本，则应考虑以下事项：

- 如果将DefaultDrawing设置为True，则当触发OnDrawCell事件时，文本已经被呈现，因此我建议将单元格标题存储在单独的变量中，而不是Cells属性中，这样就不会呈现任何文本，您可以垂直绘制自己存储的标题。 - 如果将DefaultDrawing设置为False，则必须自己绘制整个单元格，包括3D边框，这并不是很酷，我个人更喜欢让控件为我们绘制背景。

以下是使用重写的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.

以下是内容的翻译：

这就是它的样子：

- TLama