Enregistrer une police (une variable TFont) dans un fichier .ini
cricri_b34
Messages postés
222
Date d'inscription
mercredi 21 juillet 2004
Statut
Membre
Dernière intervention
15 février 2006
-
5 févr. 2005 à 03:45
Emandhal Messages postés 194 Date d'inscription dimanche 2 mars 2003 Statut Membre Dernière intervention 10 octobre 2006 - 5 févr. 2005 à 12:02
Emandhal Messages postés 194 Date d'inscription dimanche 2 mars 2003 Statut Membre Dernière intervention 10 octobre 2006 - 5 févr. 2005 à 12:02
1 réponse
Emandhal
Messages postés
194
Date d'inscription
dimanche 2 mars 2003
Statut
Membre
Dernière intervention
10 octobre 2006
3
5 févr. 2005 à 12:02
5 févr. 2005 à 12:02
Fonction qui transforme un TFont en String après il suffira de faire un ini.WriteString
Function TFontToStr(aFont: TFont): String;
Const
BoolText: Array[Boolean] of String[1] = ('0', '1');
Begin
Result := '';
With TStringList.Create do
Try
Add(aFont.Name);
Add(IntToStr(aFont.Size));
Add(BoolText[fsBold in aFont.Style]);
Add(BoolText[fsItalic in aFont.Style]);
Add(BoolText[fsUnderline in aFont.Style]);
Add(BoolText[fsStrikeOut in aFont.Style]);
Add(ColorToString(aFont.Color));
Add(IntToStr(aFont.Charset));
Add(IntToStr(aFont.Pitch));
Result := DelimitedText;
Finally
Free;
end;
End;
là c'est pour la lecture après un ini.ReadString. J'ai mis la TFont en var parce que je ne sais pas comment tu vas t'en servire. Je pense l'avoir assez bien protégé en cas de lecture éronnée (manque seulement la protection du nombre d'éléments de la StringList).
Procedure StrToTFont(aStr: String; Var aFont: TFont);
Var
bColor: TColor;
Begin
If not Assigned(aFont) Then aFont := TFont.Create;
With TStringList.Create do
Try
If aStr='' Then Exit;
DelimitedText := aStr;
aFont.Name := Strings[0];
aFont.Size := StrToIntDef(Strings[1], 8);
aFont.Style := [];
If Strings[2]='1' Then Include(aFont.Style, fsBold);
If Strings[3]='1' Then Include(aFont.Style, fsItalic);
If Strings[4]='1' Then Include(aFont.Style, fsUnderline);
If Strings[5]='1' Then Include(aFont.Style, fsStrikeOut);
bColor := StrToIntDef('$'+Strings[6], -1);
If bColor=-1 Then
begin
Try
bColor := StringToColor(Strings[6]);
Except
bColor := clBlack;
end;
end;
aFont.Color := bColor;
aFont.Charset := StrToIntDef(Strings[7], DEFAULT_CHARSET);
aFont.Pitch := StrToIntDef(Strings[8], fpDefault);
Finally
Free;
end;
End;
Bon j'ai fait ca en 10min et de mémoire, donc je ne sais pas si ça marche...
Tout problème a sa solution... Mais en général, c'est jamais la bonne...
Function TFontToStr(aFont: TFont): String;
Const
BoolText: Array[Boolean] of String[1] = ('0', '1');
Begin
Result := '';
With TStringList.Create do
Try
Add(aFont.Name);
Add(IntToStr(aFont.Size));
Add(BoolText[fsBold in aFont.Style]);
Add(BoolText[fsItalic in aFont.Style]);
Add(BoolText[fsUnderline in aFont.Style]);
Add(BoolText[fsStrikeOut in aFont.Style]);
Add(ColorToString(aFont.Color));
Add(IntToStr(aFont.Charset));
Add(IntToStr(aFont.Pitch));
Result := DelimitedText;
Finally
Free;
end;
End;
là c'est pour la lecture après un ini.ReadString. J'ai mis la TFont en var parce que je ne sais pas comment tu vas t'en servire. Je pense l'avoir assez bien protégé en cas de lecture éronnée (manque seulement la protection du nombre d'éléments de la StringList).
Procedure StrToTFont(aStr: String; Var aFont: TFont);
Var
bColor: TColor;
Begin
If not Assigned(aFont) Then aFont := TFont.Create;
With TStringList.Create do
Try
If aStr='' Then Exit;
DelimitedText := aStr;
aFont.Name := Strings[0];
aFont.Size := StrToIntDef(Strings[1], 8);
aFont.Style := [];
If Strings[2]='1' Then Include(aFont.Style, fsBold);
If Strings[3]='1' Then Include(aFont.Style, fsItalic);
If Strings[4]='1' Then Include(aFont.Style, fsUnderline);
If Strings[5]='1' Then Include(aFont.Style, fsStrikeOut);
bColor := StrToIntDef('$'+Strings[6], -1);
If bColor=-1 Then
begin
Try
bColor := StringToColor(Strings[6]);
Except
bColor := clBlack;
end;
end;
aFont.Color := bColor;
aFont.Charset := StrToIntDef(Strings[7], DEFAULT_CHARSET);
aFont.Pitch := StrToIntDef(Strings[8], fpDefault);
Finally
Free;
end;
End;
Bon j'ai fait ca en 10min et de mémoire, donc je ne sais pas si ça marche...
Tout problème a sa solution... Mais en général, c'est jamais la bonne...
