RAD Studio My easy way to Create Forms and delete old forms already created based on Class of Forms

[emailx45]

My easy way to Create Forms and delete old forms already created based on Class of Forms

Спойлер: Code source

[SHOWTOGROUPS=4,20,22]

Спойлер: Code FormMain

unit uFormMain;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.StdCtrls;

type
  TfrmFormMain = class(TForm)
    btnCreateFormSecond: TButton;
    btnCreateFormThird: TButton;
    btnFormOnMemory: TButton;
    procedure btnCreateFormSecondClick(Sender: TObject);
    procedure btnCreateFormThirdClick(Sender: TObject);
    procedure btnFormOnMemoryClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmFormMain: TfrmFormMain;

implementation

{$R *.dfm}
//
// ReportMemoryLeaksOnShutdown := true; // in DPR file for report leak memory!
//

uses
  uUnitGlobalFunctions,
  uFormSecond,
  uFormThird;

procedure TfrmFormMain.btnCreateFormSecondClick(Sender: TObject);
var
  lMyNewForm: TForm;
begin
  lMyNewForm := prcCreateMyNewForm(TfrmFormSecond);
  //
  if not(lMyNewForm = nil) then
    lMyNewForm.ShowModal;
end;

procedure TfrmFormMain.btnCreateFormThirdClick(Sender: TObject);
var
  lMyNewForm: TForm;
begin
  lMyNewForm := prcCreateMyNewForm(TfrmFormThird);
  //
  if not(lMyNewForm = nil) then
    lMyNewForm.ShowModal;
end;

procedure TfrmFormMain.btnFormOnMemoryClick(Sender: TObject);
begin
  prcHowFormsOnMemory;
end;

procedure TfrmFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  try
    prcCloseAllFormsOnMemory;
  except
    on E: Exception do
    begin
      Action := TCloseAction.caNone;
      ShowMessage('My error:' + sLineBreak + E.Message);
    end;
  end;
end;

end.

Спойлер: Code UniGlobalFunctions

unit uUnitGlobalFunctions;

interface

uses
  System.SysUtils,
  Vcl.Forms,
  Vcl.Dialogs;

procedure prcHowFormsOnMemory;
procedure prcCloseAllFormsOnMemory;
function prcCreateMyNewForm(lNewFormClass: TFormClass): TForm;

var
  OldFormToClose: TForm;

implementation

uses
  uFormMain;

function prcCreateMyNewForm(lNewFormClass: TFormClass): TForm;
var
  i: integer;
begin
  if (not(OldFormToClose = nil)) and (OldFormToClose.ClassName = lNewFormClass.ClassName) then
  begin
    result := OldFormToClose;
    ShowMessage('same class is not possible delete it for while');
    exit;
  end;
  //
  if (not(OldFormToClose = nil)) and { }
    (not(OldFormToClose = frmFormMain)) then
  begin
    FreeAndNil(OldFormToClose);
  end;
  //
  result := lNewFormClass.Create(nil); // "nil", user should "free" this object!
  //
  OldFormToClose := result;
end;

procedure prcHowFormsOnMemory;
var
  i    : integer;
  lText: string;
begin
  lText   := '';
  for i   := 0 to (Screen.FormCount - 1) do
    lText := Screen.Forms[i].Name + sLineBreak + lText;
  //
  ShowMessage('Forms on memory:' + sLineBreak + lText);
end;

procedure prcCloseAllFormsOnMemory;
var
  i: integer;
begin
  for i := 0 to (Screen.FormCount - 1) do
  begin
    if not(Screen.Forms[i] = frmFormMain) then
      Screen.Forms[i].Free;
  end;
end;

end.

Спойлер: Code FormSecond

unit uFormSecond;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.StdCtrls;

type
  TfrmFormSecond = class(TForm)
    btnFormOnMemory: TButton;
    procedure btnFormOnMemoryClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmFormSecond: TfrmFormSecond;

implementation

{$R *.dfm}

uses
  uUnitGlobalFunctions;

procedure TfrmFormSecond.btnFormOnMemoryClick(Sender: TObject);
begin
  prcHowFormsOnMemory;
end;

end.

Спойлер: Code FormThird

unit uFormThird;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.StdCtrls;

type
  TfrmFormThird = class(TForm)
    btnFormOnMemory: TButton;
    btnRecreateFormThird: TButton;
    procedure btnFormOnMemoryClick(Sender: TObject);
    procedure btnRecreateFormThirdClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmFormThird: TfrmFormThird;

implementation

{$R *.dfm}

uses
  uUnitGlobalFunctions;

procedure TfrmFormThird.btnFormOnMemoryClick(Sender: TObject);
begin
  prcHowFormsOnMemory;
end;

procedure TfrmFormThird.btnRecreateFormThirdClick(Sender: TObject);
begin
  prcCreateMyNewForm(TfrmFormThird);
end;

end.

[/SHOWTOGROUPS]