FAQ DelphiConsultez toutes les FAQ
Nombre d'auteurs : 124, nombre de questions : 933, dernière mise à jour : 28 septembre 2024 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.
- Comment connaître la longueur d'une chaîne de caractères ?
- Comment accéder à un caractère d'une chaîne en connaissant sa position ?
- Comment transformer une chaîne de un caractère en une variable de type Char ?
- Comment trouver une chaîne dans une autre ?
- Comment remplacer une chaîne dans une chaîne ?
- Comment extraire les mots d'une chaîne ?
- Comment saisir dans le source une chaîne de plus de 255 caractères ?
- Comment insérer des apostrophes dans une chaîne de caractères ?
- Comment transformer une chaîne DOS en chaîne Windows ?
- Comment faire un Case Of avec des String ?
- Comment convertir les caractères spéciaux HTML ?
- Comment transformer une taille en string ?
- Comment convertir un fichier texte Mac au format PC ?
- Comment connaître la largeur et la hauteur en pixels d'un texte ?
- Comment convertir un texte avec des formats RTF en texte brut ?
- Comment peut on faire des textures et contours d'un texte ?
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; |
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; |
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; |
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;
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;
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; |
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' } |
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; |
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 !'; |
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; |
Ceci ' est une apostrophe. Et c'est tout.
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; |
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; |
É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; |
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; |
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 + '™'; '©' : result := result + '©'; '®' : result := result + '®'; 'À' : result := result + 'À'; 'Á' : result := result + 'Á'; 'Â' : result := result + 'Â'; 'Ã' : result := result + 'Ã'; 'Ä' : result := result + 'Ä'; 'Å' : result := result + 'Å'; 'Æ' : result := result + 'Æ'; 'Ç' : result := result + 'Ç'; 'È' : result := result + 'È'; 'É' : result := result + 'É'; 'Ê' : result := result + 'Ê'; 'Ë' : result := result + 'Ë'; 'Ì' : result := result + 'Ì'; 'Í' : result := result + 'Í'; 'Î' : result := result + 'Î'; 'Ï' : result := result + 'Ï'; 'Ð' : result := result + 'Ð'; 'Ñ' : result := result + 'Ñ'; 'Ò' : result := result + 'Ò'; 'Ó' : result := result + 'Ó'; 'Ô' : result := result + 'Ô'; 'Õ' : result := result + 'Õ'; 'Ö' : result := result + 'Ö'; 'Ø' : result := result + 'Ø'; 'Ù' : result := result + 'Ù'; 'Ú' : result := result + 'Ú'; 'Û' : result := result + 'Û'; 'Ü' : result := result + 'Ü'; 'Ý' : result := result + 'Ý'; 'Þ' : result := result + 'Þ'; 'ß' : result := result + 'ß'; 'à' : result := result + 'à'; 'á' : result := result + 'á'; 'â' : result := result + 'â'; 'ã' : result := result + 'ã'; 'ä' : result := result + 'ä'; 'å' : result := result + 'å'; 'æ' : result := result + 'æ'; 'ç' : result := result + 'ç'; 'è' : result := result + 'è'; 'é' : result := result + 'é'; 'ê' : result := result + 'ê'; 'ë' : result := result + 'ë'; 'ì' : result := result + 'ì'; 'í' : result := result + 'í'; 'î' : result := result + 'î'; 'ï' : result := result + 'ï'; 'ð' : result := result + 'ð'; 'ñ' : result := result + 'ñ'; 'ò' : result := result + 'ò'; 'ó' : result := result + 'ó'; 'ô' : result := result + 'ô'; 'õ' : result := result + 'õ'; 'ö' : result := result + 'ö'; 'ø' : result := result + 'ø'; 'ù' : result := result + 'ù'; 'ú' : result := result + 'ú'; 'û' : result := result + 'û'; 'ü' : result := result + 'ü'; 'ý' : result := result + 'ý'; 'þ' : result := result + 'þ'; 'ÿ' : result := result + 'ÿ'; '¡' : result := result + '¡'; '¢' : result := result + '¢'; '£' : result := result + '£'; '¤' : result := result + '¤'; '¥' : result := result + '¥'; '¦' : result := result + '¦'; '§' : result := result + '§'; '¨' : result := result + '¨'; 'ª' : result := result + 'ª'; '«' : result := result + '«'; '¬' : result := result + '­'; '¯' : result := result + '¯'; '°' : result := result + '°'; '±' : result := result + '±'; '²' : result := result + '²'; '³' : result := result + '³'; '´' : result := result + '´'; 'µ' : result := result + 'µ'; '·' : result := result + '·'; '¸' : result := result + '¸'; '¹' : result := result + '¹'; 'º' : result := result + 'º'; '»' : result := result + '»'; '¼' : result := result + '¼'; '½' : result := result + '½'; '¾' : result := result + '¾'; '¿' : result := result + '¿'; '×' : result := result + '×'; '÷' : result := result + '÷'; '€' : result := result + '€'; else result := result + s[i]; end; end; end; |
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; |
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; |
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; |
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 } |
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 |
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; |
- 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; |
- 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
10var 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.
Pour appliquer une texture, dessiner un contour (ou n'importe quelle forme géométrique), il faut procéder en trois étapes :
- Avant de dessiner :
Code delphi : Sélectionner tout BeginPath(Canvas.Handle);
- Dessiner le texte
- Après le dessin :
Code delphi : Sélectionner tout 1
2
3CloseFigure(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. |
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 çaLes 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 © 2024 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.