How to change text orientation in fixed row cells in Delphi TStringGrid

Question

I have a standard TStringGrid in the form. I have one fixed row in a grid that contains several columns that are TGridColumns objects. I set the column headers using the object inspector, and the default orientation is horizontal. Is there a way to make the orientation vertical (as you can in cells in Excel)?

Answer 1

Here's how to render the text of the first line vertically in 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. 

Here's how to make the first text of a TStringGrid row vertically in Delphi:

I would prefer to use the overriden DrawCell procedure, because it seems to me that this is the easiest way, because if you want to make the text just in OnDrawCell , then you should think:

• if you set DefaultDrawing to True , then the text will already be displayed when the OnDrawCell event is OnDrawCell , so here I would recommend, for example, to store cells in a separate variable, and not in Cells , so the text will not be displayed, and you can draw your own saved captions upright
• if you set DefaultDrawing to False , then you have to draw the whole cell yourself, including a three-dimensional border, what IMHO is not so cool, and I personally would prefer the control to draw a background for us
  

Here is the Delphi code that uses the overriden DrawCell procedure. The text is centered inside the cell rectangle; note that I did not use DrawTextEx to measure the size of the text, since this function does not take into account the changed font orientation.

 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. 

And here is what it looks like: