memman.pas

Delphi高级开发指南是开发程序的好帮手

unit MemMan;

interface

uses
  StdCtrls, Classes;

var
  AllocCount, FreeCount: Integer;
  AllocatedList: TList;

type
  TCountButton = class (TButton)
  protected
    class function NewInstance: TObject; override;
    procedure FreeInstance; override;
  end;

implementation

uses
  Windows, SysUtils;

class function TCountButton.NewInstance: TObject;
begin
  Inc (AllocCount);
  Result := inherited NewInstance;
  AllocatedList.Add (Result);
end;

procedure TCountButton.FreeInstance;
var
  nItem: Integer;
begin
  Inc (FreeCount);
  nItem := AllocatedList.IndexOf (self);
  AllocatedList.Delete (nItem);
  inherited FreeInstance;
end;

initialization
  AllocatedList := TList.Create;

finalization
  if (AllocCount - FreeCount) <> 0 then
    MessageBox (0, pChar (
      'Objects left: ' + IntToStr (AllocCount - FreeCount)),
      'MemManager', mb_ok);
  AllocatedList.Free;
end.