9
\$\begingroup\$

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.
\$\endgroup\$
  • \$\begingroup\$ should I also add a dfm-code for my forms ? \$\endgroup\$ – Gordon Freeman Dec 14 '15 at 5:00
  • \$\begingroup\$ @ChrisJefferson If you wish. \$\endgroup\$ – Hosch250 Dec 14 '15 at 5:02
  • \$\begingroup\$ 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. \$\endgroup\$ – Gordon Freeman Dec 14 '15 at 5:07
1
\$\begingroup\$

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.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.