Сохранение свойств шрифтов

Code:

//Saving and restoring font properties in the registry

Uses typInfo, Registry;

Function GetFontProp( anObj: TObject) : TFont;

Var

PInfo: PPropInfo;

Begin

{ try to get a pointer to the property information for a property with the

   name 'Font'. TObject.ClassInfo returns a pointer to the RTTI table,

which

   we need to pass to GetPropInfo }

PInfo := GetPropInfo( anObj.ClassInfo, 'font' );

Result := Nil;

If PInfo <> Nil Then

   { found a property with this name, check if it has the correct type }

   If (PInfo^.Proptype^.Kind = tkClass) and

      GetTypeData(PInfo^.Proptype^)^.ClassType.InheritsFrom(TFont)

   Then

     Result := TFont(GetOrdProp( anObj, PInfo ));

End; { GetfontProp }

Function StyleToString( styles: TFontStyles ): String;

var

style: TFontStyle;

Begin

Result := '[';

For style := Low(style) To High(style) Do Begin

   If style IN styles Then Begin

     If Length(result) > 1 Then

       result := result + ',';

     result := result + GetEnumname( typeInfo(TFontStyle), Ord(style));

   End; { If }

End; { For }

Result := Result + ']';

End; { StyleToString }

Function StringToStyle( S: String ): TFontStyles;

Var

sl   : TStringlist;

style: TfontStyle;

i    : Integer;

Begin

Result := [];

If Length(S) < 2 Then Exit;

If S[1] = '[' Then

   Delete(S, 1, 1);

If S[Length(S)] = ']' Then

   Delete(S, Length(S), 1);

If Length(S) = 0 Then Exit;

sl:= TStringlist.Create;

try

   sl.commatext := S;

   For i := 0 To sl.Count-1 Do Begin

     try

       style := TFontStyle( GetEnumValue( Typeinfo(TFontStyle), sl[i] ));

       Include( Result, style );

     except

     end;

   End; { For }

finally

   sl.free

end;

End; { StringToStyle }

Procedure SaveFontProperties( forControl: TControl;

                             toIni: TRegInifile;

                             const section: String );

Var

font: TFont;

basename: String;

Begin

Assert( Assigned( toIni ));

font := GetFontProp( forControl );

If not Assigned( font ) Then Exit;

basename := forControl.Name+'.Font.';

toIni.WriteInteger( Section, basename+'Charset', font.charset );

toIni.WriteString ( Section, basename+'Name', font.Name );

toIni.WriteInteger( Section, basename+'Size', font.size );

toIni.WriteString ( Section, basename+'Color',

                     '$'+IntToHex(font.color,8));

toIni.WriteString ( Section, basename+'Style',

                     StyleToString( font.Style ));

End; { SaveFontProperties }

Procedure RestoreFontProperties( forControl: TControl;

                            toIni: TRegInifile;

                            const section: String );

Var

font: TFont;

basename: String;

Begin

Assert( Assigned( toIni ));

font := GetFontProp( forControl );

If not Assigned( font ) Then Exit;

basename := forControl.Name+'.Font.';

font.Charset :=

   toIni.ReadInteger( Section, basename+'Charset', font.charset );

font.Name :=

   toIni.ReadString ( Section, basename+'Name', font.Name );

font.Size :=

   toIni.ReadInteger( Section, basename+'Size', font.size );

font.Color := TColor( StrToInt(

   toIni.ReadString ( Section, basename+'Color',

                     '$'+IntToHex(font.color,8))

                     ));

font.Style := StringToStyle(

   toIni.ReadString ( Section, basename+'Style',

                      StyleToString( font.Style ))

                     );

End; { RestoreFontProperties }