Programm-Optionen

[Jens Schumann]

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