FTP | CCD | Buscar | Trucos | Trabajo | Foros |
|
Registrarse | FAQ | Miembros | Calendario | Guía de estilo | Temas de Hoy |
|
Herramientas | Buscar en Tema | Desplegado |
|
#1
|
|||
|
|||
convertidor rtf2html
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; 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 Última edición por Ecijano86 fecha: 06-06-2007 a las 20:18:40. |
#2
|
||||
|
||||
Pues muchas gracias por el codigo... A lo mejor sería interesante meterlo en la sección de TRUCOS
__________________
Un poco de tu generosidad puede salvar la vida a un niño. ASÍ DE SENCILLO |
#3
|
||||
|
||||
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 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.
__________________
Juan Antonio Castillo Hernández (jachguate) Guía de Estilo | Etiqueta CODE | Búsca antes de preguntar | blog de jachguate Última edición por jachguate fecha: 06-06-2007 a las 21:24:39. |
#4
|
|||
|
|||
Cita:
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 |
#5
|
||||
|
||||
Te he hecho esta función para los caracteres "raros" en HTML, creo q no me he dejado ninguno estandard
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. Última edición por xEsk fecha: 09-06-2007 a las 17:39:06. |
#6
|
|||
|
|||
Calculatesize
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. |
|
|
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 |
|