Mega Code Archive

 
Categories / Delphi / Files
 

How to save and Load Font from a configuration file

Title: How to save and Load Font from a configuration file unit DelphiCenterU1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, IniFiles; type TForm1 = class(TForm) Button1: TButton; Button2: TButton; ListBox1: TListBox; FontDialog1: TFontDialog; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure ListBox1Click(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} var MyFile: string = 'C:\Font.Ini'; (*----------------------------------------------------*) function FontStyletoStr(St: TFontStyles): string; var S: string; begin S := ''; if St = [fsbold] then S := 'Bold' else if St = [fsItalic] then S := 'Italic' else if St = [fsStrikeOut] then S := 'StrikeOut' else if St = [fsUnderline] then S := 'UnderLine' else if St = [fsbold, fsItalic] then S := 'BoldItalic' else if St = [fsBold, fsStrikeOut] then S := 'BoldStrike' else if St = [fsBold, fsUnderline] then S := 'BoldUnderLine' else if St = [fsBold..fsStrikeOut] then S := 'BoldItalicStrike' else if St = [fsBold..fsUnderLine] then S := 'BoldItalicUnderLine' else if St = [fsbold..fsItalic, fsStrikeOut] then S := 'BoldItalicStrike' else if St = [fsBold, fsUnderline..fsStrikeOut] then S := 'BoldStrikeUnderLine' else if St = [fsItalic, fsStrikeOut] then S := 'ItalicStrike' else if St = [fsItalic..fsUnderline] then S := 'ItalicUnderLine' else if St = [fsUnderLine..fsStrikeOut] then S := 'UnderLineStrike' else if St = [fsItalic..fsStrikeOut] then S := 'ItalicUnderLineStrike'; FontStyletoStr := S; end; (*----------------------------------------------------*) function StrtoFontStyle(St: string): TFontStyles; var S: TfontStyles; begin S := []; St := UpperCase(St); if St = 'BOLD' then S := [fsBold] else if St = 'ITALIC' then S := [fsItalic] else if St = 'STRIKEOUT' then S := [fsStrikeOut] else if St = 'UNDERLINE' then S := [fsUnderLine] else if St = 'BOLDITALIC' then S := [fsbold, fsItalic] else if St = 'BOLDSTRIKE' then S := [fsBold, fsStrikeOut] else if St = 'BOLDUNDERLINE' then S := [fsBold, fsUnderLine] else if St = 'BOLDITALICSTRIKE' then S := [fsBold..fsStrikeOut] else if St = 'BOLDITALICUNDERLINE' then S := [fsBold..fsUnderLine] else if St = 'BOLDITALICSTRIKE' then S := [fsbold..fsItalic, fsStrikeOut] else if St = 'BOLDSTRIKEUNDERLINE' then S := [fsBold, fsUnderline..fsStrikeOut] else if St = 'ITALICSTRIKE' then S := [fsItalic, fsStrikeOut] else if St = 'ITALICUNDERLINE' then S := [fsItalic..fsUnderline] else if St = 'UNDERLINESTRIKE' then S := [fsUnderLine..fsStrikeOut] else if St = 'ITALICUNDERLINESTRIKE' then S := [fsItalic..fsStrikeOut]; StrtoFontStyle := S; end; (*----------------------------------------------------*) //Example for Write Font procedure SaveFont(S: string); var Ini: TIniFile; begin Ini := TIniFile.Create(S); with Form1.ListBox1 do begin with Font do begin Ini.WriteString('Fonts', 'List Name', Name); Ini.WriteInteger('Fonts', 'List Size', Size); Ini.WriteInteger('Fonts', 'List Color', Color); S := FontStyletoStr(Style); if S '' then Ini.WriteString('Fonts', 'List Style', S); end; Ini.WriteInteger('Colors', 'List Color', Color); end; Ini.Free; end; (*----------------------------------------------------*) //Example for Read Font procedure LoadFont(S: string); var Ini: TIniFile; begin Ini := TIniFile.Create(S); with Form1.ListBox1 do begin with Font do begin Name := Ini.ReadString('Fonts', 'List Name', Name); Size := Ini.ReadInteger('Fonts', 'List Size', Size); Color := Ini.ReadInteger('Fonts', 'List Color', Color); S := Ini.ReadString('Fonts', 'List Style', ''); if S '' then Style := StrtoFontStyle(S); end; Color := Ini.ReadInteger('Colors', 'List Color', Color); end; Ini.Free; end; (*----------------------------------------------------*) procedure TForm1.Button1Click(Sender: TObject); begin SaveFont(MyFile); end; (*----------------------------------------------------*) procedure TForm1.Button2Click(Sender: TObject); begin LoadFont(MyFile); end; (*----------------------------------------------------*) procedure TForm1.ListBox1Click(Sender: TObject); begin with FontDialog1 do if Execute then ListBox1.Font := Font; end; (*----------------------------------------------------*) procedure TForm1.FormCreate(Sender: TObject); var i: Byte; begin for i := 1 to 10 do ListBox1.Items.Add('Item ' + IntToStr(i)); end; (*----------------------------------------------------*) end.