FAQ DelphiConsultez toutes les FAQ

Nombre d'auteurs : 119, nombre de questions : 909, dernière mise à jour : 22 décembre 2016  Ajouter une question

 

Cette FAQ a été réalisée à partir des questions fréquemment posées sur les forums Delphi et Delphi et bases de données de www.developpez.com et de l'expérience personnelle des auteurs.

Nous tenons à souligner que cette FAQ ne garantit en aucun cas que les informations qu'elle propose soient correctes. Les auteurs font le maximum, mais l'erreur est humaine. Cette FAQ ne prétend pas non plus être complète. Si vous souhaitez y apporter des corrections ou la compléter, contactez un responsable (lien au bas de cette page).

Nous espérons que cette FAQ saura répondre à vos attentes. Nous vous en souhaitons une bonne lecture.

L'équipe Delphi de Developpez.com.

Commentez


SommaireLangageTypes de donnéesChaînes de caractères (16)
précédent sommaire suivant
 

Il faut utiliser la fonction Length, qui permet de connaître le nombre de caractères qui composent une chaîne ou le nombre d'éléments d'un tableau.

Exemple :

Code delphi : Sélectionner tout
1
2
3
4
5
6
var 
  Longueur: Integer; 
begin 
  Longueur := Length('Hello World'); { 11 } 
  { Reste du code } 
end;

Mis à jour le 18 octobre 2013 Smortex

On peut accéder à chaque caractère d'une chaîne en indiquant entre crochets l'index du caractère que l'on souhaite récupérer.

  • le premier caractère a l'index 1 et non pas 0 ;
  • il ne faut pas dépasser la longueur de la chaîne sous peine de violation d'accès.

Exemple :
Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
var 
  S: String; 
  C: Char; 
begin 
  S := 'Hello World'; 
  C := S[7]; { 'W' } 
  { Reste du code } 
end;

Mis à jour le 18 octobre 2013 Smortex

Convertir une variable String en Char se fait très simplement en accédant au premier caractère de la chaîne :

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
var 
  S: String; 
  C: Char; 
begin 
  S := 'A'; 
  C := S[1]; { C = 'A', C étant de type Char } 
end;

Mis à jour le 18 octobre 2013 Smortex

Pour rechercher une chaîne dans une autre, il faut utiliser la fonction Pos :

Code delphi : Sélectionner tout
Function Pos (Substr : String; S : String) : Integer;
Cette fonction retourne la position de la première occurrence de Substr dans S.
Code delphi : Sélectionner tout
Pos('CD','ABCDEF'); { retourne 3 }

Depuis Delphi 7, il est possible de rechercher une chaîne à partir d'une position donnée : il suffit d'utiliser la fonction PosEx :
Code delphi : Sélectionner tout
Function PosEx (const SubStr, S : String; Offset : Cardinal = 1) : Integer;
Cette fonction est très pratique pour chercher les occurrences suivantes d'une sous chaîne.

Voici un exemple d'utilisation ; cette fonction compte le nombre d'occurrences d'une sous-chaîne dans une chaîne :
Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
Function Compte(Const SubStr:String;Const s:String):Integer; 
Var i:Integer; 
begin 
  Result:=0; 
  i:=0; 
  Repeat 
    i:=PosEx(SubStr,s,i+1); 
    If i<>0 Then 
      Inc(Result); 
  Until i=0; 
End;

Mis à jour le 18 octobre 2013 Nono40

Pour remplacer toutes les occurrences d'une chaîne par une autre dans une chaîne, il faut utiliser la fonction AnsiReplaceStr (const AText, AFromText, AToText : String) : String. Cette fonction remplace toutes les occurrences de AFromText par AToText dans la chaîne AText. AnsiReplaceStr est sensible à la casse. Pour ne pas en tenir compte, utilisez plutôt AnsiReplaceText.

Code delphi : Sélectionner tout
1
2
3
4
5
AnsiReplaceStr('ABCGHABKJABFab','AB','XX') 
{ retourne 'XXCGHabKJXXFab' } 
  
AnsiReplaceText('ABCGHABKJABFab','AB','XX') 
{ retourne 'XXCGHXXKJXXFXX' }
Ces fonctions sont utilisables avec Delphi 6 et supérieur.

Mis à jour le 18 octobre 2013 Nono40

L'objectif de cette procédure est d'extraire les mots qui se trouvent dans une chaîne (String) pour les placer dans une liste de chaînes (TStrings), comme la fonction explode de PHP. Les caractères qui servent à séparer les mots sont passés à la procédure.

Exemples d'utilisation :

Code delphi : Sélectionner tout
1
2
extraireMots(Edit1.Text,memo1.Lines);  
extraireMots(Edit1.Text,memo1.Lines,true,[' ',',','.',';']);

Cette procédure est relativement performante, puisque la chaîne initiale n'est parcourue qu'une seule fois.
Code delphi : Sélectionner tout
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
procedure extraireMots(s : string; into : TStrings; 
viderListe : boolean = false; sep : TSysCharSet = [' ', ',']);  
var  
  i, n : integer;  
  currentWord : string;  
begin  
  if viderListe then 
    into.Clear; 
  n := length(s);  
  i := 1;  
  while (i <= n) do  
  begin  
    currentWord := '';  
    { on saute les séparateurs  } 
    while (i <= n) and (s[i] in sep) do  
      inc(i);  
    { récupération du mot courant  } 
    while (i <= n) and not (s[i] in sep) do  
    begin  
      currentWord := currentWord + s[i]; 
      inc(i);  
    end;  
    if (currentWord <> '') then  
      into.Add(currentWord);  
  end;  
end;

Mis à jour le 18 octobre 2013 Bloon

Le type string n'est pas limité en longueur (enfin si, mais limité à 4 Go), par contre il n'est pas possible de saisir dans le source des chaînes de plus de 255 caractères. Ceci provoque une erreur de compilation "Les chaînes ne doivent pas dépasser 255 caractères".

Pour palier ce problème, il faut saisir dans le source la chaîne en plusieurs fois :

Code delphi : Sélectionner tout
1
2
3
4
5
Memo1.Text:='Ceci est un texte vraiment long qui ne tiens par sur une ligne,' 
           +' mais quelle idée aussi de saisir un texte comme cela alors que ' 
           +'la ligne ne tiens même pas dans l''éditeur et qu''il faut ' 
           +'utiliser les barres de défilement horizontales pour le lire ' 
           +'en entier ! Non mais bon sang de bon soir !';

Mis à jour le 19 janvier 2014 Nono40

L'ajout d'une apostrophe dans une chaine de caractères se fait par la duplication du caractère « ' ».

Code delphi : Sélectionner tout
1
2
3
4
Const Chaine='Ceci '' est une apostrophe. Et c''est tout.';  
begin  
 showmessage(Chaine)  
end;
Affiche la chaîne
Ceci ' est une apostrophe. Et c'est tout.

Mis à jour le 19 janvier 2014 Laurent Dardenne

Windows fournit une fonction permettant de convertir une chaîne contenant des caractères DOS en chaîne contenant leur équivalent en caractères Windows.

Code delphi : Sélectionner tout
1
2
3
4
5
function DosStrToWinStr(Const StrDos: String): String; 
begin 
  SetLength(Result, Length(StrDos)); 
  OemToCharBuff(pChar(StrDos),@Result[1],Length(StrDos)); 
end;
Pour utiliser les caractères étendus, il faut adapter la fonction aux chaînes WideString :
Code delphi : Sélectionner tout
1
2
3
4
5
function DosStrToWinStrW(Const StrDos: String): WideString; 
begin 
  SetLength(Result,Length(StrDos)); 
  OemToCharBuffW(pChar(StrDos),@Result[1],Length(StrDos)); 
end;

Mis à jour le 19 janvier 2014 Nono40

Étant donné que la structure Case Of requiert une donnée de type ordinal, il est impossible de faire un Case Of directement avec des String.
L'astuce consiste à utiliser la fonction AnsiIndexStr de l'unité StrUtils :

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
uses StrUtils; 
... 
case AnsiIndexStr(Str, ['Chaîne1', 'Chaîne2', 'Chaîne3']) of 
  0 : // Str = 'Chaîne1' 
  1 : // Str = 'Chaîne2' 
  2 : // Str = 'Chaîne3' 
  -1 : // Str ne vaut aucune de ces trois chaînes 
end;
Si votre version de Delphi ne propose pas cette fonction, elle peut être implémentée comme suit :
Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
function AnsiIndexStr(AText : string; const AValues : array of string) : integer; 
begin 
  Result := 0; 
  while Result <= High(AValues) do 
    if AValues[Result] = AText then exit 
    else inc(Result); 
  Result := -1; 
end;
Une autre idée, dans le cas d'un Case Of dynamique, est d'utiliser un objet de type TStrings et sa méthode IndexOf

Mis à jour le 19 janvier 2014 sjrd

Il faut écrire une fonction qui remplace les caractères spéciaux par leur équivalent HTML :

Code delphi : Sélectionner tout
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
function filtreHTML(const s : string) : string; 
var 
  i : integer; 
begin 
  result := ''; 
  for i := 1 to length(s) do 
  begin 
    case s[i] of 
      '&' : result := result +  '&'; 
      '<' : result := result +  '<'; 
      '>' : result := result +  '>'; 
      '"' : result := result +  '"'; 
      '™' : result := result +  '&trade;'; 
      '©' : result := result +  '&copy;'; 
      '®' : result := result +  '&reg;'; 
      'À' : result := result +  '&Agrave;'; 
      'Á' : result := result +  '&Aacute;'; 
      'Â' : result := result +  '&Acirc;'; 
      'Ã' : result := result +  '&Atilde;'; 
      'Ä' : result := result +  '&Auml;'; 
      'Å' : result := result +  '&Aring;'; 
      'Æ' : result := result +  '&AElig;'; 
      'Ç' : result := result +  '&Ccedil;'; 
      'È' : result := result +  '&Egrave;'; 
      'É' : result := result +  '&Eacute;'; 
      'Ê' : result := result +  '&Ecirc;'; 
      'Ë' : result := result +  '&Euml;'; 
      'Ì' : result := result +  '&Igrave;'; 
      'Í' : result := result +  '&Iacute;'; 
      'Î' : result := result +  '&Icirc;'; 
      'Ï' : result := result +  '&Iuml;'; 
      'Ð' : result := result +  '&ETH;'; 
      'Ñ' : result := result +  '&Ntilde;'; 
      'Ò' : result := result +  '&Ograve;'; 
      'Ó' : result := result +  '&Oacute;'; 
      'Ô' : result := result +  '&Ocirc;'; 
      'Õ' : result := result +  '&Otilde;'; 
      'Ö' : result := result +  '&Ouml;'; 
      'Ø' : result := result +  '&Oslash;'; 
      'Ù' : result := result +  '&Ugrave;'; 
      'Ú' : result := result +  '&Uacute;'; 
      'Û' : result := result +  '&Ucirc;'; 
      'Ü' : result := result +  '&Uuml;'; 
      'Ý' : result := result +  '&Yacute;'; 
      'Þ' : result := result +  '&THORN;'; 
      'ß' : result := result +  '&szlig;'; 
      'à' : result := result +  '&agrave;'; 
      'á' : result := result +  '&aacute;'; 
      'â' : result := result +  '&acirc;'; 
      'ã' : result := result +  '&atilde;'; 
      'ä' : result := result +  '&auml;'; 
      'å' : result := result +  '&aring;'; 
      'æ' : result := result +  '&aelig;'; 
      'ç' : result := result +  '&ccedil;'; 
      'è' : result := result +  '&egrave;'; 
      'é' : result := result +  '&eacute;'; 
      'ê' : result := result +  '&ecirc;'; 
      'ë' : result := result +  '&euml;'; 
      'ì' : result := result +  '&igrave;'; 
      'í' : result := result +  '&iacute;'; 
      'î' : result := result +  '&icirc;'; 
      'ï' : result := result +  '&iuml;'; 
      'ð' : result := result +  '&eth;'; 
      'ñ' : result := result +  '&ntilde;'; 
      'ò' : result := result +  '&ograve;'; 
      'ó' : result := result +  '&oacute;'; 
      'ô' : result := result +  '&ocirc;'; 
      'õ' : result := result +  '&otilde;'; 
      'ö' : result := result +  '&ouml;'; 
      'ø' : result := result +  '&oslash;'; 
      'ù' : result := result +  '&ugrave;'; 
      'ú' : result := result +  '&uacute;'; 
      'û' : result := result +  '&ucirc;'; 
      'ü' : result := result +  '&uuml;'; 
      'ý' : result := result +  '&yacute;'; 
      'þ' : result := result +  '&thorn;'; 
      'ÿ' : result := result +  '&yuml;'; 
      '¡' : result := result +  '&iexcl;'; 
      '¢' : result := result +  '&cent;'; 
      '£' : result := result +  '&pound;'; 
      '¤' : result := result +  '&curren;'; 
      '¥' : result := result +  '&yen;'; 
      '¦' : result := result +  '&brvbar;'; 
      '§' : result := result +  '&sect;'; 
      '¨' : result := result +  '&uml;'; 
      'ª' : result := result +  '&ordf;'; 
      '«' : result := result +  '&laquo;'; 
      '¬' : result := result +  '&shy;'; 
      '¯' : result := result +  '&macr;'; 
      '°' : result := result +  '&deg;'; 
      '±' : result := result +  '&plusmn;'; 
      '²' : result := result +  '&sup2;'; 
      '³' : result := result +  '&sup3;'; 
      '´' : result := result +  '&acute;'; 
      'µ' : result := result +  '&micro;'; 
      '·' : result := result +  '&middot;'; 
      '¸' : result := result +  '&cedil;'; 
      '¹' : result := result +  '&sup1;'; 
      'º' : result := result +  '&ordm;'; 
      '»' : result := result +  '&raquo;'; 
      '¼' : result := result +  '&frac14;'; 
      '½' : result := result +  '&frac12;'; 
      '¾' : result := result +  '&frac34;'; 
      '¿' : result := result +  '&iquest;'; 
      '×' : result := result +  '&times;'; 
      '÷' : result := result +  '&divide;'; 
      '€' : result := result +  '&euro;'; 
      else result := result + s[i]; 
    end; 
  end; 
end;

Mis à jour le 19 janvier 2014 Bloon

On peut parfois avoir besoin de convertir une taille (de fichier, de dossiers…) en une chaîne plus parlante pour l'utilisateur.
Voici une possibilité d'implémentation, qui affiche la taille dans son unité la plus proche :

Code delphi : Sélectionner tout
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
function SizeToStr(Sz: int64): string; 
resourcestring 
  strMinSize = '0 Octets'; 
  strKo = '%s Ko'; 
  strMo = '%s Mo'; 
  strGo = '%s Go'; 
  strOct = '%s Octets'; 
const 
  cstFloatFmt = '#.##'; 
  cstOneKo = 1024; 
  cstOneMo = cstOneKo * 1024; 
  cstOneGo = cstOneMo * 1024; 
begin 
  Result := strMinSize; 
  if (Sz = 0) then 
    Exit; 
  if (Sz <= cstOneKo) then 
  begin 
    Result := Format(strOct, [FormatFloat(cstFloatFmt, Sz)]); 
    Exit; 
  end; 
  if (Sz <= cstOneMo) then 
  begin 
    Result := Format(strKo, [FormatFloat(cstFloatFmt, Sz / cstOneKo)]); 
    Exit; 
  end; 
  if (Sz <= cstOneGo) then 
  begin 
    Result := Format(strMo, [FormatFloat(cstFloatFmt, Sz / (cstOneMo))]); 
    Exit; 
  end; 
  Result := Format(strGo, [FormatFloat(cstFloatFmt, Sz / (cstOneGo))]); 
end;

Mis à jour le 19 janvier 2014 Reisubar

Les fichiers textes de Windows, Macintosh et Unix diffèrent par leurs fins de ligne.

  • Sur Mac, le passage à la ligne se fait par le caractère CR (#13),
  • sous Windows, il se fait par le caractère CR+LF (#13+#10),
  • et sous Unix, par le caractère LF (#10).

Il en résulte que la récupération d'un fichier texte Mac ou Linux en utilisant l'instruction ReadLn se solde par un échec.
Voici une méthode pour convertir un fichier vers un des trois formats. Cette variante utilise un TStringList car sa méthode LoadFromFile reconnaît les types de fichiers.
Code delphi : Sélectionner tout
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
type  TTextFileFormat = (tfWINDOWS, tfUNIX, tfMAC); 
  
// Convertir un fichier texte vers le format désiré 
// cette variante utilise un TStringList 
  
function ConvertTextFile(const InputFileName, OutputFilename: string; 
                         const OutputFormat: TTextFileFormat): boolean; 
  
var 
  FI: File; 
  FO  : TextFile; 
  ENDL: string;   // fin de ligne 
  ALine: string; 
  i,j: integer; 
begin 
  Result:=False; 
  if Not(FileExists(InputFileName)) then Exit; 
  case OutputFormat of 
    tfWINDOWS: ENDL:=#13+#10; 
    tfUNIX   : ENDL:=#10; 
    tfMAC    : ENDL:=#13; 
  end; 
  with TStringList.Create do begin 
  try 
    Clear; 
    LoadFromFile(InputFileName); 
    AssignFile(FO, OutputFilename); 
    ReWrite(FO); 
    try 
      try 
        for i:=0 to Count-1 do begin 
          ALine:=Trim(Strings[i])+ENDL; 
          Write(FO, ALine); 
        end; 
        Result:=True; 
      except 
      end; 
    finally 
      CloseFile(FO); 
    end; 
  finally // with TStringList 
    Clear; 
    Free; 
  end; 
  end; 
end;

Mis à jour le 19 janvier 2014 pipistrelle

Le code suivant permet de récupérer la largeur et la hauteur en pixel d'un texte.
La fonction supporte du texte multiligne et renvoie la largeur de la plus longue ligne, et la hauteur du tout.

Le principe est d'utiliser les fonctionnalités du Canvas d'un TBitmap pour récupérer les tailles du texte.

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Function TextSize(Phrase : string; Police : TFont = nil) : TPoint;  
var  
  DC: HDC;  
  Rect: TRect;  
  C : TBitmap;  
begin  
  C := TBitmap.create;  
  if police <> nil then  C.canvas.Font := police;  
  
    Rect.Left := 0;  
    Rect.Top:=0;  
    Rect.Right:=0;  
    Rect.Bottom:=0;  
    DC := GetDC(0);  
    C.Canvas.Handle := DC;  
    DrawText(C.Canvas.Handle, PChar(Phrase), Length(Phrase), Rect, (DT_EXPANDTABS or DT_CALCRECT));  
    C.Canvas.Handle := 0;  
    ReleaseDC(0, DC);  
    result.X:=Rect.Right-Rect.Left;  
    result.Y:=Rect.Bottom-Rect.Top;  
    C.Free;  
end;

Mis à jour le 19 janvier 2014 LadyWasky

Il peut être intéressant dans certains cas de pouvoir convertir un texte contenant des formats RTF en texte brut, sans aucune marque de formatage.
Par exemple, transformer ceci :

Code other : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
{\rtf1\ansi\ansicpg1252\deff0\deflang1036{\fonttbl{\f0\fswiss\fcharset0 Arial;} 
{\f1\fmodern\fprq1\fcharset0 Courier New;}}  
{\colortbl ;\red0\green255\blue0;\red255\green0\blue0;\red0\green0\blue128;}  
{\*\generator Msftedit 5.41.15.1503;}\viewkind4\uc1\pard\qc\f0\fs32 A la \cf1 p\'eache \cf0 aux moules\par  
jkhjkhhkkhj\par  
du Ma\'efs des \'e9pis de bl\'e9\line\ul\b\f1 le caf\'e9\par  
\pard\ulnone\b0\i\f0\fs20 Bonjour tout le monde,\par  
\i0 comment \'e7a va ?\par  
\cf2\b\'e9l\'e9phant \cf3 rhinoc\'e9ros\cf0\b0\par  
\fs32\par  
}
En cela :
Code other : Sélectionner tout
1
2
3
4
5
6
7
8
A la pêche aux moules  
jkhjkhhkkhj  
du Maïs des épis de blé  
le café  
  
Bonjour tout le monde,  
comment ça va ?  
éléphant rhinocéros
La plupart du temps, il est possible et satisfaisant de réaliser cette conversion avec un TRichEdit intermédédiaire comme ceci :
Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
function TForm1.RTFtoText(rtf:string):string;  
var  
  temp_richedit: TRichedit;  
  temp_str: string;  
  ss: TStringStream;  
begin  
  ss := TStringStream.Create(rtf);  
  temp_richedit := TRichEdit.Create(nil);  
  try  
  temp_richedit.Lines.LoadFromStream(ss);  
  result := temp_richedit.Lines.Text;  
  finally  
   ss.free;  
   temp_richedit.Free;  
end;  
end;
Cependant, dans certains cas de figure, d'aucun préfèrerais éviter l'utilisation d'un TRichEdit. Par exemple, cela peut être le cas dans les configurations suivantes :
  • Un champ blob d'une base de données contient du texte formaté que l'on souhaite afficher dans un label par exemple : la création et la destruction d'un grand nombre de composant TRichEdit n'est pas une solution idéale…
  • On souhaite convertir un fichier au format RTF de Word95 (format non supporté par TRichEdit) en fichier texte.

Au passage, il peut être aussi intéressant :
  • de remplacer les passages à la ligne par des espaces.
  • de ne récupérer que les N premiers caractères du résultat

…afin d'afficher tout ceci dans un TLabel ou bien de créer un logiciel de recherche de document et d'en afficher leur contenu à la manière d'un moteur de recherche internet.

Une solution :

Une solution consiste alors à utiliser la fonction suivante :
Code delphi : Sélectionner tout
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
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
function RTFtoText(const RTF: string;ReplaceLineFeedWithSpace,DoTrimLeft:Boolean;TrailAfter:integer): string;  
var  
  //n: Nombre de caractères à traiter à la source  
  //i:index du caractère dans le résultat  
  //    (utilisé après le traitement de la source)  
  //x:index du caractère que l'on traite dans la source (voir ThisChar)  
  n,i,x:Integer;  
  
  //flag iniquant si on est en train de lie un code de formatage  
  //Un code de formatage commence par un Anti-Slash "\" et  
  //considéré comme fini juste avant un autre Anti-slash,  
  //un espace ou un retour à la ligne.  
  GetCode:Boolean;   
  
  //Chaîne dans laquelle on stocke le code de formatage que  
  //l'on est en train de lire  
  Code:String;  
  
  //Caractère que l'on est en train de traiter,  
  //et caractère le précédant  
  ThisChar,LastChar:Char;  
  
  //Niveau de groupe (ou bloc) de format dans lequel on se trouve  
  //un groupe commence par une accolade ouverte "{" et se termine par une accolade fermée "}"  
  Group:Integer;  
  
//Flag indiquant si le caractère Thiscar doit être rejeté (True) ou recopié dans le résultat (False]  
  Skip:Boolean;  
  
procedure ProcessCode;  
begin  
  //Si on vient de terminer la lecture d'un code de formatage  
  if ThisChar in ['\',' ',#13,#10] then  
  begin  
    //si on vient de lire le code de format d'un début de paragraphe  
    //ou celui d'un passage à la ligne...  
    if (Code='\par') or (Code='\line') or (Code='\pard') then  
      begin  
        //#13#10 est le code iutilisé sous Windows  
        //pour coder en ASCII un retour à la ligne  
        if ReplaceLineFeedWithSpace  
        then Result:=Result+' '  
        else Result:=Result+#13#10;  
        GetCode:=FALSE;  
        skip:=TRUE;  
      end;  
    //si on vient de lire le code de format d'une tabulation  
    if Code='\tab' then  
    begin  
      //#9 est le code utilisé sous Windows  
        //pour coder une tabulation en code ASCII  
      Result:=Result+#9;  
      GetCode:=FALSE;  
      skip:=TRUE;  
    end;  
  end;  
  //Un code de format \'xx indique le code ASCII d'un caractère spécial  
  // (lettres accentuées en particulier). xx est ce code en hexadécimal.  
  if ((Length(Code)=4) and ((Code[1]+code[2])='\''')) then  
  begin  
    //on retranscrit le code hexadécimal en code ASCII)  
    Result:=Result+Chr(strtoint('$'+code[3]+code[4]));  
    GetCode:=FALSE;  
    skip:=TRUE;  
  end;  
end;  
  
begin  
  try  
    //Initialisations  
    n:=Length(RTF);  
    Result:='';  
  
    GetCode:=FALSE;  
    Group:=0;  
    LastChar:=#0;  
  
    //Traitement de la source  
    x:=1;  
    while x<=n do  
      begin  
        Skip:=FALSE;  
        ThisChar:=RTF[x];  
        case ThisChar of  
         '{':if LastChar<>'\'  
              then begin  //Début de groupe  
                     inc(Group);  
                     skip:=TRUE;  
                   end  
              else GetCode:=FALSE;  
          '}':if LastChar<>'\'  
              then begin //Fin de groupe  
                     dec(Group);  
                     skip:=TRUE;  
                   end  
              else GetCode:=FALSE;  
          '\':if LastChar<>'\'  
              then begin // Début de Code de format à traiter  
                     if GetCode then ProcessCode;  
                     Code:='';  
                     GetCode:=TRUE;  
                   end  
              else GetCode:=FALSE; //c'était bien le caractère anti-slash  
                                                //(codé en RTF avec deux anti-slashs  
                                               // successifs)  
          ' ':begin  
                if GetCode then  
                begin //fin de Code de format  
                  ProcessCode;  
                  GetCode:=FALSE;  
                  skip:=TRUE;  
                end;  
            end;  
  
          #10:  
            begin  
              if GetCode then  
                begin //fin de Code de format  
                  ProcessCode;  
                  GetCode:=FALSE;  
                  skip:=TRUE;  
                end;  
              //(on est dans un groupe,  
              // on ne recopie pas le "LineFeed")  
              if Group>0 then skip:=TRUE;   
            end;  
          #13:  
            begin  
              if GetCode then  
                begin  
                  ProcessCode;  
                  GetCode:=FALSE;  
                  skip:=TRUE;  
                end;  
              //(on est dans un groupe,  
              // on ne recopie pas le "Retour chariot")  
              if Group>0 then skip:=TRUE;  
            end;  
        end;  
        if not GetCode then  
          begin  
            if (not Skip) and (Group <= 1) then  
            //On a un caractère à recopier dans le résultat du traitement  
            //(du texte brut, pas du format)  
            Result:=Result+ThisChar;  
          end  
        else begin  
            //on lit le code  
            Code:=Code+ThisChar;  
            ProcessCode;  
          end;  
        //Préparation de la boucle suivante  
        LastChar:=ThisChar;  
        Inc(x);  
      end;  
    //Fin du traitement de la source et  
    //Début de traitement du résultat obtenu  
  
    //Suppression des catractères cr/lf et espaces en fin de chaîne  
    n:=Length(Result);  
    while ((n>0) and (Result[n]<' ')) do  
      dec(n);  
    if n>0 then  
      SetLength(Result,n);  
  
    //idem mais pour le début de la chaîne  
    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);  
  
    //césure du texte si l'utilisateur l'à demandé  
    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;
Utilisation de la fonction :
  • ReplaceLineFeedWithSpace :
    Avec True : un espace remplacera les retours à la ligne. Votre texte sera alors affiché sur une seule ligne.
    Avec False, les caractères spéciaux de retour à la ligne seront conservés : vous pourrez ainsi récupérer le texte dans un TMemo via sa propriété Text :
    Code delphi : Sélectionner tout
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    var ASL:TStringList;  
    begin  
      ASL:=TStringList.Create;  
      try  
        ASL.Lines.LoadFromFile('FichierTest.rtf');  
        Memo1.Text:=RTFtoText(ASL.Text,false,False,-1);  
      finally  
        ASL.Free;  
      end;  
    end;
  • 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.

Mis à jour le 19 janvier 2014 LadyWasky

Pour appliquer une texture, dessiner un contour (ou n'importe quelle forme géométrique), il faut procéder en trois étapes :

  1. Avant de dessiner :
    Code delphi : Sélectionner tout
    BeginPath(Canvas.Handle);
  2. Dessiner le texte
  3. Après le dessin :
    Code delphi : Sélectionner tout
    1
    2
    3
    CloseFigure(Canvas.Handle);  
    EndPath(Canvas.Handle);  
    StrokeAndFillPath(Canvas.Handle);

Ci-dessous, nous vous proposons un exemple concret.
Créer une fiche et y déposer un bouton (Le plus à droite possible sur la fiche) et un TOpenPictureDialog, puis copier/coller le code ci-dessous :
Code delphi : Sélectionner tout
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
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
unit Unit1;  
  
interface  
  
uses  
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  
  Dialogs, StdCtrls, ExtDlgs;  
  
type  
  TForm1 = class(TForm)  
    Button1: TButton;  
    OpenPictureDialog1: TOpenPictureDialog;  
    procedure Button1Click(Sender: TObject);  
  private  
    { Déclarations privées }  
  public  
    { Déclarations publiques }  
  end;  
  
var  
  Form1: TForm1;  
  
implementation  
  
{$R *.dfm}  
  
procedure TexteTexture(Texte : string; x,y:integer; Dest : TCanvas);  
// Texte est le texte à écrire  
// x,y : la position où écrire le texte  
// Dest est le Canvas où écrire le texte  
var DC:HDC;  
begin  
  DC:=Dest.Handle;  
  
  //Avant de dessiner le texte  
  BeginPath(DC);  
  
  //Petite préparation...  
  SetBkMode(DC, TRANSPARENT);  
  
  //dessiner le texte  
  Dest.TextOut(x, y, Texte);  
  
  //Après le dessin :  
  EndPath(DC);  
  StrokeAndFillPath(DC);  
  
end;  
  
procedure TForm1.Button1Click(Sender: TObject);  
const TonTexte='Hello World !';  
var oldBrush:TBrush;  
    HauteurTexte:integer;  
  
    //pour le troisième exemple  
    Texture:TBitmap;  
  
    //pour les derniers exemples  
    i,x,y:integer;  
    size:TSize;  
    l:double;  
    MyRgn:HRGN;  
begin  
  Texture :=TBitmap.Create;  
  try  
    if OpenPictureDialog1.Execute  
    then Texture.LoadFromFile(OpenPictureDialog1.FileName);  
  
    with form1 do  
    begin  
      oldBrush:=Canvas.Brush;  
  
      //Choix de la police  
      Canvas.Font.Name:='Arial'; //Cela ne fonctionne qu'avec des polices TrueType  
      Canvas.Font.Size:=48; //Plus elle est grande, plus joli ce sera !!!  
      HauteurTexte:=Canvas.TextHeight(TonTexte);  
  
      //Premier effet  
      canvas.Pen.Color:=clYellow;  
      canvas.Pen.Width:=3;  
      Canvas.Brush.Style:= bsSolid;  
      Canvas.Brush.Color := clLime;  
      TexteTexture(TonTexte,10,0,Canvas);  
  
      //second...  
      canvas.Pen.Color:=clRed;  
      canvas.Pen.Width:=1;  
      Canvas.Brush.Style:= bsDiagCross;  
      Canvas.Brush.Color := clBlue;  
      TexteTexture(TonTexte,10,HauteurTexte,Canvas);  
  
      //troisième, avec une texture  
  
      Canvas.Brush.Bitmap :=Texture;  
      TexteTexture(TonTexte,10,2*HauteurTexte,Canvas);  
      Canvas.Brush.Bitmap :=nil;  
  
      ////////////////////encore plus fort...  
  
      //Dimensions  
      GetTextExtentPoint32(Canvas.Handle, PChar(TonTexte),  
         Length(TonTexte), size);  
  
      //quatrième demo  
      canvas.Pen.Color:=clBlack;  
      canvas.Pen.Width:=1;  
      Canvas.Brush.Style:= bsclear;  
      Canvas.Brush.Color := form1.Color;  
  
      canvas.Pen.width:=3;  
      //Avant de dessiner le texte  
      BeginPath(Canvas.Handle);  
      SetBkMode(Canvas.Handle, TRANSPARENT);  
      //dessiner le texte  
      Canvas.TextOut(10,3*HauteurTexte, TonTexte);  
      //Après le dessin :  
      EndPath(Canvas.Handle);  
      SelectClipPath(Canvas.Handle, RGN_DIFF);  
      i:=3*HauteurTexte;  
      while (i < (3*HauteurTexte + size.cy)) do  
      begin  
        Canvas.MoveTo(11, i);  
        Canvas.LineTo(8+size.cx, i);  
        inc(i,6);  
      end;  
  
      //Cinquième demo  
      canvas.Pen.Color:=clBlack;  
      canvas.Pen.Width:=1;  
      Canvas.Brush.Style:= bsclear;  
      Canvas.Brush.Color := form1.Color;  
  
      canvas.Pen.width:=3;  
      //Avant de dessiner le texte  
      BeginPath(Canvas.Handle);  
      SetBkMode(Canvas.Handle, OPAQUE);  
      //dessiner le texte  
      Canvas.TextOut(10,4*HauteurTexte, TonTexte);  
      //Après le dessin :  
      EndPath(Canvas.Handle);  
      SelectClipPath(Canvas.Handle, RGN_DIFF);  
  
      i:=4*HauteurTexte+1;  
      while (i < (4*HauteurTexte + size.cy)) do  
      begin  
        Canvas.MoveTo(11, i);  
        Canvas.LineTo(8+size.cx, i);  
        inc(i,6);  
      end;  
  
      //Sixième demo  
      canvas.Pen.Color:=clBlack;  
      canvas.Pen.Width:=1;  
      Canvas.Brush.Style:= bsclear;  
      Canvas.Brush.Color := form1.Color;  
  
      //Avant de dessiner le texte  
      BeginPath(Canvas.Handle);  
      SetBkMode(Canvas.Handle, Transparent);  
      //dessiner le texte  
      Canvas.TextOut(10,5*HauteurTexte, TonTexte);  
      //Après le dessin :  
      EndPath(Canvas.Handle);  
  
      MyRgn:=PathToRegion(Canvas.Handle);  
      SelectClipRgn(Canvas.Handle,MyRgn);  
      i:=0;  
      for i:=0 to 90 do  
      begin  
        x:=round(cos(i*pi/180)*size.cx);  
        y:=round(sin(i*pi/180)*size.cx);  
        Canvas.MoveTo(11,5*HauteurTexte+1);  
        Canvas.LineTo(11+x,5*HauteurTexte+1+y);  
      end;  
      SelectClipRgn(Canvas.Handle,0);  
      DeleteObject(MyRgn);  
    end;  
  finally  
    Texture.Free;  
  end;  
end;  
  
end.

Mis à jour le 19 janvier 2014 LadyWasky

Proposer une nouvelle réponse sur la FAQ

Ce n'est pas l'endroit pour poser des questions, allez plutôt sur le forum de la rubrique pour ça


Réponse à la question

Liens sous la question
précédent sommaire suivant
 

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2017 Developpez Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.

 
Responsables bénévoles de la rubrique Delphi : Gilles Vasseur - Alcatîz -