Discussion :

[LadyWasky]

Voilà mon problème,

Dans une table d'une base de données, j'ai un champ blob qui contient du texte formatté RTF pas très long. Par exemple :

Salut tout le monde !

J'arrive à récupérer la chaîne formattée (texte+formats RTF) dans un type String, ce qui me donne donc un truc du style :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
s:='{\rtf1\ansi\ansicpg1252\deff0\deflang1036{\fonttbl{\f0\fswiss\fcharset0 Arial;}}
{\colortbl ;\red255\green0\blue0;\red0\green0\blue255;}
{\*\generator Msftedit 5.41.15.1503;}\viewkind4\uc1\pard\cf1\f0\fs36 Salut\cf0\fs20  \b tout \cf2\i le monde !\par
}'

Ca me permet d'afficher le texte formatté dans un Contrôle orienté base de données de mon cru qui est capable d'afficher correctement tous les champs RichText dans un DBCtrlGrid (aussi de mon crû, parce que le mien n'a plus les scrollBar et possède des en-tête de colonne et de ligne)

Le but est ici de réaliser un planning.
Voici une photo de la bête en action :


Ce que je cherche à faire, c'est à partir de ma chaîne formattée, de ne récupérer que le texte sans les format afin d'obtenir :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

s:='Salut tout le monde !';

Par rapport à la photo que j'ai fourni, ce serait plutôt :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

s:='Simu S21 truc machin bidule chouette';

Connaissez vous donc une fonction du style :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

function RTF_to_TextOnly(RTF:string):string;

qui permette de le faire sans avoir a passer par un RichEdit ?
J'ai beau chercher sur le Web, je sêche...

Merci d'avance.

[Rayek]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

RichEdit.lines.text;

Ca doit normalement te récupérer le texte sans le formatage, non ?

[Edit]Tu te fais ta fonction de recupérations en créeant dynamiquement un richedit dedans afin de récup le text[/edit]

[LadyWasky]

Ouip, je crois que je vais me résigner à faire comme ça, mais alors la création dynamique d'un RichEdit en plus, pour chaque appel j'ai peur de bouffer de la mémoire et d'avoir un truc un poil lent...

En attendant, si quelqu'un a une autre idée...

[Rayek]

A toi de faire en sorte de la créer le moins souvent possible.

Genre pour la fonction RTF_to_TextOnly(RTF:string):string;

tu rajoute une variable

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

function  RTF_To_Text(Rich : TRichEdit;RTF :String) : String;

En clair

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
Rich := TRichEdit.Create(UneForm);
try
// traitement
MonText := RTF_TO_Text (Rich,RTF);
// Traitement
finally
  Rich.free;
end;

Gain de temps et de mémoire (une seule création de richedit).

Solution possible comme tant d'autre

[LadyWasky]

Bon, pour l'instant je vais faire comme ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
function TForm1.RTFtoText(const RTF: string): string;
var
  Stream: TStringStream;
begin
  Result := EmptyStr;
  Stream := TStringStream.Create(RTF);
  try
    with TRichEdit.Create(Self) do
    try
      Parent := Self;
      PlainText:=False;
      Lines.LoadFromStream(Stream);
      PlainText:=True;
      Result := Lines.Text;
    finally
      Free;
    end;
  finally
    Stream.Free;
  end;
end;

En attendant qu'une muse inspiratrice du Forum, ou moi-même, trouve un moyen de zapper le TRichEdit...

[LadyWasky]

Ca y'est, j'ai fini par trouver ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
function RTFToText(RTF: String): string;
 
var
  n,i,x:Integer;
  GetCode:Boolean;
  Code:String;
  ThisChar,LastChar:Char;
  Group:Integer;
  Skip:Boolean;
 
procedure ProcessCode;
 
begin
  if Code='\par' then
    begin
      inc(i);
      Result[i]:=#13;
    end
  else
    begin
      if Code='\tab' then
        begin
          inc(i);
          Result[i]:=#9;
        end;
    end;
end;
 
begin
  try
    // length is always shorter
    n:=Length(RTF);
    i:=0;
    SetLength(Result,n);
 
    // are we getting a code?
    GetCode:=FALSE;
    // indent level of curlies
    Group:=0;
    // allow for excaped characters
    LastChar:=#0;
    // parse each character
    for x:=1 to n do
      begin
        Skip:=FALSE;
        ThisChar:=RTF[x];
        case ThisChar of
          '{':
            if LastChar<>'\' then
              begin // Curly start
                inc(Group);
                skip:=TRUE;
              end
            else
              GetCode:=FALSE;
          '}':
            if LastChar<>'\' then
              begin // Curly end
                dec(Group);
                skip:=TRUE;
              end
            else
              GetCode:=FALSE;
          '\':
            if LastChar<>'\' then
              begin // Code start
                if GetCode then ProcessCode;
                Code:='';
                GetCode:=TRUE;
              end
            else
              GetCode:=FALSE;
          ' ':
            begin
              if GetCode then
                begin
                  ProcessCode;
                  GetCode:=FALSE;
                  skip:=TRUE;
                end;
            end;
          #10, #13:
            begin
              if Group>0 then
                skip:=TRUE;
            end;
        end;
        if GetCode then
          begin
            Code:=Code+ThisChar;
          end
        else
          begin
            if (not Skip) and (Group <= 1) then
              begin
                inc(i);
                result[i]:=ThisChar;
              end;
          end;
        LastChar:=ThisChar;
      end;
    SetLength(Result,i);
    // remove trailing spaces and cr/lf
    n:=Length(Result);
    while ((n>0) and (Result[n]<' ')) do
      dec(n);
    if n>0 then
      SetLength(Result,n);
  except
    on e:exception do
  end;
end;

Je peux vous assurer que ça n'a pas été une mince affaire !


Ca marche nickel et c'est plutot rapide.

[LadyWasky]

Pour ceux qui sont intéressés, j'ai amélioré le code de la fonction :

Utilisation de la fonction :
ReplaceLineFeedWithSpace :
Avec False, celà remplacera les retour à la ligne avec aucun caractère, si vous avez plusieurs lignes dans le RTF, celle-ci sembleront collées les unes aux autres.
Avec True : un espace sera inséré.

DoTrimLeft:
Avec True : Supprime les espace et caractères de contrôles en début de chaîne.

TrailAfter:
Avec TrailAfter>0 : Si la chaîne résultante est plus longue que TrailAfter, cette dernière est coupée, et trois petits points sont rajoutés. Donc attention, la longueur de la chaîne en retour sera égale à TrailAfter+3 !
Avec TrailAfter=0 ou -1 : Sans effet.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
function RTFtoText(const RTF: string;ReplaceLineFeedWithSpace,DoTrimLeft:Boolean;TrailAfter:integer): string;
var
  n,i,x:Integer;
  GetCode:Boolean;
  Code:String;
  ThisChar,LastChar:Char;
  Group:Integer;
  Skip:Boolean;
 
procedure ProcessCode;
begin
  if Code='\par' then
    begin
      inc(i);
      Result[i]:=#13;
    end
  else
    begin
      if Code='\tab' then
        begin
          inc(i);
          Result[i]:=#9;
        end;
    end;
end;
 
begin
  try
    // length is always shorter
    n:=Length(RTF);
    i:=0;
    SetLength(Result,n);
 
    // are we getting a code?
    GetCode:=FALSE;
    // indent level of curlies
    Group:=0;
    // allow for excaped characters
    LastChar:=#0;
    // parse each character
    for x:=1 to n do
      begin
        Skip:=FALSE;
        ThisChar:=RTF[x];
        case ThisChar of
          '{':
            if LastChar<>'\' then
              begin // Curly start
                inc(Group);
                skip:=TRUE;
              end
            else
              GetCode:=FALSE;
          '}':
            if LastChar<>'\' then
              begin // Curly end
                dec(Group);
                skip:=TRUE;
              end
            else
              GetCode:=FALSE;
          '\':
            if LastChar<>'\' then
              begin // Code start
                if GetCode then ProcessCode;
                Code:='';
                GetCode:=TRUE;
              end
            else
              GetCode:=FALSE;
          ' ':
            begin
              if GetCode then
                begin
                  ProcessCode;
                  GetCode:=FALSE;
                  skip:=TRUE;
                end;
            end;
          #10:
            begin
              if Group>0 then
              begin
                if ReplaceLineFeedWithSpace then
                begin
                  Inc(i);
                  result[i]:=' ';
                end;
                skip:=TRUE;
              end;
            end;
          #13:
            begin
              if Group>0 then
              begin
                skip:=TRUE;
              end;
            end;
        end;
        if GetCode then
          begin
            Code:=Code+ThisChar;
          end
        else
          begin
            if (not Skip) and (Group <= 1) then
              begin
                inc(i);
                result[i]:=ThisChar;
              end;
          end;
        LastChar:=ThisChar;
      end;
    SetLength(Result,i);
    // remove trailing spaces and cr/lf
    n:=Length(Result);
    while ((n>0) and (Result[n]<' ')) do
      dec(n);
    if n>0 then
      SetLength(Result,n);
 
    if DoTrimLeft then
    begin
      i := Length(Result);
      n := 1;
      while (n <= i) and (Result[n] <= ' ') do Inc(n);
      Result := Copy(Result, n, Maxint);
    end;
    result:=TrimLeft(Result);
 
    if TrailAfter>0 then
    begin
      if Length(Result)>TrailAfter then
      begin
        SetLength(Result,TrailAfter);
        result:=result+'...';
      end;
    end;
  except
    on e:exception do
  end;
end;

[/u]

[Bruno13]

Bonjour Waskol,

j'étais justement en train de chercher une fonction RTF2Str, et voilà que je trouve ton Post Que du bonheur !!!

Merci encore !

PS : je ne connais rien au format RTF, mais comment puis récupèrer (si elles existent biensur ) des informations ET sur le document ET dans le document ? du genre Auteur, Commentaire ET/OU Titre ?

D'avance merci

Bruno

[LadyWasky]

Salut Bruno13,

En fait je n'ai jamais vu ces champs d'info dans un fichier RTF, à part un petit laïus du style (regarde dans mon premier post) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

\*\generator Msftedit 5.41.15.1503

Peut-être existent-ils des descripteurs de champ RTF intitulés "author/" par exemple, c'est possible, je n'y ai jamais vraiment prêté attention.

Ce qu'il faudrait que tu fasses, c'est d'aller jeter un oeil sur la documentation qui décrit la structure d'un fichier RTF (qui est en fait fichier texte avec des balises spéciales de mise en forme, un peu à la manière d'un fichier html).
Pour ce faire, tu devrais trouver la description du format .rtf sur http://www.wotsit.org.

Bon courage.

[LadyWasky]

Voici le code de la fonction magique mis à jour pour qu'elle prenne aussi les caractères accentués :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
 
function RTFtoText(const RTF: string;ReplaceLineFeedWithSpace,DoTrimLeft:Boolean;TrailAfter:integer): string;
var
  n,i,x:Integer;
  GetCode:Boolean;
  Code:String;
  ThisChar,LastChar:Char;
  Group:Integer;
  Skip:Boolean;
 
procedure ProcessCode;
begin
  if ThisChar in ['\',' ',#13,#10] then
  begin
    if (Code='\par') or (Code='\line') or (Code='\pard') then
      begin
        if ReplaceLineFeedWithSpace
        then Result:=Result+' '
        else Result:=Result+#13#10;
        GetCode:=FALSE;
        skip:=TRUE;
      end;
    if Code='\tab' then
    begin
      Result:=Result+#9;
      GetCode:=FALSE;
      skip:=TRUE;
    end;
  end;
  if ((Length(Code)=4) and ((Code[1]+code[2])='\''')) then
  begin
    Result:=Result+Chr(strtoint('$'+code[3]+code[4]));
    GetCode:=FALSE;
    skip:=TRUE;
  end;
end;
 
begin
  try
    // length is always shorter
    n:=Length(RTF);
    Result:='';
 
    // are we getting a code?
    GetCode:=FALSE;
    // indent level of curlies
    Group:=0;
    // allow for escaped characters
    LastChar:=#0;
    // parse each character
    x:=1;
    while x<=n do
      begin
        Skip:=FALSE;
        ThisChar:=RTF[x];
        case ThisChar of
          '{':if LastChar<>'\'
              then begin // Curly start
                     inc(Group);
                     skip:=TRUE;
                   end
              else GetCode:=FALSE;
          '}':if LastChar<>'\'
              then begin // Curly end
                     dec(Group);
                     skip:=TRUE;
                   end
              else GetCode:=FALSE;
          '\':if LastChar<>'\'
              then begin // Code start
                     if GetCode then ProcessCode;
                     Code:='';
                     GetCode:=TRUE;
                   end
              else GetCode:=FALSE;
          ' ':begin
                if GetCode then
                begin
                  ProcessCode;
                  GetCode:=FALSE;
                  skip:=TRUE;
                end;
            end;
 
          #10:
            begin
              if GetCode then
                begin
                  ProcessCode;
                  GetCode:=FALSE;
                  skip:=TRUE;
                end;
              if Group>0 then
              begin
                skip:=TRUE;
              end;
            end;
          #13:
            begin
              if GetCode then
                begin
                  ProcessCode;
                  GetCode:=FALSE;
                  skip:=TRUE;
                end;
              if Group>0 then
              begin
                skip:=TRUE;
              end;
            end;
        end;
        if not GetCode then
          begin
            if (not Skip) and (Group <= 1) then
            Result:=Result+ThisChar;
          end
        else begin
            Code:=Code+ThisChar;
            ProcessCode;
          end;
        LastChar:=ThisChar;
        Inc(x,1);
      end;
 
    // remove trailing spaces and cr/lf
    n:=Length(Result);
    while ((n>0) and (Result[n]<' ')) do
      dec(n);
    if n>0 then
      SetLength(Result,n);
 
    if DoTrimLeft then
    begin
      i := Length(Result);
      n := 1;
      while (n <= i) and (Result[n] <= ' ') do Inc(n);
      Result := Copy(Result, n, Maxint);
    end;
    result:=TrimLeft(Result);
 
    if TrailAfter>0 then
    begin
      if Length(Result)>TrailAfter then
      begin
        SetLength(Result,TrailAfter);
        result:=result+'...';
      end;
    end;
  except
    on e:exception do
  end;
end;

[Bruno13]

Salut Waskol,

j'ai essayé à peine cette nuit ta fonction (aussi bien l'ancienne que la nouvelle) avec les fichiers que j'ai récupéré en faisant la requete suivante sur Google :

mannina +filetype:rtf

je sauvegarde une dizaine de fichier RTF sur mon disque, je stoque un par un les fichiers RTF dans une String RTF et je fais :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

s:=RtfToTxt(RTF, True, True, 0);

Et je m'apercois que s est tout le temps vide alors ma variable RTF contient bien le fichier en cours

Peux tu me dire ce que j'ai fait de mal j'ai fait les essais sur une dizaine de fichiers RTF pris au hasard.

Merci bcp pour ton aide.

Amitiés,
Bruno

[Pedro]

Et je m'apercois que s est tout le temps vide alors ma variable RTF contient bien le fichier en cours

Le nom du fichier ou bien son contenu? Parce que visiblement, c'est le contenu de ce fichier qu'il faut passer en paramètre

[Bruno13]

Salut Pedro,

La variable RTF contient le contenu, et s normalement doit contenir la conversion RTFtoTXT mais hélas toujours vide.

Bruno

[Bruno13]

Je pense que mon probleme ne vient pas de RTFToTxt mais de ma maniere de procéder pour la lecture du fichier RTF. En fait j'utilise un Stream pour lire le fichier et j'affecte un PChar de cette maniere :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
      Buffer : Pchar;
      RTF : String;
      s : String;
      ....
      Buffer:=TMemoryStream(Stream).Memory;
      ....
      // et plus loin je fais :
      RTF:=Buffer;
      ....
      s:=RTFToTXT(RTF, True, True, 0);
      ....

J'utilise cette methode tout simplement parce que j'essaie d'implementer cette fonction directement dans mon programme qui se sert d'un composant HTTP qui rempli mon Buffer.

En mode Pas à Pas lorsque je passe ma souris sur la valeur de Buffer, je n'ai pas tout le fichier qui s'affiche (alors que le chargement est complert biensûr !), par contre si je fais un showmessage(RTF) il semble que j'ai tout mon fichier RTF.

Kkun pour me venir en aide, please.

Amitiés,
Bruno

[LadyWasky]

Houla !!!!!!!!

Dans le paramètre RTF, il faut mettre TOUT le contenu texte du fichier RTF;

Bref, tu télécharge ton fichier RTF, tu le charges avec un TStringList, et tu passes la propriété Texte du TStringList dans la fonction.

Bref, ça ne marche pas petitit bout par petit bout

[Bruno13]

Salut Waskol,

j'aimerai juste comprendre ce que tu me dis, pourtant lorsque je fais un showmessage de RTF j'ai bien mon fichier (certes avec des caractéres bizarres) entier en visu.

A ma disposition je n'ai QUE Buffer (PChar) comme variable contenant le fichier qui vient d'être téléchargé. Comment, si je pars du principe que RTF ne contient pas la totalité du fichier, puis-je lui faire contenir mon fichier entier ?

Merci pour ton aide.

Amicalement,
Bruno

[LadyWasky]

Salut Waskol,

j'aimerai juste comprendre ce que tu me dis, pourtant lorsque je fais un showmessage de RTF j'ai bien mon fichier (certes avec des caractéres bizarres) entier en visu.

A ma disposition je n'ai QUE Buffer (PChar) comme variable contenant le fichier qui vient d'être téléchargé. Comment, si je pars du principe que RTF ne contient pas la totalité du fichier, puis-je lui faire contenir mon fichier entier ?

Merci pour ton aide.

Amicalement,
Bruno

Excuses moi, j'ai aussi m... dans mes explication, j'avais pas compris ton code...

Mais, ça, c'est pas bon du tout, mais alors, pas du tout :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Buffer:=TMemoryStream(Stream).Memory;
      ....
      // et plus loin je fais :
      RTF:=Buffer;

ça m'a l'air assez cavalier ton histoire

Voici ce que je te propose à la place (au fait Stream, c'est de quel type ? ) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
var Buffer:TStringList;
...
Buffer:=TStringList.create;
Buffer.Lines.LoadFromStream(Stream);
RTF:=Buffer.Text;
s:=RTFToTXT(RTF, True, True, 0);
Buffer.Free;

Est-ce que ça marche mieux ?

Sinon, qu'entend tu par là ?

certes avec des caractéres bizarres

[Bruno13]

Salut Waskol,

Hélas ce la ne fonctionne pas, tout mes fichiers transformés on des tailles de 1 ko avec des caractéres non alpha-numériques du style #9 etc...

Je commence à douter de la maniere donc je recupere le contenu de Stream
Il semble que ce qui est dessous ne prenne pas en compte la totalité de du fichier récupèré, en mettant un point d'arret sur slRTF.Text je n'est pas tout le contenu du fichier RTF.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
slRTF:=TStringList.create;
Try
   slRTF.LoadFromStream(Stream);
   RTF:=slRTF.Text;
   s:=RTFtoText(RTF, True, True, 0);
Finally
   slRTF.Free;
End;

et pour vérifier que j'ai bien mon fichier RTF, juste au dessous je fais :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
F:=TFileStream.Create(Path+'\rtf\'+Hash+'.'+Extension, fmCreate);
try
  F.CopyFrom(Stream, 0);
finally
  F.Free;
end;

et j'ai bien mon fichier RTF en entier.


Arrrggghh, j'comprends pas !!


Bruno

[LadyWasky]

Je commence à douter de la maniere donc je recupere le contenu de Stream

hmm, je pense avoir compris...
As-Tu pensé à faire ça ? (c'est à dire à "rembobiner" le stream)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Stream.position:=0;

juste avant ceci ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
slRTF:=TStringList.create;
Try
   slRTF.LoadFromStream(Stream);
   RTF:=slRTF.Text;
   s:=RTFtoText(RTF, True, True, 0);
Finally
   slRTF.Free;
End;

[Bruno13]

Hélas toujours pas, d'ailleurs j'y avais pensé à faire cela mais en voyant qu'en fait j'avais uniquement le debut du fichier avec un point d'arret sur sl.RTL.Text
je me suis dit assez rapidement que le problème ne venait pas de là.

C'est à se rendre fou !

Est-ce qu'un Stream à une taille limitée ? parce que quelque soit le fichi_er RTF qui est chargé je ne vois que les 10 à 15 premieres lignes, peut etre une piste ??

En tout cas merci pour ton aide, car là moi je séche !

Amitiés,
Bruno