Delphi XE 7 project template for saving / loading form settings

Question

I have developed small test project as a template for production project. In this template I've found a way that the application saves and loads its own settings (ini-file). Main Form1 will contain many other sub-forms Form2, Form3, ... FormN

Each sub-form has its own settings, but only main form is responsible for saving/loading settings for these forms (sub-forms only can give an access to settings via public methods). In this example I've introduced only Form2 for simplicity.

I need your comments and advice about my method. The project is developed in Delphi XE 7.

Dropbox link

program Project_Test_Application;
uses
 Vcl.Forms,
 Unit1 in 'Unit1.pas' {Form1},
 Unit2 in 'Unit2.pas' {Form2},
 U_Common in 'U_Common.pas',
 U_Singleton in 'U_Singleton.pas';
{$R *.res}
begin
 Application.Initialize;
 Application.MainFormOnTaskbar := True;
 P_MAIN_START;
 Application.CreateForm(TForm1, Form1);
 Form1.P_START;
 Application.Run;
 P_MAIN_EXIT;
end.
unit U_Common;
interface
uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls,
 U_Singleton, Unit2;
{------------------------------------------------------------------------------}
function F_GS: TSingleton;
procedure P_MAIN_START;
procedure P_MAIN_EXIT;
{------------------------------------------------------------------------------}
procedure P_DS(const S : String);
implementation uses Unit1;
{------------------------------------------------------------------------------}
function F_GS: TSingleton;
begin
 F_GS := F_Singleton;
end;
{------------------------------------------------------------------------------}
procedure P_MAIN_START;
begin
 P_Singleton_MAIN_START;
end;
{------------------------------------------------------------------------------}
procedure P_MAIN_EXIT;
begin
 P_Singleton_MAIN_EXIT;
end;
{------------------------------------------------------------------------------}
procedure P_DS(const S : String);
var W : PWideChar;
begin
 W := PWideChar(S);
 OutputDebugString(W);
end;
{------------------------------------------------------------------------------}
end.
unit U_Singleton;
interface
uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms,
 Vcl.Dialogs, Vcl.ExtCtrls, IniFiles;
{------------------------------------------------------------------------------}
type TSingleton = class
strict private
 FF_Destroying : Boolean ;
 FF_Application_Directory : String ;
 FF_Main_Exit : BOOLEAN ;
 O_INI : TIniFile ;
 procedure P_Internal_Start;
 procedure P_Get_Application_Directory;
 procedure P_Prepare_INI_File_Storage;
private
 constructor InternalCreate;
 procedure InternalDestroy;
 procedure P_Declare_Main_Exit;
public
 constructor Create;
 destructor Destroy; override;
 procedure BeforeDestruction; override;
 procedure Write_Integer(const Parameter_Name : String; const x : Integer);
 function Read_Integer (const Parameter_Name : String; const Value_if_Null : Integer) : Integer;
 procedure Write_String (const Parameter_Name : String; const x : String);
 function Read_String (const Parameter_Name : String; const Value_if_Null : String) : String;
 function F_App_Dir(const s_File_Name : String) : String;
 property Application_Directory : String read FF_Application_Directory ;
 property Main_Exit : BOOLEAN read FF_Main_Exit;
 const c_INI_File_Name = 'Settings.ini';
 c_INI_Section = 'Application';
end;
{------------------------------------------------------------------------------}
function F_Singleton : TSingleton;
procedure P_Singleton_MAIN_START;
procedure P_Singleton_MAIN_EXIT;
{------------------------------------------------------------------------------}
implementation var GS : TSingleton;
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
procedure P_Singleton_MAIN_START;
begin
 OutputDebugString('procedure P_MAIN_START ');
 GS := nil;
 GS := F_Singleton;
end;
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
procedure P_Singleton_MAIN_EXIT;
begin
 OutputDebugString('procedure P_MAIN_EXIT ');
 if GS <> nil then
 begin
 GS.P_Declare_Main_Exit;
 GS.InternalDestroy;
 GS := nil;
 end;
 //----Application.Terminate;
end;
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
function F_Singleton: TSingleton;
begin
 if GS = nil then GS := TSingleton.InternalCreate;
 Result := GS;
end;
{------------------------------------------------------------------------------}
procedure TSingleton.BeforeDestruction;
begin
 if not FF_Destroying then raise EAssertionFailed.Create('Do not call TSingleton.Destroy');
 inherited;
end;
{------------------------------------------------------------------------------}
constructor TSingleton.Create;
begin
 raise EAssertionFailed.Create('Do not call TSingleton.Create');
end;
{------------------------------------------------------------------------------}
constructor TSingleton.InternalCreate;
begin
 inherited Create;
 P_Internal_Start;
end;
{------------------------------------------------------------------------------}
procedure TSingleton.InternalDestroy;
begin
 FF_Destroying := True;
 Destroy;
end;
{------------------------------------------------------------------------------}
destructor TSingleton.Destroy;
begin
 // your cleanup
 O_INI.Free;
 inherited;
end;
{------------------------------------------------------------------------------}
procedure TSingleton.P_Internal_Start;
begin
 P_Get_Application_Directory;
 P_Prepare_INI_File_Storage;
end;
{------------------------------------------------------------------------------}
procedure TSingleton.P_Get_Application_Directory;
begin
 FF_Application_Directory := IncludeTrailingBackslash(ExtractFilePath(Application.ExeName));
end;
{------------------------------------------------------------------------------}
function TSingleton.F_App_Dir(const s_File_Name: string) : String;
begin
 Result := FF_Application_Directory + s_File_Name;
end;
{------------------------------------------------------------------------------}
procedure TSingleton.P_Prepare_INI_File_Storage;
begin
 O_INI:=TIniFile.Create(F_App_Dir(c_INI_File_Name));
end;
{------------------------------------------------------------------------------}
procedure TSingleton.P_Declare_Main_Exit;
begin
 FF_Main_Exit:=True;
end;
{------------------------------------------------------------------------------}
procedure TSingleton.Write_Integer(const Parameter_Name: string; const x: Integer);
begin
 try O_INI.WriteInteger(c_INI_Section,Parameter_Name,x) except end;
end;
{------------------------------------------------------------------------------}
function TSingleton.Read_Integer(const Parameter_Name: string; const Value_if_Null: Integer) : Integer;
begin
 Result := Value_if_Null;
 try Result := O_INI.ReadInteger(c_INI_Section,Parameter_Name,Value_if_Null); except end;
end;
{------------------------------------------------------------------------------}
procedure TSingleton.Write_String(const Parameter_Name: string; const x: String);
begin
 try O_INI.WriteString(c_INI_Section,Parameter_Name,x) except end;
end;
{------------------------------------------------------------------------------}
function TSingleton.Read_String(const Parameter_Name: string; const Value_if_Null: String) : String;
begin
 Result := Value_if_Null;
 try Result := O_INI.ReadString(c_INI_Section,Parameter_Name,Value_if_Null); except end;
end;
{------------------------------------------------------------------------------}
end.
unit Unit1;
interface
uses
 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.ExtCtrls,
 U_Common, Unit2;
type
 TForm1 = class(TForm)
 PC_Main: TPageControl;
 TabSheet1: TTabSheet;
 TabSheet2: TTabSheet;
 Tab_Exit: TTabSheet;
 Panel1: TPanel;
 procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
 procedure PC_MainChange(Sender: TObject);
 private
 procedure P_Create_Event_Log_Form ;
 procedure P_INI_Parameters_Save ;
 procedure P_INI_Parameters_Load ;
 const
 c_P_Font_Name = 'Event_Log_Font_Name';
 c_P_Font_Size = 'Event_Log_Font_Size';
 public
 F_FRM_Event_Log : TForm2;
 procedure P_START;
 procedure P_END;
 end;
var Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
 CanClose := False;
 P_END;
 CanClose := True;
end;
procedure TForm1.P_START;
begin
 ReportMemoryLeaksOnShutdown := True ;
 P_Create_Event_Log_Form ;
 P_INI_Parameters_Load ;
 PC_Main.ActivePageIndex := TabSheet1.PageIndex ;
end;
procedure TForm1.P_END;
begin
 P_INI_Parameters_Save ;
end;
procedure TForm1.P_INI_Parameters_Save ;
begin
 if F_FRM_Event_Log.F_We_Must_Save_Font_Size then F_GS.Write_Integer( F_FRM_Event_Log.PAR_Font_Size, F_FRM_Event_Log.F_Current_Font_Size ) ;
 if F_FRM_Event_Log.F_We_Must_Save_Font_Name then F_GS.Write_String ( F_FRM_Event_Log.PAR_Font_Name, F_FRM_Event_Log.F_Current_Font_Name ) ;
end;
procedure TForm1.P_INI_Parameters_Load ;
 var i:Integer; S:String;
 procedure P_Font_Size;
 begin
 i:=F_GS.Read_Integer(F_FRM_Event_Log.PAR_Font_Size,F_FRM_Event_Log.C_Error_Font_Size);
 F_FRM_Event_Log.P_Try_to_Set_Font_Size(i);
 F_FRM_Event_Log.P_Save_Last_Loaded_Font_Size(i);
 end;
 procedure P_Font_Name;
 begin
 S:=F_GS.Read_String(F_FRM_Event_Log.PAR_Font_Name,F_FRM_Event_Log.C_Error_Font_Name);
 F_FRM_Event_Log.P_Try_to_Set_Font_Name(S);
 F_FRM_Event_Log.P_Save_Last_Loaded_Font_Name(S);
 end;
begin
 P_Font_Size;
 P_Font_Name;
end;
procedure TForm1.PC_MainChange(Sender: TObject);
begin
 if PC_Main.ActivePageIndex = Tab_Exit.PageIndex then Close;
end;
procedure TForm1.P_Create_Event_Log_Form;
begin
 Application.CreateForm(TForm2, F_FRM_Event_Log);
 F_FRM_Event_Log.Parent := Panel1;
 F_FRM_Event_Log.Align := alClient;
 F_FRM_Event_Log.Visible := True;
 F_FRM_Event_Log.Caption := '' ;
 F_FRM_Event_Log.BorderStyle := bsNone ;
end;
end.
unit Unit2;
interface
uses
 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls;
type
 TForm2 = class(TForm)
 Memo1: TMemo;
 cb_Font_Name: TComboBox;
 cb_Font_Size: TComboBox;
 procedure FormCreate(Sender: TObject);
 const
 C_Error_Font_Name = '';
 C_Error_Font_Size = 0;
 C_Font_Min = 8;
 C_Font_Max = 20;
 procedure Action_Font_Size(Sender: TObject);
 procedure Action_Font_Name(Sender: TObject);
 strict private
 Default_Font_Name : String ;
 Default_Font_Size : Integer ;
 Last_Loaded_Font_Name : String ;
 Last_Loaded_Font_Size : Integer ;
 procedure P_Make_List_of_Font_Name;
 procedure P_Make_List_of_Font_Size;
 procedure P_Init_Default_Values;
 procedure P_Activate_Event_Handler_Font_Name(const B_Activate:BOOLEAN);
 procedure P_Activate_Event_Handler_Font_Size(const B_Activate:BOOLEAN);
 procedure P_Start ;
 public
 const
 PAR_Font_Name = 'Event_Log_Font_Name';
 PAR_Font_Size = 'Event_Log_Font_Size';
 function F_Current_Font_Size : Integer ;
 function F_Current_Font_Name : String ;
 function F_We_Must_Save_Font_Size : BOOLEAN;
 function F_We_Must_Save_Font_Name : BOOLEAN;
 procedure P_Try_to_Set_Font_Size (const i_Font_Size : Integer);
 procedure P_Try_to_Set_Font_Name (const s_Font_Name : String );
 procedure P_Save_Last_Loaded_Font_Size (const i_Font_Size : Integer);
 procedure P_Save_Last_Loaded_Font_Name (const s_Font_Name : String );
 end;
implementation
{$R *.dfm}
procedure TForm2.P_Start;
 procedure P_Set_Font;
 begin
 P_Init_Default_Values ;
 P_Make_List_of_Font_Name ;
 P_Make_List_of_Font_Size ;
 P_Activate_Event_Handler_Font_Name(True);
 P_Activate_Event_Handler_Font_Size(True);
 P_Try_To_Set_Font_Name(F_Current_Font_Name);
 P_Try_To_Set_Font_Size(F_Current_Font_Size);
 end;
begin
 P_Set_Font; 
end;
{=============================}
procedure TForm2.P_Activate_Event_Handler_Font_Name(const B_Activate: Boolean);
begin
 if B_Activate then CB_Font_Name.OnChange := Action_Font_Name
 else CB_Font_Name.OnChange := nil;
end;
{=============================}
procedure TForm2.P_Activate_Event_Handler_Font_Size(const B_Activate: Boolean);
begin
 if B_Activate then CB_Font_Size.OnChange := Action_Font_Size
 else CB_Font_Size.OnChange := nil;
end;
{=============================}
procedure TForm2.P_Try_to_Set_Font_Size(const i_Font_Size: Integer);
begin
 if ( (i_Font_Size>=c_Font_Min) AND (i_Font_Size<=c_Font_Max) ) = FALSE then Exit;
 if Memo1.Font.Size <> i_Font_Size then try Memo1.Font.Size := i_Font_Size except end;
 if CB_Font_Size.Text <> IntToStr(i_Font_Size) then
 begin
 P_Activate_Event_Handler_Font_Size(False);
 try CB_Font_Size.ItemIndex := CB_Font_Size.Items.IndexOf( IntToStr(i_Font_Size) ) except end;
 P_Activate_Event_Handler_Font_Size(True);
 end;
end;
{=============================}
procedure TForm2.P_Try_to_Set_Font_Name(const s_Font_Name: string);
begin
 if ( Length(s_Font_Name) > 0 ) = FALSE then Exit;
 if Memo1.Font.Name <> s_Font_Name then try Memo1.Font.Name := s_Font_Name except end;
 if CB_Font_Name.Text <> s_Font_Name then
 begin
 P_Activate_Event_Handler_Font_Name(False);
 try CB_Font_Name.ItemIndex := CB_Font_Name.Items.IndexOf( s_Font_Name ) except end;
 P_Activate_Event_Handler_Font_Name(True);
 end;
end;
{=============================}
procedure TForm2.P_Save_Last_Loaded_Font_Size(const i_Font_Size: Integer);
begin
 if F_Current_Font_Size=i_Font_Size then Last_Loaded_Font_Size := i_Font_Size;
end;
{=============================}
procedure TForm2.P_Save_Last_Loaded_Font_Name(const s_Font_Name: string);
begin
 if F_Current_Font_Name=s_Font_Name then Last_Loaded_Font_Name := s_Font_Name;
end;
{=============================}
procedure TForm2.Action_Font_Size(Sender: TObject);
var i : Integer;
begin
 if TryStrToInt(CB_Font_Size.Text,i) then P_Try_to_Set_Font_Size(i);
end;
{=============================}
procedure TForm2.Action_Font_Name(Sender: TObject);
begin
 P_Try_to_Set_Font_Name(CB_Font_Name.Text) ;
end;
{=============================}
function TForm2.F_Current_Font_Size : Integer;
begin
 Result := Memo1.Font.Size;
end;
{=============================}
procedure TForm2.FormCreate(Sender: TObject);
begin
 P_Start;
end;
{=============================}
function TForm2.F_Current_Font_Name : String;
begin
 Result := Memo1.Font.Name;
end;
{=============================}
function TForm2.F_We_Must_Save_Font_Size : BOOLEAN;
begin
 Result := ( F_Current_Font_Size <> Default_Font_Size )
 OR
 (
 (Last_Loaded_Font_Size <> F_Current_Font_Size)
 AND
 (Last_Loaded_Font_Size <> C_Error_Font_Size )
 );
end;
{=============================}
function TForm2.F_We_Must_Save_Font_Name : BOOLEAN;
begin
 Result := ( F_Current_Font_Name <> Default_Font_Name )
 OR
 (
 (Last_Loaded_Font_Name <> F_Current_Font_Name)
 AND
 (Last_Loaded_Font_Name <> C_Error_Font_Name )
 );
end;
{=============================}
procedure TForm2.P_Init_Default_Values;
begin
 Default_Font_Name := Memo1.Font.Name ;
 Default_Font_Size := Memo1.Font.Size ;
 Last_Loaded_Font_Name := C_Error_Font_Name ;
 Last_Loaded_Font_Size := C_Error_Font_Size ;
end;
{=============================}
procedure TForm2.P_Make_List_of_Font_Name;
begin
 CB_Font_Name.Items.Assign(Screen.Fonts);
end;
{=============================}
procedure TForm2.P_Make_List_of_Font_Size;
var S : TStrings; i : Integer;
begin
 S := CB_Font_Size.Items; S.Clear;
 for i := c_Font_Min to c_Font_Max do S.Add(IntToStr(i));
end;
{=============================}
end.

• Gordon Freeman: should I also add a dfm-code for my forms ?
• user34073: @ChrisJefferson If you wish.
• Gordon Freeman: Nevertheless I ask you to download this zip file and open my test project in your IDE and you'll see the sence of the question.

Answer 1

I know it's old but there is very simple solution for saving and retrieving component configuration. You can save current configuration of components using WriteComponentRes :

var
 FS : TFileStream;
 Count: Byte;
begin
 FS := TFileStream.Create(ExtractFilePath(Application.ExeName)+'Option.res',fmOpenWrite or fmCreate);
 try
 FS.WriteComponentRes(Form1.ClassName,Form1);
 finally
 FS.Free;
 end;
 // Free all components on form 1
 for Count:= Form1.ComponentCount-1 downto 0 do
 Form1.Components[0].Free;
end;

And retrieve theme using ReadComponentRes method :

var
 FS: TFileStream;
 TempForm1: TForm1;
 Count: Integer;
begin
 // Free all components on form 1
 for Count:= Form1.ComponentCount-1 downto 0 do
 Form1.Components[0].Free;
 FS := TFileStream.Create(ExtractFilePath(Application.ExeName)+'Option.res',fmOpenRead);
 try
 TempForm1 := TForm1.Create(nil);
 FS.ReadComponentRes(Form1);
 Form1 := TempForm1;
 finally
 FS.Free;
 end;
end;

You casn also use TMemoryStream instead of TFileStream to store the configuration in byte array and save and retrieve it from database.