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+'"'
else
if Memo.SelText='<' then
s:=s+'<'
else
if Memo.SelText='>' then
s:=s+'>'
else
if Memo.SelText='ä' then
s:=s+'ä'
else
if Memo.SelText='Ä' then
s:=s+'Ä'
else
if Memo.SelText='ö' then
s:=s+'ö'
else
if Memo.SelText='Ö' then
s:=s+'Ö'
else
if Memo.SelText='ü' then
s:=s+'ü'
else
if Memo.SelText='Ü' then
s:=s+'Ü'
else
if Memo.SelText='ß' then
s:=s+'ß'
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 ' '
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+' ';
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