convertidor rtf2html

Ecijano86 · #1 06-06-2007

Holas buenas tardes:
Buscando entre tanto por internet, encontramos pocos métodos para convertir rtf a html , y todos en ALEMÁN, que no tenemos ni papa xD. aquí va nuestro método, para que no tengáis que partiros los cuernos buscando por ahí :

Código:

procedure Rtf2Html(Memo : TRichEdit, strHtml: String );
var Contador,Contador2:integer; // Contadores
    s,s2:string; // cadenas
    negrita1,negrita2,cursiva1,cursiva2,subrayado1,subrayado2,lista1,lista2:boolean; // Atributos caracter anterior (1) y caracter actual (2)
    ccolor1, ccolor2:tColor; // color de letra anterior (1) y color de letra actual (2)
    ccolorFondo:tColor; // color de fondo
    iSize1, iSize2:integer; // Tamaño de letra anterior (1) y tamaño de letra actual (2)
    Alineacion1, Alineacion2:TAlignment; // Alineacion de parrafo anterior(1) y alineacion de parrafo actual (2)

begin
  strHtml := '';
  ccolorFondo:= Memo.Color;

  // creamos la cabecera
  s:= '<html><head><title></title></head>'+'<body bgcolor="#' +IntToHex(GetRValue(ccolorFondo),2)+ IntToHex(GetGValue(ccolorFondo),2)+ IntToHex(GetBValue(ccolorFondo),2) + '" link="#FF0000" alink="#FF0000" vlink="#FF0000">';

  //inicializamos las variables de tipo boolean
  negrita1:=false;
  cursiva1:=false;
  subrayado1:=false;
  lista1:=false;
  negrita2:=false;
  cursiva2:=false;
  subrayado2:=false;
  lista2:=false;

  // Contabilizamos el número de caracteres
  Memo.SelectAll;
  Contador2:=Memo.SelLength;

  // Seleccionamos el primer caracter y sus propiedades
  Memo.SelLength:=1;
  cColor1:= Memo.SelAttributes.Color;
  iSize1:=CalculateSize(Memo.SelAttributes.Size);
  Alineacion1:= Memo.Paragraph.Alignment;

  // creamos la cadena correspondiente al primer carácter
  s:=s+'<font size="'+IntToStr(iSize1)+'" color="#'+IntToHex(GetRValue(cColor1),2)+IntToHex(GetGValue(cColor1),2)+IntToHex(GetBValue(cColor1),2)+'">';
  // comprobamos la alineación del párrafo
  case Alineacion1 of
    taLeftJustify:s:=s+'<p align="left">';
    taRightJustify:s:=s+'<p align="right">';
    taCenter:s:=s+'<p align="center">';
  end;
  //comprobamos si estamos en una lista
  if Memo.Paragraph.Numbering = TNumberingStyle(true) then
    begin
      Lista1:=true;
      s:= s + '<li>';
    end;

  // Bucle para los siguientes caracteres
  for Contador:=0 to Contador2 do
  begin
    Memo.SelStart:=Contador;
    Memo.SelLength:=1;
    // Con el carácter seleccionado ...
    with Memo.SelAttributes do
    begin
      cColor2:= Color;
      iSize2:=CalculateSize(Size);
      Alineacion2:= Memo.Paragraph.Alignment;

      if fsBold in Style then
        negrita2:=true
      else
        negrita2:=false;

      if fsItalic in Style then
        cursiva2:=true
      else
        cursiva2:=false;

      if fsUnderline in Style then
        subrayado2:=true
      else
        subrayado2:=false;

      if Memo.Paragraph.Numbering = TNumberingStyle(true) then
        Lista2:=true
      else
        Lista2:=false;
    end;

    // Comprobamos si ha cambiado el estilo con respecto al caracter anterior
    if lista2 = true then
      if lista1 <> lista2 then
      begin
        s:=s + '<li>';
        lista1:= true;
      end;

    if negrita1 <> negrita2 then
      if negrita2 = true then
        s := s + '<b>';

    if cursiva1 <> cursiva2 then
      if cursiva2 = true then
        s := s + '<i>';

    if subrayado1 <> subrayado2 then
      if subrayado2 = true then
        s := s + '<u>';

    if subrayado1 <> subrayado2 then
      if subrayado2 = false then
        s := s + '</u>';

    if cursiva1 <> cursiva2 then
      if cursiva2 = false then
        s := s + '</i>';

    if negrita1 <> negrita2 then
      if negrita2 = false then
        s := s + '</b>';

    if Alineacion1 <> Alineacion2 then
    begin
      case Alineacion2 of
        //Alineacion Izquierda
        taLeftJustify:
        begin
        if cColor1 <> cColor2 then
          if iSize1 <> iSize2 then
            s:=s+'</p></font><font size="'+IntToStr(iSize2)+'" color="#'+IntToHex(GetRValue(cColor2),2)+IntToHex(GetGValue(cColor2),2)+IntToHex(GetBValue(cColor2),2)+'"><p align="left">'
          else
            s:=s+'</p></font><font size="'+IntToStr(iSize1)+'" color="#'+IntToHex(GetRValue(cColor2),2)+IntToHex(GetGValue(cColor2),2)+IntToHex(GetBValue(cColor2),2)+'"><p align="left">'
        else
          if iSize1 <> iSize2 then
            s:=s+'</p></font><font size="'+IntToStr(iSize2)+'" color="#'+IntToHex(GetRValue(cColor1),2)+IntToHex(GetGValue(cColor1),2)+IntToHex(GetBValue(cColor1),2)+'"><p align="left">'
          else
            s:=s+'</p><p align="left">';
        end;
        //Alineacion Derecha
        taRightJustify:
        begin
        if cColor1 <> cColor2 then
          if iSize1 <> iSize2 then
            s:=s+'</p></font><font size="'+IntToStr(iSize2)+'" color="#'+IntToHex(GetRValue(cColor2),2)+IntToHex(GetGValue(cColor2),2)+IntToHex(GetBValue(cColor2),2)+'"><p align="right">'
          else
            s:=s+'</p></font><font size="'+IntToStr(iSize1)+'" color="#'+IntToHex(GetRValue(cColor2),2)+IntToHex(GetGValue(cColor2),2)+IntToHex(GetBValue(cColor2),2)+'"><p align="right">'
        else
          if iSize1 <> iSize2 then
            s:=s+'</p></font><font size="'+IntToStr(iSize2)+'" color="#'+IntToHex(GetRValue(cColor1),2)+IntToHex(GetGValue(cColor1),2)+IntToHex(GetBValue(cColor1),2)+'"><p align="right">'
          else
            s:=s+'</p><p align="right">';
        end;
        //Alineacion Centrada
        taCenter:
        begin
        if cColor1 <> cColor2 then
          if iSize1 <> iSize2 then
            s:=s+'</p></font><font size="'+IntToStr(iSize2)+'" color="#'+IntToHex(GetRValue(cColor2),2)+IntToHex(GetGValue(cColor2),2)+IntToHex(GetBValue(cColor2),2)+'"><p align="center">'
          else
            s:=s+'</p></font><font size="'+IntToStr(iSize1)+'" color="#'+IntToHex(GetRValue(cColor2),2)+IntToHex(GetGValue(cColor2),2)+IntToHex(GetBValue(cColor2),2)+'"><p align="center">'
        else
          if iSize1 <> iSize2 then
            s:=s+'</p></font><font size="'+IntToStr(iSize2)+'" color="#'+IntToHex(GetRValue(cColor1),2)+IntToHex(GetGValue(cColor1),2)+IntToHex(GetBValue(cColor1),2)+'"><p align="center">'
          else
            s:=s+'</p><p align="center">';
        end
      end;
      Alineacion1 := Alineacion2;
    end
    else
    begin
      if cColor1 <> cColor2 then
        if iSize1 <> iSize2 then
          s:=s+'</font><font size="'+IntToStr(iSize2)+'" color="#'+IntToHex(GetRValue(cColor2),2)+IntToHex(GetGValue(cColor2),2)+IntToHex(GetBValue(cColor2),2)+'">'
        else
          s:=s+'</font><font size="'+IntToStr(iSize1)+'" color="#'+IntToHex(GetRValue(cColor2),2)+IntToHex(GetGValue(cColor2),2)+IntToHex(GetBValue(cColor2),2)+'">'
      else
        if iSize1 <> iSize2 then
          s:=s+'</font><font size="'+IntToStr(iSize2)+'" color="#'+IntToHex(GetRValue(cColor1),2)+IntToHex(GetGValue(cColor1),2)+IntToHex(GetBValue(cColor1),2)+'">'
    end;

    // Comprobamos si existen caracteres extraños
    if Memo.SelText='"' then
      s:=s+'&quot;'
    else
    if Memo.SelText='<' then
      s:=s+'&lt;'
    else
    if Memo.SelText='>' then
      s:=s+'&gt;'
    else
    if Memo.SelText='ä' then
      s:=s+'&auml;'
    else
    if Memo.SelText='Ä' then
      s:=s+'&Auml;'
    else
    if Memo.SelText='ö' then
      s:=s+'&ouml;'
    else
    if Memo.SelText='Ö' then
      s:=s+'&Ouml;'
    else
    if Memo.SelText='ü' then
      s:=s+'&uuml;'
    else
    if Memo.SelText='Ü' then
      s:=s+'&Uuml;'
    else
    if Memo.SelText='ß' then
      s:=s+'&szlig;'
    else
    if Memo.SelText='' then
      begin
        Memo.SelStart := Contador + 1;
        Memo.SelLength := 1;
        if Memo.SelText = '' then
          s:=s+'<br>'
        else
          if Lista1 = lista2 then
          begin
            s := s + '</li>';
            lista1:=false;
          end;
      end
    else
      s:=s+Memo.SelText;

    // establecemos las propiedades para comparar con el siguiente carácter
    negrita1:=negrita2;
    cursiva1:=cursiva2;
    subrayado1:=subrayado2;
    cColor1 := cColor2;
    iSize1 := iSize2;
  end; // fin del for

 // eliminamos los comentarios y los espacios en blanco los sustituimos por '&nbsp;'
 for Contador:=100 downto 2 do
  begin
   s2:='';
   for Contador2:=1 to Contador do
    s2:=s2+' ';
   s:=StringReplace(s,s2,'<!--'+IntToStr(Contador)+'-->',[rfReplaceAll,rfIgnoreCase]);
  end;

 for Contador:=100 downto 2 do
  begin
   s2:='';
   for Contador2:=1 to Contador do
    s2:=s2+'&nbsp;';
   s:=StringReplace(s,'<!--'+IntToStr(Contador)+'-->',s2,[rfReplaceAll,rfIgnoreCase]);
  end;

  // cerramos las etiquetas body y html
  s:=s+'</body></html>';
  strHtml := s;
end;

Saludos y esperemos que sirva

PD: Se aceptan sugerencias y mejoras jeje , a parte, comentar el código... no es lo nuestro xD
PD2: Hemos puesto las etiquetas 'code' y '/code' porque con las de delphi... interpretaba algunas de las etiquetas html!!! LOL xD

[ArdiIIa] · #2 06-06-2007

Pues muchas gracias por el codigo... A lo mejor sería interesante meterlo en la sección de TRUCOS

jachguate · #3 06-06-2007

En primer lugar... gracias por el cógido.

En segundo, estoy de acuerdo con ArdiIIa en cuanto a ponerlo en la sección de trucos, pero con todo respeto, creo que vale la pena revisarlo primero.

He dado una mirada rápida y hay al menos 2 cosas que habrá que cambiar, para tener una rutina robusta y de uso general.

La rutina debiera generar no un html completo (con cabecera y todo), sino el "fragmento" de html que representa el rtf, por si el programador que la use quiere incluir esto en un <div> o en cualquier otro contenedor.
La forma de identificar y codificar "caracteres especiales", pues por ahora soporta solamente un número limitado de estos. Estoy seguro que habrá una forma genérica de identificar aquellos caracteres que no pertenezcan al alfabeto Inglés y obtener su respectivo código html (quizas sea mejor con la notación &#xx; y no con &x; ).

¿La revisamos a fondo?

Finalmente, sobre la mezcla de etiquetas que reportan que ocurre en la etiqueta delphi, ahora mismo estoy notificando en el foro de moderadores de la situación para que se vea si está en nuestras manos subsanarlo.

Saludos.

Ecijano86 · #4 07-06-2007

Cita:

Empezado por jachguate

En primer lugar... gracias por el cógido.

En segundo, estoy de acuerdo con ArdiIIa en cuanto a ponerlo en la sección de trucos, pero con todo respeto, creo que vale la pena revisarlo primero.

He dado una mirada rápida y hay al menos 2 cosas que habrá que cambiar, para tener una rutina robusta y de uso general.

La rutina debiera generar no un html completo (con cabecera y todo), sino el "fragmento" de html que representa el rtf, por si el programador que la use quiere incluir esto en un <div> o en cualquier otro contenedor.
La forma de identificar y codificar "caracteres especiales", pues por ahora soporta solamente un número limitado de estos. Estoy seguro que habrá una forma genérica de identificar aquellos caracteres que no pertenezcan al alfabeto Inglés y obtener su respectivo código html (quizas sea mejor con la notación &#xx; y no con &x; ).

¿La revisamos a fondo?

Finalmente, sobre la mezcla de etiquetas que reportan que ocurre en la etiqueta delphi, ahora mismo estoy notificando en el foro de moderadores de la situación para que se vea si está en nuestras manos subsanarlo.

Saludos.

Buenas, en primer lugar agradecer a los que habeis contestado, luego decir que si alguien quiere revisarlo a fondo pues mejor, 4 ojos ven más que dos.

En cuanto a los errores que has visto decir, que lo de las cabeceras puede haber gente que las necesite y otras no... asi que mejor dejarlo creo yo... no?? simplemente basta con borrar lineas sino te hacen falta, tampoco no es muy importante

.

Con respecto a los caracteres especiales... esos son los que venian en todos los codigos que encontramos... si sabes más se podrían poner, cuestión de mejorar

Saludos y de nuevo gracias por vuestros comentarios.

PD: Situamos este hilo en este apartado porque no sabíamos dónde colocarlo, en manos del moderador está colocarlo en su sitio correcto

[xEsk] · #5 08-06-2007

Te he hecho esta función para los caracteres "raros" en HTML, creo q no me he dejado ninguno estandard

Código Delphi [-]// una forma de detectar caracteres estandard en HTML
function CharToHTML(AChar: Char): String;
begin
  if AChar in [' ', '!', '#'..'%', #39..';', '=', '?'..'~'] then // es un caracter estandard
    Result:=AChar
  else // es un caracter "raro"
   Result:='&#' + IntToStr(Word(AChar)) + ';';
end;

Creo q la cosa esta en detectar todos los caracteres estandard (ya que son menos q los "raros") asi pues, si es estandard lo dejamos igual, en caso contrario lo codificamos usando &#valor;

Saludos.

mapi966 · #6 22-01-2009

Podeis indicarme el procedimiento createsize.

Es que delphi no me compila, me dice que me falta. Pensaba que era una propiedad, pero creo que necesito saber al menos que hace esto.

Gracias.

[xEsk] · #7 24-01-2009

Cita:

Empezado por mapi966

Podeis indicarme el procedimiento createsize.

Es que delphi no me compila, me dice que me falta. Pensaba que era una propiedad, pero creo que necesito saber al menos que hace esto.

Gracias.

Por lo que deduzco del código, convierte un font size a un html size, pero a mi forma de entender, no lo haria como hacen en el código (que no lo veo, pero lo intuyo xD), ya que yo usaria tamaños relativos o simplemente usaria el font.size que ya tiene el texto a convertir...

Saludos.

Temas Similares
Tema	Autor	Foro	Respuestas	Último mensaje
Ayuda con la funcion Rtf2html en php	lazar	PHP	2	17-02-2007 20:24:38
Convertidor RTF2HTML	gluglu	Internet	0	12-04-2006 18:38:19
rtf2html	ivet	Servers	1	06-06-2005 11:33:11
rtf2html	ivet	OOP	1	14-05-2005 22:27:29
Convertidor de texto antiguo	rsotolongo	Varios	2	30-05-2004 03:35:45