FAQ DelphiConsultez toutes les FAQ

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

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;

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;

Function Pos (Substr : String; S : String) : Integer;

Pos('CD','ABCDEF'); { retourne 3 }

Function PosEx (const SubStr, S : String; Offset : Cardinal = 1) : Integer;

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;

1
2
3
4
5
AnsiReplaceStr('ABCGHABKJABFab','AB','XX') 
{ retourne 'XXCGHabKJXXFab' } 
  
AnsiReplaceText('ABCGHABKJABFab','AB','XX') 
{ retourne 'XXCGHXXKJXXFXX' }

1
2
extraireMots(Edit1.Text,memo1.Lines);  
extraireMots(Edit1.Text,memo1.Lines,true,[' ',',','.',';']);

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;

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 !';

1
2
3
4
Const Chaine='Ceci '' est une apostrophe. Et c''est tout.';  
begin  
 showmessage(Chaine)  
end;

1
2
3
4
5
function DosStrToWinStr(Const StrDos: String): String; 
begin 
  SetLength(Result, Length(StrDos)); 
  OemToCharBuff(pChar(StrDos),@Result[1],Length(StrDos)); 
end;

1
2
3
4
5
function DosStrToWinStrW(Const StrDos: String): WideString; 
begin 
  SetLength(Result,Length(StrDos)); 
  OemToCharBuffW(pChar(StrDos),@Result[1],Length(StrDos)); 
end;

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;

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;

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;

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;

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;

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;

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  
}

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

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;

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;

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.