söndag 28 juli 2024

How to remove dependencies in uses for dialogs with interfaces

The target for this post is to show how you can use interfaces to decouple units in your application.
Good developers know that loose coupling between units is a good thing. This is usually done with interfaces.

Consider this small application:

MainForm.pas
unit MainForm;


interface

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

type
  TMain = class(TForm)
    lblResult: TLabel;
    btnResult: TButton;
    txtResult: TEdit;
    procedure btnResultClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Main: TMain;

implementation

{$R *.dfm}

uses
  Dialog;  // Dialog must be here in uses

procedure TMain.btnResultClick(Sender: TObject);
var
  sName: string;
begin
  sName := TDialogForm.Execute(txtResult.Text);
  if sName <> '' then
  begin
    txtResult.Text := sName;
  end;
end;

end.

MainForm.dfm
object Main: TMain
  Left = 0
  Top = 0
  Caption = 'Main'
  ClientHeight = 87
  ClientWidth = 187
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -12
  Font.Name = 'Segoe UI'
  Font.Style = []
  TextHeight = 15
  object lblResult: TLabel
    Left = 8
    Top = 54
    Width = 32
    Height = 15
    Caption = 'Result'
  end
  object btnResult: TButton
    Left = 8
    Top = 20
    Width = 159
    Height = 25
    Caption = 'Get result'
    TabOrder = 0
    OnClick = btnResultClick
  end
  object txtResult: TEdit
    Left = 46
    Top = 51
    Width = 121
    Height = 23
    TabOrder = 1
  end
end

Dialog.pas
unit Dialog;

interface

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

type
  TDialogForm = class(TForm)
    btnOk: TButton;
    btnCancel: TButton;
    lblName: TLabel;
    txtName: TEdit;
  public
    class function Execute(const AName: string): string;
  end;

implementation

{$R *.dfm}

{ TDialogForm }

class function TDialogForm.Execute(const AName: string): string;
var
  oDialog: TDialogForm;
begin
  oDialog := TDialogForm.Create(nil);
  oDialog.txtName.Text := AName;
  if oDialog.ShowModal = mrOk then
  begin
    Result := oDialog.txtName.text;
  end;
end;

end.

Dialog.dfm
object DialogForm: TDialogForm
  Left = 0
  Top = 0
  BorderIcons = [biMinimize, biMaximize]
  BorderStyle = bsDialog
  Caption = 'Dialog'
  ClientHeight = 114
  ClientWidth = 216
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -12
  Font.Name = 'Segoe UI'
  Font.Style = []
  DesignSize = (
    216
    114)
  TextHeight = 15
  object lblName: TLabel
    Left = 24
    Top = 24
    Width = 32
    Height = 15
    Caption = 'Name'
  end
  object btnOk: TButton
    Left = 50
    Top = 68
    Width = 65
    Height = 31
    Anchors = [akRight, akBottom]
    Caption = '&Ok'
    Default = True
    ModalResult = 1
    TabOrder = 0
  end
  object btnCancel: TButton
    Left = 137
    Top = 68
    Width = 71
    Height = 31
    Anchors = [akRight, akBottom]
    Cancel = True
    Caption = '&Cancel'
    ModalResult = 2
    TabOrder = 1
  end
  object txtName: TEdit
    Left = 62
    Top = 21
    Width = 150
    Height = 23
    TabOrder = 2
    TextHint = 'Enter any name here'
  end
end

InterfaceDemo.dpr
program InterfaceDemo;

uses
  Vcl.Forms,
  MainForm in 'MainForm.pas' {Main},
  Dialog in 'Dialog.pas' {DialogForm};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TMain, Main);
  Application.Run;
end.


Now I want to be able to create the dialog without have the dialog unit in uses. To do this I can use interfaces. It doesn't matter in this small demo but can be nice in an application with hundreds of forms.

First a new unit GUIAsInterface.pas
It has 3 interfaces

type
  IInterfaceRegistry = interface
  ['{1F44813F-A8EA-4C5C-B7E9-34626108C171}']
    procedure RegisterClass(const IID: TGUID; aClass: TComponentClass);
  end;

  IGuiDialog = interface
  ['{22E22636-9312-4606-90CB-497D1E07FF2F}']
    function ShowModalForm(ACustomForm: TCustomForm): integer;
  end;

  IGUI = interface
    ['{49C1E5D8-92CE-486C-9082-FC257C1F2A6A}']
    function GuiDialog: IGuiDialog;
    procedure RegisterForm(const IID: TGUID; aClass: TComponentClass); overload;
  end;

Some records and classes that implements the interfaces

type
  TInterfaceClassRegistryEntry = record
    IID: TGUID;
    ComponentClass: TComponentClass;
  end;

  TInterfaceInstanceRegistryEntry = record
    IID: TGUID;
    InstanceAsComponent: TComponent;
  end;

  TClassRegistryArray = array of TInterfaceClassRegistryEntry;
  TInterfaceRegistryArray = array of TInterfaceInstanceRegistryEntry;

  TInterfaceRegistry = class(TComponent, IInterfaceRegistry)
  private
    fClasses: TClassRegistryArray;
    fInstances: TInterfaceRegistryArray;
    class var _Instance: IInterfaceRegistry;
    procedure InternalRegisterInstance(const IID: TGUID; aComponent: TComponent; out Obj);
    function FindClass(const IID: TGUID): TComponentClass;
    procedure RegisterClass(const IID: TGUID; aClass: TComponentClass);
  protected
    function QueryInterface(const IID: TGUID; out Obj): HResult; override;
  public
    procedure BeforeDestruction; override;
  end;

  TGUI = class(TInterfaceRegistry, IGUI)
  private
    function GuiDialog: IGuiDialog;
    procedure RegisterForm(const IID: TGUID; aClass: TComponentClass); overload;
  end;

And a global method

function GUI: IGUI;
begin
  if not Assigned(TInterfaceRegistry._Instance) then
  begin
    if _UnitFinalized then
      Raise Exception.Create('Attempt to access Gui after finalization.')
    else
      TInterfaceRegistry._Instance := TGui.Create(Application);
  end;
  result := TInterfaceRegistry._Instance as IGUI;
end;

uInterfaces.pas containing the interfaces. In this case only one.
unit uInterfaces;

interface

type
  IForm = interface

  end;

  ITestDlg = interface
  ['{E80A465B-6908-47B7-AC12-0835D4DE79AD}']
    function Execute(const AName: string): string;
  end;

implementation

end.

The idea is to have array of classes and interfaces in TInterfaceRegistry.
At startup all interfaces are registred to a form in initialization section of the form.
To add more forms and interfaces just add them to uInterfaces.pas and modify the dialog to implement the new interface like this


type
  TDialogForm = class(TForm, ITestDlg)

The registration

initialization
  Gui.RegisterForm(ITestDlg, TDialogForm);

As GUIAsInterface now handle the create and free of dialog it cane be removed from Execute in Dialog.pas

So when the form is needed all you need to do is (GUI as someInterface).someMethod where someInterface and SomeMethod can be anything.

In this case the dialog is created with

  sName := (GUI as ITestDlg).Execute(txtResult.Text);

Method Execute can have any signature. It is decided in uInterfaces.pas.

The complete project that use interfaces is committed to 

torsdag 6 juli 2023

DVD Sale

 These DVD's are for sale

Price: 1 € per DVD. If a season contains 5 DVD's this means 5 €
BlueRay 2 € per DVD


Title Year More info Comment
Brothers 2009 Image
The killing 2009 Image Second season 5 discs. Danish with subtitles in Finnish, Swedish and Norwegian
Hearbreakers 2001 Image