Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 300
  • Last Modified:

save and load font properties

hi,

i would like to save my edit object font properties to database and load from database.

thanks...
0
komputer
Asked:
komputer
  • 5
1 Solution
 
ginsonicCommented:
Use this code to get as string all properties:

procedure ListComponentProperties(Component: TComponent; Strings: TStrings);
var
  Count, Size, I: Integer;
  List: PPropList;
  PropInfo: PPropInfo;
  PropOrEvent, PropValue: string;
begin
  Count := GetPropList(Component.ClassInfo, tkAny, nil);
  Size  := Count * SizeOf(Pointer);
  GetMem(List, Size);
  try
    Count := GetPropList(Component.ClassInfo, tkAny, List);
    for I := 0 to Count - 1 do
    begin
      PropInfo := List^[I];
      if PropInfo^.PropType^.Kind in tkMethods then
        PropOrEvent := 'Event'
      else
        PropOrEvent := 'Property';
      PropValue := VarToStr(GetPropValue(Component, PropInfo^.Name));
      Strings.Add(Format('[%s] %s: %s = %s', [PropOrEvent, PropInfo^.Name,
        PropInfo^.PropType^.Name, PropValue]));
    end;
  finally
    FreeMem(List);
  end;
end;
0
 
ginsonicCommented:
Add
....
uses
  Typinfo;
0
 
ginsonicCommented:
To save:

uses
  Typinfo;

function GetFontProp( anObj: TObject) : TFont;
var
  PInfo: PPropInfo;
begin
  PInfo := GetPropInfo( anObj.ClassInfo, 'font' );
  Result := Nil;
  if PInfo <> Nil then
    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;

procedure TForm1.Button1Click(Sender: TObject);
var
  font: TFont;
begin
  font := GetFontProp( Form1 ); // or work component - if already have an TFont use it with font.Assign(MyFont)
  if not Assigned( font ) then
    Exit;
  Table1.Insert;
  Table1.FieldByName('Charset').AsInteger:=font.charset;
  Table1.FieldByName('Name').AsString:=font.Name;
  Table1.FieldByName('Size').AsInteger:=font.size;
  Table1.FieldByName('Color').AsString:='$' + IntToHex(font.color,8);
  Table1.FieldByName('Style').AsString:=StyleToString( font.Style );
  Table1.Post;
end;


0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
ginsonicCommented:
to load use:

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;

.......
var
  font: TFont;
begin
  font := GetFontProp( Form1 ); // or your component
  if not Assigned( font ) then
    Exit;
  font.Charset := Table1.FieldByName('Charset').AsInteger;
  font.Name := Table1.FieldByName('Name').AsString;
  font.Size := Table1.FieldByName('Size').AsInteger;
  font.Color := TColor( StrToInt(Table1.FieldByName('Name').AsString));
  font.Style := StringToStyle(Table1.FieldByName('Name').AsString);
end;
0
 
komputerAuthor Commented:
thanks ginsonic...
0
 
ginsonicCommented:
Welcome! :)
0

Featured Post

Ask an Anonymous Question!

Don't feel intimidated by what you don't know. Ask your question anonymously. It's easy! Learn more and upgrade.

  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now