Classes aninhadas: um uso prático

Olá!

Há um recurso muito interessante no Object Pascal que é a classe aninhada - nested classes em inglês. É um recurso existente em Java e .NET a tempos.

A grosso modo permite você implementar uma classe dentro de outra. O ganho disso é você conseguir elaborar uma classe "auto-suficiente", protegendo - se for este o caso - as soluções que você desenvolveu.

Bom, indo ao ponto. Desenvolvi a unit abaixo exemplificando a implementação de uma classe aninhada. Para efeitos didáticos o objetivo do programa é o seguinte:

Implementar um liberador de objetos.

Para isso, desenvolvi a classe TLiberador que é descendente de TObject. Ela implementa, então, a classe TLiberadorThread que por sua vez descende de TThread.

Logo, TLiberadorThread só é visível pela classe TLiberador e é isso que é o pulo do gato.

Compartilho da opinião que a legibilidade do código fica inicialmente comprometida mas creio ser uma questão de adaptação.

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, SyncObjs, Contnrs, ComCtrls, Unt_MemoryMonitor,
  Unt_RotinasLog;

type

  {
    Classe responsável por liberar objetos
  }
  TLiberador = class(TObject)
  strict private type {<== Declaração de tipo dentro da classe!}
    TLiberadorThread = class(TThread)
    strict private
      FQueue: TObjectQueue;
      FCritical: TCriticalSection;
      procedure WhenTerminate(Sender: TObject);
    protected
      procedure Execute; override;
    public
      procedure AfterConstruction; override;
      procedure BeforeDestruction; override;
      procedure AddObject(poObject: TObject);
    end;
  strict private
    FDetail: TLiberadorThread; {<== Instância da classe aninhadaS}
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    procedure AddObject(poObject: TObject);
  end;

  {
    Formulário com um botão que adiciona um objeto na pilha
  }
  TForm2 = class(TForm)
    Button1: TButton;
    g4MemoryMonitor1: Tg4MemoryMonitor;
    StatusBar1: TStatusBar;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    FTeste: TLiberador;
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

{ TLiberador.TLiberadorThread }

procedure TLiberador.TLiberadorThread.AddObject(poObject: TObject);
begin
  Self.FCritical.Enter;
  try
    Self.FQueue.Push(poObject);
  finally
    Self.FCritical.Release;
  end;
end;

procedure TLiberador.TLiberadorThread.AfterConstruction;
begin
  inherited;
  Self.OnTerminate := Self.WhenTerminate;
  Self.FQueue := TObjectQueue.Create;
  Self.FCritical := TCriticalSection.Create;
end;

procedure TLiberador.TLiberadorThread.BeforeDestruction;
begin
  inherited;
  Self.FQueue.Free;
  Self.FCritical.Free;
end;

procedure TLiberador.TLiberadorThread.Execute;
begin
  inherited;
  NameThreadForDebugging(AnsiString(Self.ToString));
  IdentificarPID(Self.ToString);
  while not (Self.Terminated) do
  begin
    Sleep(10);
    if (Self.FQueue.Count > 0) then
    begin
      Self.FQueue.Pop.Free;
    end;
  end;
end;

procedure TLiberador.TLiberadorThread.WhenTerminate(Sender: TObject);
begin
  Sleep(10);
end;

{ TLiberador }

procedure TLiberador.AddObject(poObject: TObject);
begin
  Self.FDetail.AddObject(poObject);
end;

procedure TLiberador.AfterConstruction;
begin
  inherited;
  Self.FDetail := TLiberadorThread.Create(True);
  Self.FDetail.Start;
end;

procedure TLiberador.BeforeDestruction;
begin
  inherited;
  Self.FDetail.Terminate;
  if not (Self.FDetail.Suspended) then
    Self.FDetail.WaitFor;
  Self.FDetail.Free;
end;

{ TForm2 }

procedure TForm2.Button1Click(Sender: TObject);
begin
  Self.FTeste.AddObject(TObject.Create);
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  Self.g4MemoryMonitor1.Active := True;
  Self.FTeste := TLiberador.Create;
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
  Self.FTeste.Free;
end;

end.

Existem outras novidades que talvez os programadores Delphi da "old school" não conheçam (a começar por mim). Dê uma olhada neste link: http://edn.embarcadero.com/article/34324