Solved

save and load font properties

Posted on 2004-09-24
6
283 Views
Last Modified: 2013-12-03
hi,

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

thanks...
0
Comment
Question by:komputer
  • 5
6 Comments
 
LVL 9

Expert Comment

by:ginsonic
Comment Utility
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
 
LVL 9

Expert Comment

by:ginsonic
Comment Utility
Add
....
uses
  Typinfo;
0
 
LVL 9

Expert Comment

by:ginsonic
Comment Utility
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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 9

Accepted Solution

by:
ginsonic earned 50 total points
Comment Utility
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
 

Author Comment

by:komputer
Comment Utility
thanks ginsonic...
0
 
LVL 9

Expert Comment

by:ginsonic
Comment Utility
Welcome! :)
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Suggested Solutions

Title # Comments Views Activity
Font install problem 9 36
Adobe Acrobat Pro: how to copy style? 2 70
Printing problem 2 72
Create a path if not exists 7 41
A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
This video demonstrates how to create an example email signature rule for a department in a company using CodeTwo Exchange Rules. The signature will be inserted beneath users' latest emails in conversations and will be displayed in users' Sent Items…

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now