Memorija zauzeta Objektom

Code:

  IGetMem = interface
    function GetOwnMem: integer;
  end;

  TMyClass = class(TPersistent, IGetMem)
    ...
  end;

Code:

  TFramesList = array of array of TByteMap; // Graphig32 mapa bytova velicine HxW. Koristim je kao 256color bitmap uz pomoc palete (koja nema veze sa mojim objektom, eksterna je).
  TFramesHeader = array of array of THeader_Frame; //2xmatrica obicanih rekord. 8xCardinal.
  THeaderStatus = record
    StatusMain   : TDC6_HeaderStatus_Main; // Set od 7 elemenata.
    StatusFrames : TDC6_FramesStatus;// 2xmatrica setova od 6 elemenata.
  end;
TMasksList = array of array of TBitsMap; //2xmatrica. Izvedeno od TBooleanMap iz Grapgic32. Mapa boolova koristim je za masku pri iscrtavanju bitmapa.

TMy_Decoder = class (TObject)  
    FHeader_Main   : THeader_Main;  //Rekord. 6xCardinal +1 Dinamicki niz Cardinala(maximalna duzine koju cu koristit je 256x256 elemenata. Realno koristim oko 100).
    FHeader_Frame  : TFramesHeader;  
    FHeaderStatus  : THeaderStatus;
    FDecoderStatus : TStatus_Decoder; // Set od 7 elemenata.
    FFrames        : TFramesList;      
    FMasks         : TMasksList;       
    ...

Code:
procedure TMyDecoder.CalculateOcupatedSpace;
var I,II:Integer;
begin
{Sam object + THeader_Main}
    FMemory_Used:=InstanceSize;
    FMemory_Used:=FMemory_Used+Length(FHeader_Main.Offsets)*4;
    FMemory_Used:=FMemory_Used+Length(FHeader_Frame)*(Length(FHeader_Frame[0])+1)*SizeOf(THeader_Frame);
{Zauzeto TFramesList}
    for I:=0 to Length(FFrames)-1 do
    for II:=0 to Length(FFrames[I])-1 do
      begin 
      // Velicina slike+Objekt
      FMemory_Used:=FMemory_Used+(FFrames[I,II].Width*FFrames[I,II].Height)+FFrames[I,II].InstanceSize;
      end;
    FMemory_Used:=FMemory_Used+(Length(FFrames)*(Length(FFrames[0])+1))*4;
{Zauzeto TMasksList}
    for I:=0 to Length(FMasks)-1 do
    for II:=0 to Length(FMasks[I])-1 do
      begin
      // Velicina maske u bajtovima+Objekt
      FMemory_Used:=FMemory_Used+Ceil(FMasks[I,II].Width*FMasks[I,II].Height/8)+FMasks[I,II].InstanceSize;
      end;
    FMemory_Used:=FMemory_Used+(Length(FMasks)*(Length(FMasks[0])+1))*4;
{Zauzeto THeaderStatus}
    for I:=0 to Length(FHeaderStatus.StatusFrames)-1 do
    for II:=0 to Length(FHeaderStatus.StatusFrames[I])-1 do
      begin
      FMemory_Used:=FMemory_Used+(SizeOf(FHeaderStatus.StatusFrames[I,II]));
      end;
    FMemory_Used:=FMemory_Used+(Length(FHeaderStatus.StatusFrames)*(Length(FHeaderStatus.StatusFrames[0])+1))*SizeOf(FHeaderStatus.StatusFrames);
{Ostali elementi}
    FMemory_Used:=FMemory_Used+SizeOf(FHeaderStatus.StatusMain);
    FMemory_Used:=FMemory_Used+SizeOf(FDecoderStatus);
end;

Code:

unit MyMM;

interface

function MyAlloc(Size: Integer): Pointer;
function MyFree(P: Pointer): Integer;
function MyRealloc(P: Pointer; Size: Integer): Pointer;

const MyMemMgr: TMemoryManager = (GetMem: MyAlloc; FreeMem: MyFree; ReallocMem: MyRealloc);

var
  TotalSize: Integer = 0;
  OldMM: TMemoryManager;

implementation

uses
  Windows, SysUtils;

function MyAlloc(Size: Integer): Pointer;
begin
  Result := OldMM.GetMem(Size);
  InterlockedExchangeAdd(TotalSize, Size);
end;

function MyFree(P: Pointer): Integer;
var
  Size: Integer;
begin
  Size := SizeOf(P);
  Result := OldMM.FreeMem(P);
  InterlockedExchangeAdd(TotalSize, -Size);
end;

function MyRealloc(P: Pointer; Size: Integer): Pointer;
var
  OldSize: Integer;
begin
  OldSize := SizeOf(P);
  Result := OldMM.ReallocMem(P, Size);
  InterlockedExchangeAdd(TotalSize, -OldSize);
  InterlockedExchangeAdd(TotalSize, Size);
end;

initialization
  GetMemoryManager(OldMM);
  SetMemoryManager(MyMemMgr);
end.

Code:

  OldSize := SizeOf(P);

Code:

  Size := MyMM.GetAllocatedSize(GetCurrentThreadID);
  ...
  //kreiranje objekata
  ...
  Size := MyMM.GetAllocatedSize(GetCurrentThreadID) - Size;

Code:

unit MyMM;

interface

uses
  Classes;

function MyAlloc(Size: Integer): Pointer;
function MyFree(P: Pointer): Integer;
function MyRealloc(P: Pointer; Size: Integer): Pointer;

function GetMemUsageList: String;
function GetMySize(var P): Integer;
function GetAllocatedSize(ThreadID: Cardinal = 0): Integer;

const MyMemMgr: TMemoryManager = (GetMem: MyAlloc; FreeMem: MyFree; ReallocMem: MyRealloc);

var
  OldMM: TMemoryManager;
  AllocList: TThreadList;

type
  PMemRec = ^TMemRec;
  TMemRec = record
    P: Pointer;
    Size: Integer;
    ThreadID: Cardinal;
  end;

implementation

uses
  Windows, SysUtils;

function FindRec(P: Pointer): PMemRec;
var
  I: Integer;
  Lst: TList;
begin
  Result := nil;
  Lst := AllocList.LockList;
  try
    for I := 0 to Lst.Count - 1 do
      if PMemRec(Lst[I]).P = P then
      begin
        Result := PMemRec(Lst[I]);
        break;
      end;
  finally
    AllocList.UnlockList;
  end;
end;

function MyAlloc(Size: Integer): Pointer;
var
  Rec: PMemRec;
begin
  Result := OldMM.GetMem(Size);
  Rec := OldMM.GetMem(SizeOf(TMemRec));
  Rec.Size := Size;
  Rec.P := Result;
  Rec.ThreadID := GetCurrentThreadId;
  AllocList.Add(Rec);
end;

function MyFree(P: Pointer): Integer;
var
  Rec: PMemRec;
begin
  Result := OldMM.FreeMem(P);
  Rec := FindRec(P);
  if Rec <> nil then
  begin
    AllocList.Remove(Rec);
    OldMM.FreeMem(Rec);
  end;
end;

function MyRealloc(P: Pointer; Size: Integer): Pointer;
var
  Rec: PMemRec;
begin
  Result := OldMM.ReallocMem(P, Size);
  Rec := FindRec(P);
  if Rec <> nil then
  begin
    Rec.P := Result;
    Rec.Size := Size;
    Rec.ThreadID := GetCurrentThreadId;
  end;
end;

function GetMemUsageList: String;
var
  I: Integer;
  Lst: TList;
  Rec: PMemRec;
begin
  Result := '';
  Lst := AllocList.LockList;
  try
    for I := 0 to Lst.Count - 1 do
    begin
      Rec := Lst[I];
      Result := Result + IntToHex(Integer(Rec.P), 8) + ': ' + IntToStr(Rec.Size) + ' b, ThreadID=' + IntToHex(Rec.ThreadID, 8) + #13#10;
    end;
  finally
    AllocList.UnlockList;
  end;
end;

function GetMySize(var P): Integer;
var
  Rec: PMemRec;
begin
  Rec := FindRec(Pointer(P));
  if Rec <> nil then
    Result := Rec.Size
  else
    Result := 0;
end;

function GetAllocatedSize(ThreadID: Cardinal = 0): Integer;
var
  Lst: TList;
  I: Integer;
begin
  Result := 0;
  Lst := AllocList.LockList;
  try
    for I := 0 to Lst.Count - 1 do
      if (ThreadID = 0) or (ThreadID = PMemRec(Lst[I]).ThreadID) then
        Inc(Result, PMemRec(Lst[I]).Size);
  finally
    AllocList.UnlockList;
  end;
end;

initialization
  AllocList := TThreadList.Create;
  AllocList.LockList.Capacity := 65536;
  AllocList.UnlockList;
  GetMemoryManager(OldMM);
  SetMemoryManager(MyMemMgr);

finalization
  SetMemoryManager(OldMM);
  AllocList.Free;
end.