How to save and restore font properties in the registry (Views: 28)
Problem/Question/Abstract: I tried to save user selected font settings in the registry. Therefore I declared a variable Wfont: TFont; and created it with Wfont := TFont.create; . All works fine, like setting a panel's font and so on, but when I try to write it to the registry using reg.writebinarydata('Font',wfont,sizeof(Tfont)), only 4 Bytes are stored. Ergo the font could not be loaded. Answer: 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; 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; end; Result := Result + ']'; end; 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; finally sl.free end; end; 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; 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; |