Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

uses
   {...} Grids;

 type
   TForm1 = class(TForm)
     StringGrid1: TStringGrid;
     procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
       Rect: TRect; State: TGridDrawState);
   end;

 {...}

 implementation

 {...}

 // Display text vertically in StringGrid cells 
// Vertikale Textausgabe in den Zellen eines StringGrid 
procedure StringGridRotateTextOut(Grid: TStringGrid; ARow, ACol: Integer; Rect: TRect;
   Schriftart: string; Size: Integer; Color: TColor; Alignment: TAlignment);
 var
   lf: TLogFont;
   tf: TFont;
 begin
   // if the font is to big, resize it 
  // wenn Schrift zu gro? dann anpassen 
  if (Size > Grid.ColWidths[ACol] div 2) then
     Size := Grid.ColWidths[ACol] div 2;
   with Grid.Canvas do
   begin
     // Replace the font 
    // Font setzen 
    Font.Name := Schriftart;
     Font.Size := Size;
     Font.Color := Color;
     tf := TFont.Create;
     try
       tf.Assign(Font);
       GetObject(tf.Handle, SizeOf(lf), @lf);
       lf.lfEscapement  := 900;
       lf.lfOrientation := 0;
       tf.Handle := CreateFontIndirect(lf);
       Font.Assign(tf);
     finally
       tf.Free;
     end;
     // fill the rectangle 
    // Rechteck fullen 
    FillRect(Rect);
     // Align text and write it 
    // Text nach Ausrichtung ausgeben 
    if Alignment = taLeftJustify then
       TextRect(Rect, Rect.Left + 2,Rect.Bottom - 2,Grid.Cells[ACol, ARow]);
     if Alignment = taCenter then
       TextRect(Rect, Rect.Left + Grid.ColWidths[ACol] div 2 - Size +
         Size div 3,Rect.Bottom - 2,Grid.Cells[ACol, ARow]);
     if Alignment = taRightJustify then
       TextRect(Rect, Rect.Right - Size - Size div 2 - 2,Rect.Bottom -
         2,Grid.Cells[ACol, ARow]);
   end;
 end;

 // 2. Alternative: Display text vertically in StringGrid cells 
// 2. Variante: Vertikale Textausgabe in den Zellen eines StringGrid 
procedure StringGridRotateTextOut2(Grid:TStringGrid;ARow,ACol:Integer;Rect:TRect;
           Schriftart:String;Size:Integer;Color:TColor;Alignment:TAlignment);
 var
     NewFont, OldFont : Integer;
     FontStyle, FontItalic, FontUnderline, FontStrikeout: Integer;
 begin
    // if the font is to big, resize it 
   // wenn Schrift zu gro? dann anpassen 
   If (Size > Grid.ColWidths[ACol] DIV 2) Then
        Size := Grid.ColWidths[ACol] DIV 2;
    with Grid.Canvas do
    begin
        // Set font 
       // Font setzen 
       If (fsBold IN Font.Style) Then
           FontStyle := FW_BOLD
        Else
           FontStyle := FW_NORMAL;

        If (fsItalic IN Font.Style) Then
           FontItalic := 1
        Else
           FontItalic := 0;

        If (fsUnderline IN Font.Style) Then
           FontUnderline := 1
        Else
           FontUnderline := 0;

        If (fsStrikeOut IN Font.Style) Then
           FontStrikeout:=1
        Else
           FontStrikeout:=0;

        Font.Color := Color;

        NewFont := CreateFont(Size, 0, 900, 0, FontStyle, FontItalic,
                              FontUnderline, FontStrikeout, DEFAULT_CHARSET,
                              OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
                              DEFAULT_PITCH, PChar(Schriftart));

        OldFont := SelectObject(Handle, NewFont);
        // fill the rectangle 
       // Rechteck fullen 
       FillRect(Rect);
        // Write text depending on the alignment 
       // Text nach Ausrichtung ausgeben 
       If Alignment = taLeftJustify Then
           TextRect(Rect,Rect.Left+2,Rect.Bottom-2,Grid.Cells[ACol,ARow]);
        If Alignment = taCenter Then
           TextRect(Rect,Rect.Left+Grid.ColWidths[ACol] DIV 2 - Size + Size DIV 3,
             Rect.Bottom-2,Grid.Cells[ACol,ARow]);
        If Alignment = taRightJustify Then
           TextRect(Rect,Rect.Right-Size - Size DIV 2 - 2,Rect.Bottom-2,Grid.Cells[ACol,ARow]);

        // Recreate reference to the old font 
       // Referenz auf alten Font wiederherstellen 
       SelectObject(Handle, OldFont);
        // Recreate reference to the new font 
       // Referenz auf neuen Font loschen 
       DeleteObject(NewFont);
    end;
 end;

 // Call the method in OnDrawCell 
// Methode im OnDrawCell aufrufen 
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol,
   ARow: Integer; Rect: TRect; State: TGridDrawState);
 begin
   // In the second column: Rotate Text by 90° and left align the text 
  // Text um 90°gedreht ausgeben, linksbundig in der zweiten Spalte 
  if ACol = 1 then
     StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL',
       12,clRed, taLeftJustify);

   // In the third column: Center the text 
  // Ausgabe zentriert in der dritten Spalte 
  if ACol = 2 then
     StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL', 12, clBlue, taCenter);

   // In all other columns third row: right align the text 
  // Ausgabe rechtsbundig in den restlichen Spalten 
  if ACol > 2 then
     StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL', 12,clGreen,
       taRightJustify);
 end;

 end.