如何更改Delphi TStringGrid中固定行的单元格中的文本方向
如何更改Delphi TStringGrid中固定行的单元格中的文本方向
提问于 2012-02-05 17:57:25
我在表单上有一个标准的TStringGrid。我在网格中有一个固定的行，其中包含许多列，这些列都是TGridColumns对象。我已经使用对象检查器设置了列标题，默认方向为水平。有没有办法使方向垂直(就像在Excel的单元格中一样)？
Stack Overflow用户
回答已采纳
发布于 2012-02-06 11:45:35
下面是如何在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属性中，这样就不会渲染任何文本，你可以绘制自己存储的标题vertically - if你将把
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.它看起来是这样的：
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/9148347
复制相关文章
相似问题
腾讯云开发者
