2006. július 18., kedd
How to save and retrieve font information to / from a TIniFile
Problem/Question/Abstract:
How to save and retrieve font information to / from a TIniFile
Answer:
Solve 1:
uses
Inifiles;
procedure SaveFont(FName: string; Section: string; smFont: TFont);
var
FStream: TIniFile;
begin
FStream := TIniFile.Create(FName);
try
FStream.WriteString(Section, 'Name', smFont.Name);
FStream.WriteInteger(Section, 'CharSet', smFont.CharSet);
FStream.WriteInteger(Section, 'Color', smFont.Color);
FStream.WriteInteger(Section, 'Size', smFont.Size);
FStream.WriteInteger(Section, 'Style', Byte(smFont.Style));
finally
FStream.free;
end;
end;
procedure LoadFont(FName: string; Section: string; smFont: TFont);
var
FStream: TIniFile;
begin
FStream := TIniFile.Create(Fname);
try
smFont.Name := FStream.ReadString(Section, 'Name', smFont.Name);
smFont.CharSet := TFontCharSet(FStream.ReadInteger(Section, 'CharSet',
smFont.CharSet));
smFont.Color := TColor(FStream.ReadInteger(Section, 'Color', smFont.Color));
smFont.Size := FStream.ReadInteger(Section, 'Size', smFont.Size);
smFont.Style := TFontStyles(Byte(FStream.ReadInteger(Section, 'Style',
Byte(smFont.Style))));
finally
FStream.free;
end;
end;
Here 's how to use the procedures:
{Save Font}
procedure TForm1.Button1Click(Sender: TObject);
begin
SaveFont('font.ini', 'label', Label1.Font);
end;
procedure TForm1.Label1DblClick(Sender: TObject);
begin
if FontDialog1.Execute then
Label1.Font := FontDialog1.Font
end;
{Load Font}
procedure TForm1.Button2Click(Sender: TObject);
begin
LoadFont('font.ini', 'label', Label1.Font);
end;
Solve 2:
This code converts an instance of TFont to/ from a string. Just store that string whereever you want:
function GetAnyFontAsStr(Font: TFont): string;
begin
Result := 'DEFAULT';
if Assigned(Font) then
begin
Result := QuotedStr('Name=' + Font.Name);
Result := Result + ';
Size = ' + IntToStr(Font.Size);
Result := Result + ';
Color = ' + ColorToString(Font.Color);
Result := Result + ';
Pitch = ' + GetEnumName(TypeInfo(TFontPitch), Ord(Font.Pitch));
Result := Result + ';
Style = ' + IntToStr(Byte(Font.Style));
end;
end;
procedure SetAnyFontAsStr(var Font: TFont; aFontStr: string);
var
FontStrList: TStringList;
begin
if Assigned(Font) then
begin
FontStrList := TStringList.Create;
FontStrList.QuoteChar := '''';
FontStrList.Delimiter := ';';
FontStrList.DelimitedText := aFontStr;
Font.Name := FontStrList.Values['Name'];
Font.Size := StrToInt(FontStrList.Values['Size']);
Font.Color := StringToColor(FontStrList.Values['Color']);
Font.Pitch := TFontPitch(GetEnumValue(TypeInfo(TFontPitch),
FontStrList.Values['Pitch']));
Font.Style := TFontStyles(Byte(StrToIntDef(FontStrList.Values['Style'], 0)));
FontStrList.Free;
end;
end;
Solve 3:
uses
IniFiles;
procedure SaveInfo;
var
t: TIniFile;
s: string;
begin
s := ExtractFilePath(ParamStr(0)) + 'fontinfo.ini';
t := TIniFile.Create(s);
{load previous values into Font dialog if there are any}
if FileExists(s) then
with FontDialog1.Font do
begin
Name := t.ReadString('Font', 'Name', Name);
Size := t.ReadInteger('Font', 'Size', Size);
Color := t.ReadInteger('Font', 'Color', Color);
if t.ReadBool('Font', 'Bold', False) then
Style := Style + [fsBold];
if t.ReadBool('Font', 'Italic', False) then
Style := Style + [fsItalic];
if t.ReadBool('Font', 'Underline', False) then
Style := Style + [fsUnderline];
if t.ReadBool('Font', 'Strikeout', False) then
Style := Style + [fsStrikeOut];
end;
if FontDialog1.Execute then
begin
{write new values to INI file for next time}
with FontDialog1.Font do
begin
t.WriteString('Font', 'Name', Name);
t.WriteInteger('Font', 'Size', Size);
t.WriteInteger('Font', 'Color', Color);
t.WriteBool('Font', 'Bold', fsBold in Style);
t.WriteBool('Font', 'Italic', fsItalic in Style);
t.WriteBool('Font', 'Underline', fsUnderline in Style);
t.WriteBool('Font', 'Strikeout', fsStrikeout in Style);
end;
end;
t.Free;
end;
As you can see, the Color property is stored as an integer. Therefore, if you need to also store the ColorDialog.Color property, use the ReadInteger and WriteInteger methods.
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése