Gravação com formatação

Estou pedindo ajuda se possível para uma função que vai formatar um texto de um RichEdit em NEGRITO, ITÁLICO ou SUBLINHADO ou sem nenhuma formatação e gravar no banco entre tags html.
A formatação é feita seleciona o que quer e clicando no checkbox correspondentes e até aqui eu consegui fazer mas a função para percorrer cada caracter do que o usuário digitou e gravar entre tags html eu não consegui.
1 - Se o usuario digitar por exemplo SOU MUITO FELIZ, selecionar SOU e marcar a opção Negrito vair gravar no banco <b>SOU</b> MUITO FELIZ

2- Se o usuario digitar por exemplo SOU MUITO FELIZ, selecionar MUITO e marcar a opção Itálico vair gravar no banco SOU <i>MUITO</i> FELIZ

3- Se o usuario digitar por exemplo SOU MUITO FELIZ, selecionar FELIZ e marcar a opção Sublinhado vair gravar no banco SOU MUITO <u>FELIZ</u>

4- Se o usuario digitar por exemplo SOU MUITO FELIZ e não marcar nada grava sem nenhum formatação

5 - A função esta abaixo

E assim por diante. Se puderem me ajudar agradeço.

procedure TFormTeste.btnValidarClick(Sender: TObject);
begin
   fnVerificarFormatacoes(RichEdit1.Text);
end;

function TFormTeste.fnVerificarFormatacoes(_rstrString: String): String;
var
   _rTemp : TFontStyles;
   _rstrCaracter, _rstrNegrito, _rstrItalico, _rstrSublinhado : String;
   _rintAuxConteudo : Integer;
begin
   // Função que percorre cada caracter da string verificando
   // Se é negrito, itálico ou sublinhado montando a string final em html
   Result          := '';
   _rstrNegrito    := '';
   _rstrItalico    := '';
   _rstrSublinhado := '';
   if Length(_rstrString) <> 0 then
   begin
      for _rintAuxConteudo := 1 to Length(_rstrString) do
      begin
         _rstrCaracter := Copy(rchteste.Text,_rintAuxConteudo,1);
         // Verificar o estilo do caracter
         _rTemp := rchteste.SelAttributes.Style[_rstrCaracter];<-- Aqui acontece o erro
         if _rTemp = [fsBold] then
         begin
            _rstrNegrito := _rstrNegrito + _rstrCaracter;
         end;
         if _rTemp = [fsItalic] then
         begin
            _rstrItalico := _rstrItalico + _rstrCaracter;
         end;
         if _rTemp = [fsUnderline] then
         begin
            _rstrSublinhado := _rstrSublinhado + _rstrCaracter;
         end;// <b>NEGRITO</b> <i>ITÁLICO</i><u>SUBLINHADO</u>
         Result := _rstrNegrito + _rstrItalico + _rstrSublinhado;
      end;
      ShowMessage('String Formatada Final: ' + Result);
   end;
end;