Skip to main content
Code Review

Return to Question

Bumped by Community user
Bumped by Community user
Bumped by Community user
Bumped by Community user
deleted 119 characters in body
Source 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;
 //CB_Font_Name.Style := csDropDown;

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;
 try
 if Memo1.Font.Name <> s_Font_Name then try Memo1.Font.Name := s_Font_Name except end;
 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.
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;
 //CB_Font_Name.Style := csDropDown;

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;
 try
 if Memo1.Font.Name <> s_Font_Name then try Memo1.Font.Name := s_Font_Name except end;
 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.
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.
edited tags; edited title
Link
200_success
  • 145.5k
  • 22
  • 190
  • 479

Delphi XE 7 test project (templatetemplate for production application)saving / loading form settings

Tweeted twitter.com/StackCodeReview/status/676285400655265796
Post Reopened by Community Bot, Quill, Phrancis, Heslacher, Mathieu Guindon
added 4 characters in body
Source Link
Heslacher
  • 50.9k
  • 5
  • 83
  • 177

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

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 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 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.

edited title
Link
Phrancis
  • 20.5k
  • 6
  • 69
  • 155
Loading
edited title
Source Link
Loading
edited title
Link
Loading
added 23 characters in body
Source Link
user34073
user34073
Loading
added 20179 characters in body
Source Link
Loading
Post Closed as "Not suitable for this site" by Quill, holroy, Mathieu Guindon
Source Link
Loading
default

AltStyle によって変換されたページ (->オリジナル) /