procedure  DrawRotatedText( const  DC: HDC; AText:  String ;  const  ARect: TRect;
   const  AFormat: Cardinal);
 { Like DrawText, but draws the text at a 270 degree angle.
  The format flag this function respects are
  DT_NOPREFIX, DT_HIDEPREFIX, DT_CENTER, DT_END_ELLIPSIS, DT_NOCLIP } 
 var 
  RotatedFont, SaveFont: HFONT;
  TextMetrics: TTextMetric;
  X, Y, P, I, SU, FU, W: Integer;
  SaveAlign: UINT;
  SavePen, Pen: HPEN;
  Clip: Boolean;

   function  GetSize(DC: HDC;  const  S:  string ): Integer;
   var 
    Size: TSize;
   begin 
    GetTextExtentPoint32(DC, PChar(S), Length(S), Size);
    Result := Size.cx;
   end ;

 begin 
   if  Length(AText) =  0   then  Exit;

  RotatedFont := CreateRotatedFont(DC);
  SaveFont := SelectObject(DC, RotatedFont);

  GetTextMetrics(DC, TextMetrics);
  X := ARect.Left + ((ARect.Right - ARect.Left) - TextMetrics.tmHeight)  div   2 ;

  Clip := (AFormat  and  DT_NOCLIP) <> DT_NOCLIP;

   { Find the index of the character that should be underlined. Delete '&'
    characters from the string. Like DrawText, only the last prefixed character
    will be underlined. } 
  P :=  0 ;
  I :=  1 ;
   if  AFormat  and  DT_NOPREFIX <>  0   then 
     while  I <= Length(AText)  do   begin 
       if  AText  in  LeadBytes  then 
        Inc(I)
       else   if  AText[I] = '&'  then   begin 
        Delete(AText, I,  1 );
         [i]{ Note: PChar cast is so that if Delete deleted the last character in
          the string, we don''t step past the end of the string (which would cause
          an AV if AText is now empty), but rather look at the null character
          and treat it as an accelerator key like DrawText. } 
         if  PChar(AText)[I- 1 ] <> '&'  then 
          P := I;
       end ;
      Inc(I);
     end ;

   if  AFormat  and  DT_END_ELLIPSIS <>  0   then 
   begin 
     if  (Length(AText) >  1 )  and  (GetSize(DC, AText) > ARect.Bottom - ARect.Top)  then 
     begin 
      W := ARect.Bottom - ARect.Top;
       if  W >  2   then 
       begin 
        Delete(AText, Length(AText),  1 );
         while  (Length(AText) >  1 )  and  (GetSize(DC, AText + '...') > W)  do 
          Delete(AText, Length(AText),  1 );
       end 
       else  AText := AText[ 1 ];
       if  P > Length(AText)  then  P :=  0 ;
      AText := AText + '...';
     end ;
   end ;

   if  (AFormat  and  DT_CENTER) = DT_CENTER  then 
    Y := ARect.Top + ((ARect.Bottom - ARect.Top) - GetSize(DC, AText))  div   2 
   else 
    Y := ARect.Top;

   if  Clip  then 
   begin 
    SaveDC(DC);
     with  ARect  do  IntersectClipRect(DC, Left, Top, Right, Bottom);
   end ;

  SaveAlign := SetTextAlign(DC, TA_BOTTOM);
  TextOut(DC, X, Y, PChar(AText), Length(AText));
  SetTextAlign(DC, SaveAlign);
   { Underline } 
   if  (P >  0 )  and  (AFormat  and  DT_HIDEPREFIX =  0 )  then   begin 
    SU := GetTextWidth(DC, Copy(AText,  1 , P- 1 ), False);
    FU := SU + GetTextWidth(DC, PChar(AText)[P- 1 ], False);
    Inc(X, TextMetrics.tmDescent -  2 );
    Pen := CreatePen(PS_SOLID,  1 , GetTextColor(DC));
    SavePen := SelectObject(DC, Pen);
    MoveToEx(DC, X, Y + SU,  nil );
    LineTo(DC, X, Y + FU);
    SelectObject(DC, SavePen);
    DeleteObject(Pen);
   end ;

   if  Clip  then  RestoreDC(DC, - 1 );

  SelectObject(DC, SaveFont);
  DeleteObject(RotatedFont);
 end ;