roberto
8679a9bc04
git-svn-id: https://192.168.0.254/svn/Proyectos.AbetoDesign_FactuGES/trunk@2 93f398dd-4eb6-7a46-baf6-13f46f578da2
298 lines
11 KiB
ObjectPascal
298 lines
11 KiB
ObjectPascal
unit funciones;
|
||
|
||
interface
|
||
|
||
function RtfToText(Cadena: PChar): PChar; cdecl; export;
|
||
|
||
implementation
|
||
|
||
uses
|
||
Forms, Classes, SysUtils, StdCtrls, ComCtrls,
|
||
RVRTF, RVRTFErr, Menus, RVTypes;
|
||
|
||
type
|
||
TConversor = class(TObject)
|
||
private
|
||
FirstLine: Boolean;
|
||
procedure DoReaderText(Sender: TRVRTFReader; const Text: TRVAnsiString;
|
||
Position: TRVRTFPosition);
|
||
public
|
||
RTFText: TRVAnsiString;
|
||
function ExtractTextFromRTF(const AStream: TStream): Boolean;
|
||
end;
|
||
|
||
{ TConversor }
|
||
|
||
procedure TConversor.DoReaderText(Sender: TRVRTFReader;
|
||
const Text: TRVAnsiString; Position: TRVRTFPosition);
|
||
begin
|
||
if (Position <> rtf_ts_ContinuePara) and not FirstLine then
|
||
RTFText := RTFText+#13#10;
|
||
FirstLine := False;
|
||
RTFText := RTFText+Text;
|
||
end;
|
||
|
||
function TConversor.ExtractTextFromRTF(const AStream: TStream): Boolean;
|
||
var
|
||
Parser: TRVRTFReader;
|
||
begin
|
||
{FirstLine := True;}
|
||
parser := TRVRTFReader.Create(nil);
|
||
try
|
||
Parser.OnNewText := DoReaderText;
|
||
Result := (Parser.ReadFromStream(AStream) = rtf_ec_OK);
|
||
finally
|
||
Parser.Free;
|
||
end;
|
||
end;
|
||
|
||
function RtfToText(Cadena: PChar): PChar;
|
||
var
|
||
AStream : TStringStream;
|
||
AConversor : TConversor;
|
||
begin
|
||
AStream := TStringStream.Create(Cadena);
|
||
AConversor := TConversor.Create;
|
||
try
|
||
AConversor.ExtractTextFromRTF(AStream);
|
||
Result := PChar(AConversor.RTFText);
|
||
finally
|
||
FreeAndNil(AConversor);
|
||
FreeAndNIL(AStream);
|
||
end;
|
||
end;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
// NO USAR LAS FUNCIONES QUE VIENEN A CONTINUACIÓN
|
||
|
||
|
||
// Esta función falla cuando hay caracteres especiales en el texto (ñ, por ejemplo).
|
||
// Mejor la de abajo.
|
||
|
||
function RtfToText2(Cadena: PChar): PChar;
|
||
var
|
||
i: integer;
|
||
CadenaAux1: String;
|
||
|
||
begin
|
||
//Si no tiene ninguna llave no esta guardado como rtf
|
||
if (Pos('{', Cadena) = 0) then
|
||
Result := Cadena
|
||
else
|
||
//Esta guardado con rtf
|
||
begin
|
||
//Quitamos todo lo que está antes de \fs1x
|
||
i := Pos('\fs', Cadena);
|
||
CadenaAux1 := Copy(Cadena, i, StrLen(Cadena)-1);
|
||
|
||
//Quitamos la parte de delante \fs1x
|
||
i:= Pos(' ', CadenaAux1);
|
||
CadenaAux1 := Copy(PChar(CadenaAux1), i+1, StrLen(PChar(CadenaAux1))-1);
|
||
|
||
//Quitamos todo lo de la parte de atras a partir de la primera barra \ que tengamos
|
||
i:= Pos('\', CadenaAux1);
|
||
CadenaAux1 := Copy(PChar(CadenaAux1), 0, i-1);
|
||
|
||
Result := PChar(CadenaAux1);
|
||
end;
|
||
end;
|
||
|
||
|
||
{
|
||
Convert RTF enabled text to plain.
|
||
http://www.delphipraxis.net/topic45179.html
|
||
}
|
||
|
||
// Esta función falla porque se come letras del final de cada línea (¿?)
|
||
|
||
// HAY QUE LIMPIAR LA CADENA DE ENTRADA DE SALTOS DE LÍNEA (#$D#$A) POR QUE
|
||
// SI NO, NO ES UNA CADENA CON TEXTO RTF VÁLIDO
|
||
|
||
function RtfToText3(Cadena: PChar): PChar;
|
||
const
|
||
SaltoLinea = #13#10; //--> #$D#$A
|
||
var
|
||
aSource: string; // <- Para almacenar la cadena de entrada sin saltos de línea
|
||
Source: string;
|
||
NChar: Integer;
|
||
|
||
function ProcessGroupRecursevly: string;
|
||
|
||
function HexToInt(HexStr: String): Integer;
|
||
begin
|
||
result := StrToInt('$' + HexStr);
|
||
end;
|
||
|
||
procedure SkipStar;
|
||
var
|
||
BracesOpened: Integer;
|
||
Escaped: Boolean;
|
||
begin
|
||
BracesOpened:=1;
|
||
Escaped:=false;
|
||
while BracesOpened>0
|
||
do begin
|
||
Inc (NChar);
|
||
case Source [NChar] of
|
||
'{': if Escaped
|
||
then Escaped:=false
|
||
else Inc (BracesOpened);
|
||
'}': if Escaped
|
||
then Escaped:=false
|
||
else Dec (BracesOpened);
|
||
'\': Escaped:=not Escaped;
|
||
else Escaped:=false;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function UnicodeCharCode2ANSIChar (aCode: LongInt): Char;
|
||
type
|
||
TUnicode2ANSITable=array [$0410..$044f] of Char;
|
||
const
|
||
Unicode2ANSITable: TUnicode2AnsiTable=('À', 'Á', 'Â', 'Ã', 'Ä', 'Å', 'Æ', 'Ç', 'È', 'É', 'Ê', 'Ë', 'Ì', 'Í', 'Î', 'Ï', 'Ð', 'Ñ', 'Ò', 'Ó', 'Ô', 'Õ', 'Ö', '×', 'Ø', 'Ù', 'Ú', 'Û', 'Ü', 'Ý', 'Þ', 'ß',
|
||
'à', 'á', 'â', 'ã', 'ä', 'å', 'æ', 'ç', 'è', 'é', 'ê', 'ë', 'ì', 'í', 'î', 'ï', 'ð', 'ñ', 'ò', 'ó', 'ô', 'õ', 'ö', '÷', 'ø', 'ù', 'ú', 'û', 'ü', 'ý', 'þ', 'ÿ');
|
||
begin
|
||
if (Low (Unicode2ANSITable)<=aCode) and (aCode<=High (Unicode2ANSITable)) then
|
||
UnicodeCharCode2ANSIChar:=Unicode2ANSITable [aCode]
|
||
else UnicodeCharCode2ANSIChar:='?';
|
||
end;
|
||
|
||
var
|
||
Control, NumericValue, TextValue: string;
|
||
begin
|
||
Result:='';
|
||
Inc (NChar);
|
||
while NChar<=Length (Source)
|
||
do case Source [NChar] of
|
||
'{': Result:=Result+ProcessGroupRecursevly;
|
||
'}': begin
|
||
Inc (NChar);
|
||
Break;
|
||
end;
|
||
'\': begin
|
||
Inc (NChar);
|
||
case Source [NChar] of
|
||
'''': begin
|
||
Result:=Result+Chr (HexToInt (Copy (Source, NChar+1, 2)));
|
||
Inc (NChar, 3);
|
||
end;
|
||
'~': Result:=Result+#$20;
|
||
'*': SkipStar;
|
||
'a'..'z': begin
|
||
Control:='';
|
||
while Source [NChar] in ['a'..'z']
|
||
do begin
|
||
Control:=Control+Source [NChar];
|
||
Inc (NChar);
|
||
end;
|
||
if Source [NChar]='-'
|
||
then begin
|
||
NumericValue:=Source [NChar];
|
||
Inc (NChar);
|
||
end
|
||
else NumericValue:='';
|
||
while Source [NChar] in ['0'..'9']
|
||
do begin
|
||
NumericValue:=NumericValue+Source [NChar];
|
||
Inc (NChar);
|
||
end;
|
||
if Source [NChar]='{'
|
||
then ProcessGroupRecursevly;
|
||
TextValue:='';
|
||
if not (Source [NChar] in ['a'..'z', '{', '}', '\'])
|
||
then begin
|
||
Inc (NChar);
|
||
while not (Source [NChar] in ['{', '}', '\'])
|
||
do begin
|
||
TextValue:=TextValue+Source [NChar];
|
||
Inc (NChar);
|
||
end;
|
||
end;
|
||
if (Control='line') or (Control='par')
|
||
then Result:=Result+#$0D#$0A
|
||
else if Control='tab'
|
||
then Result:=Result+#$09
|
||
else if Control='u'
|
||
then Result:=Result+UnicodeCharCode2ANSIChar (StrToInt (NumericValue))
|
||
else if Control='colortbl'
|
||
then TextValue:='';
|
||
if Length (TextValue)>0
|
||
then if (not ((TextValue [Length (TextValue)]=';') and (Source [NChar]='}')))
|
||
then begin
|
||
Result:=Result+TextValue;
|
||
TextValue:='';
|
||
end;
|
||
end;
|
||
else begin
|
||
Result:=Result+Source [NChar];
|
||
Inc (NChar);
|
||
end;
|
||
end;
|
||
end;
|
||
else begin
|
||
Result:=Result+Source [NChar];
|
||
Inc (NChar);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function InitSource: Boolean;
|
||
var
|
||
BracesCount: Integer;
|
||
Escaped: Boolean;
|
||
begin
|
||
if Copy (aSource, 1, 5) <> '{\rtf' then
|
||
InitSource:=false
|
||
else begin
|
||
Source:='';
|
||
BracesCount:=0;
|
||
Escaped:=false;
|
||
NChar:=1;
|
||
while (NChar<=Length (aSource)) and (BracesCount>=0)
|
||
do begin
|
||
if not (aSource [NChar] in [#$0D, #$0A])
|
||
then begin
|
||
Source:=Source+aSource [NChar];
|
||
case aSource [NChar] of
|
||
'{': if not Escaped
|
||
then Inc (BracesCount)
|
||
else Escaped:=false;
|
||
'}': if not Escaped
|
||
then Dec (BracesCount)
|
||
else Escaped:=false;
|
||
'\': Escaped:=true;
|
||
else Escaped:=false;
|
||
end;
|
||
end;
|
||
Inc (NChar);
|
||
end;
|
||
InitSource:=BracesCount=0;
|
||
end;
|
||
end;
|
||
|
||
begin
|
||
// Hay que quitar el salto de línea al final de la aSource RTF
|
||
aSource := Copy(Cadena, 1, length(Cadena)-2);
|
||
|
||
// Cambiar los saltos de línea que no son de RTF por un caracter para
|
||
// que se limpien.
|
||
// aSource := StringReplace(aSource, SaltoLinea, '^', [rfreplaceall]);
|
||
|
||
if InitSource then
|
||
begin
|
||
NChar:=1;
|
||
Result:= PChar(ProcessGroupRecursevly);
|
||
end
|
||
else
|
||
Result := PChar(aSource);
|
||
end;
|
||
|
||
end.
|