Canvas - exibir texto sobreescrito e subescrito

Função para Criar Subescrito e Sobrecrito

procedure SuperSubLabelOut(Canvas:TCanvas; const aRect:TRect; X, Y:integer; text:String); 

var 

  i,xx:integer; 

  // s:string[16]; 

  subScript, superScript:boolean; 

  DefFont:TFont; 

begin 

  Canvas.FillRect(aRect); 

  DefFont:=TFont.Create; 

  DefFont.Assign(Canvas.Font); 

  with Canvas do 

  begin 

    xx:=X; 

    for i:=1 to length(text) do 

    begin 

      if text[i-1] = '_' then 

        subScript:=true 

      else 

        subScript:=false; 

      if text[i-1] = '^' then 

        superScript:=true 

      else 

        superScript:=false; 

      if (text[i] < '_' ) and (text[i] < '^' ) then 

      begin 

        if ( subScript ) then 

        begin 

          Canvas.Font.Height:=Canvas.Font.Height*8 div 10; 

          TextRect(Rect(xx,aRect.Top,xx+TextWidth(text[i]),aRect.Bottom),xx,Y+abs(8*Canvas.Font.Height-10*DefFont.Height) div 10, text[i]); 

          inc(xx,TextWidth(text[i])); 

        end; 

        if ( not subScript) and ( not superScript ) then 

        begin 

          Canvas.Font:=DefFont; 

          TextRect(Rect(xx,aRect.Top,xx+TextWidth(text[i]),aRect.Bottom),xx, Y, text[i]); 

          inc(xx,TextWidth(text[i])); 

        end; 

        if ( superScript ) then 

        begin 

          Canvas.Font.Height:=Canvas.Font.Height*9 div 10; 

          TextRect(Rect(xx,aRect.Top,xx+TextWidth(text[i]),aRect.Bottom),xx, Y-abs(8*Canvas.Font.Height-10*DefFont.Height) div 20, text[i]); 

          inc(xx,TextWidth(text[i])); 

        end; 

        Canvas.Font:=DefFont; 

      end; 

    end; //for loop 

  end; // with 

  DefFont.Free; 

end; 

Exemplo de uso:

Coloque um Label com propriedade Caption com: "Formula da Agua H_2O" ou "medida 3000 cm^3"

procedure TForm1.Button1Click(Sender: TObject);

begin

  SuperSubLabelOut(Canvas,ClientRect ,100,100,Label1.Caption);

end;