unit hdFreeUtilities;
 
interface
 
uses
  Messages, Windows, Classes;
 
const
  // Nachricht, die den FreeManager dazu veranlasst, ein Objekt freizugeben
  WM_FREE_OBJECT = WM_USER + 0;
 
type
  // Der FreeManager - Eine Instanz wird bereits bei Unit-Initialisierung erzeugt.
 
  TFreeManager = class(TObject)
  private
    FFreeList: TList;
 
    FWndHandle: HWND;
  protected
    procedure WndProcFreeObj(var Msg: TMessage); message WM_FREE_OBJECT;
 
  public
    function PostFree(AObject: TObject): Boolean;
 
    procedure FreeObjects;
 
    constructor Create();
    destructor Destroy; override;
  end;
 
  // Alle hiervon abgeleiteten Objekte können sich über die eigene Methode PostFree selbst freigeben
 
  TOwnFreeObject = class(TObject)
  public
    procedure PostFree;
  end;
 
  // Postfree kann auch unabhängig von bereits verwendeten FreeManagern benutzt werden:
  // es wird dann der Unit-lokale FreeManager verwendet
 
function PostFree(AObj: TObject): Boolean;
 
implementation
 
var
  FreeManager: TFreeManager; // Lokaler FreeManager
 
  ///
  /// Diese Funktion gibt das übergebene Objekt nach einer gewissen Zeit frei.
  ///
  ///  TFreeManager.PostFree
 
function PostFree(AObj: TObject): Boolean;
begin
  Result := FreeManager.PostFree(AObj);
end;
 
{ TFreeManager }
 
constructor TFreeManager.Create;
begin
  inherited;
 
  FFreeList := TList.Create();
  FWndHandle := Classes.AllocateHWnd(WndProcFreeObj);
end;
 
destructor TFreeManager.Destroy;
begin
  FreeObjects;
  FFreeList.Free;
  Classes.DeallocateHWnd(FWndHandle);
 
  inherited;
end;
 
///
/// Mit dieser Funktion wird ein angegebenes Objekt nach einer gewissen Zeit freigegeben.
/// Ein Objekt kann sich so also in seiner eigenen Routine freigeben,
/// allerdings wird das Objekt dann erst freigegeben, wenn alle Routinen abgearbeitet wurden.
///
///  Das freizugebende Objekt
///
/// False, wenn das Objekt in diesem FreeManager bereits freigegeben wurde
/// True, wenn alles erfolgreich war
///
 
function TFreeManager.PostFree(AObject: TObject): Boolean;
begin
  Result := Assigned(AObject) and (FFreeList.IndexOf(AObject)  -1) then
  begin
    FFreeList.Delete(Index);
    AObject.Free;
  end;
end;
 
{ TOwnFreeObject }
 
///
/// Über diese Prozedur kann sich das von TOwnFreeObject abgeleitete Objekt selbst freigeben.
///
 
procedure TOwnFreeObject.PostFree;
begin
  FreeManager.PostFree(Self)
end;
 
///
/// Initialierung und finalisierung des lokalen FreeManagers
///
 
initialization
  FreeManager := TFreeManager.Create();
 
finalization
  FreeManager.Free;
 
end.
