{
This example demonstrates the use of SetMemoryManager and
GetMemoryManager routines. Note that this example is
thread safe.
}
var
  OldMemMgr       : TMemoryManagerEx;
  GetMemCalls     : Integer;
  FreeMemCalls    : Integer;
  ReallocMemCalls : Integer;
  AllocMemCalls   : Integer;

function MyGetMem(Size: Integer): Pointer;
begin
  { Route the call }
  Result := OldMemMgr.GetMem(Size);

  { Safely increment the counter }
  InterlockedIncrement(GetMemCalls);
end;

function MyFreeMem(P: Pointer): Integer;
begin
  { Route the call }
  Result := OldMemMgr.FreeMem(P);

  { Safely increment the counter }
  InterlockedIncrement(FreeMemCalls);
end;

function MyReallocMem(P: Pointer; Size: Integer): Pointer;
begin
  { Route the call }
  Result := OldMemMgr.ReallocMem(P, Size);

  { Safely increment the counter }
  InterlockedIncrement(ReallocMemCalls);
end;

function MyAllocMem(Size: Cardinal): Pointer;
begin
  { Route the call }
  Result := OldMemMgr.AllocMem(Size);

  { Safely increment the counter }
  InterlockedIncrement(AllocMemCalls);
end;

procedure TForm2.btPerformSomethingClick(Sender: TObject);
var
  X : Integer;
  I : ^Integer;
begin
  { Perform some allocations and frees }
  for X := 0 to 999 do
  begin
    New(I);
    Dispose(I);
  end;
end;

procedure TForm2.btUseMyMemMgrClick(Sender: TObject);
var
  MyMemMgr : TMemoryManagerEx;
begin
  { Switch button states }
  btUseSystemMemMgr.Enabled := true;
  btUseMyMemMgr.Enabled := false;

  { Get the old memory manager }
  GetMemoryManager(OldMemMgr);

  { Create our instance }
  MyMemMgr.GetMem := MyGetMem;
  MyMemMgr.FreeMem := MyFreeMem;
  MyMemMgr.ReallocMem := MyReallocMem;
  MyMemMgr.AllocMem := MyAllocMem;

  { Use the defaults for this - not important }
  MyMemMgr.RegisterExpectedMemoryLeak := OldMemMgr.RegisterExpectedMemoryLeak;
  MyMemMgr.UnregisterExpectedMemoryLeak := OldMemMgr.UnregisterExpectedMemoryLeak;

  { Clear out the count variables }
  GetMemCalls := 0;
  FreeMemCalls := 0;
  ReallocMemCalls := 0;
  AllocMemCalls := 0;

  { Install the new memory manager }
  SetMemoryManager(MyMemMgr);
end;

procedure TForm2.btUseSystemMemMgrClick(Sender: TObject);
begin
  { Switch button states }
  btUseSystemMemMgr.Enabled := false;
  btUseMyMemMgr.Enabled := true;

  { Set the old memory manager back! }
  SetMemoryManager(OldMemMgr);

  GetMemCalls := 0;
  FreeMemCalls := 0;
  ReallocMemCalls := 0;
  AllocMemCalls := 0;
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
  { Set the old memory manager back }
  if IsMemoryManagerSet then
     SetMemoryManager(OldMemMgr);
end;

procedure TForm2.Timer1Timer(Sender: TObject);
begin
  {
  Note that IntToStr calls will also Allocate/Free
  memory so at each timer tick the counts will be increased;
  }
  Form2.edtGetMemCalls.Text := IntToStr(GetMemCalls);
  Form2.edtFreeMemCalls.Text := IntToStr(FreeMemCalls);
  Form2.edtReallocMemCalls.Text := IntToStr(ReallocMemCalls);
  Form2.edtAllocMemCalls.Text := IntToStr(AllocMemCalls);
end;