Registriert seit: 27. Apr 2003
Ort: Bad Honnef
1.644 Beiträge
Delphi 2009 Professional
|
Re: Programm-Optionen
6. Jan 2004, 09:11
Hallo,
dem Objekt TInifile fehlen leider die Methoden ReadFont und WriteFont.
Das lässt sich Dank OOP aber leicht ändern.
Delphi-Quellcode:
unit Inifile2;
interface
uses IniFiles, Graphics, Classes, StdCtrls;
Type
TIniFileExt = Class(TIniFile)
procedure WriteFont( Const Section, Ident: String; Value: TFont);
function ReadFont( Const Section, Ident: String; default: TFont): TFont;
end;
implementation
uses
SysUtils, Consts;
procedure TIniFileExt.WriteFont( Const Section, Ident: String; Value: TFont);
var
Str : String;
v :char;
Begin
V:=' ';
Str := ' ';
Str := Value. Name + ' ,';
Str := Str + ColorToString(Value.Color) + ' ,';
Str := Str + IntToStr(Value.Size) + ' ,';
Case Value.Pitch of
fpdefault : v :=' d';
fpvariable : v :=' v';
fpfixed : v :=' f';
end;
Str:= Str + v + ' ,';
if fsBold in Value.Style then Str:=Str + ' b';
if fsItalic in Value.Style then Str:=Str + ' i';
if fsUnderline in Value.Style then Str:=Str + ' u';
if fsStrikeOut in Value.Style then Str:=Str +' s';
WriteString(Section,Ident,Str);
end;
function TIniFileExt.ReadFont( Const Section, Ident: String;
default: TFont): TFont;
var
FFont : TFont;
Str,sc : String;
I : byte;
Begin
Str := ReadString(Section,Ident,' ');
ReadFont := default;
I := Pos(' ,',Str);
if i = 0 then exit;
FFont := TFont.Create;
FFont. Name := Copy(Str,1,i-1);
Delete(Str,1,i);
i:=Pos(' ,',Str);
if i = 0 then exit;
try
FFont.Color:= StringtoColor(Copy(Str,1,(i-1)));
except
FFont.Free;
exit;
end;
Delete(Str,1,i);
i:=Pos(' ,',Str);
if i = 0 then exit;
try
FFont.Size:= StrToInt(Copy(Str,1,(i-1)));
except
FFont.Free;
exit;
end;
Delete(Str,1,i);
i:=Pos(' ,',Str);
if i = 0 then
begin
FFont.Free;
exit;
end;
sc:=Copy(Str,1,(i-1));
if sc = ' d' then FFont.pitch := fpdefault;
if sc = ' v' then FFont.pitch := fpvariable;
if sc = ' f' then FFont.pitch := fpfixed;
Delete(Str,1,i);
FFont.Style:=[];
While byte(Length(Str)) > 0 do
Begin
Case Str[1] of
' b': FFont.Style := FFont.Style + [fsbold];
' i': FFont.Style := FFont.Style + [fsitalic];
' u': FFont.Style := FFont.Style + [fsUnderline];
' s': FFont.Style := FFont.Style + [fsStrikeout];
end;
Delete(Str,1,1);
end;
ReadFont.Assign(FFont);
FFont.Free;
end;
end.
Diese unit verwende ich schon seit D1
|