Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Освобождение памяти

unit MemMan;

interface

var
  GetMemCount, FreeMemCount,
    ReallocMemCount: Integer;

implementation

uses
  Windows, SysUtils;

var
  OldMemMgr: TMemoryManager;

function NewGetMem(Size: Integer): Pointer;
begin
  Inc(GetMemCount);
  Result := OldMemMgr.GetMem(Size);
end;

function NewFreeMem(P: Pointer): Integer;
begin
  Inc(FreeMemCount);
  Result := OldMemMgr.FreeMem(P);
end;

function NewReallocMem(P: Pointer; Size: Integer): Pointer;
begin
  Inc(ReallocMemCount);
  Result := OldMemMgr.ReallocMem(P, Size);
end;

const
  NewMemMgr: TMemoryManager = (
    GetMem: NewGetMem;
    FreeMem: NewFreeMem;
    ReallocMem: NewReallocMem);

initialization
  GetMemoryManager(OldMemMgr);
  SetMemoryManager(NewMemMgr);

finalization
  SetMemoryManager(OldMemMgr);
  if (GetMemCount - FreeMemCount) <> 0 then
    MessageBox(0, pChar(
      'Objects left: ' + IntToStr(GetMemCount - FreeMemCount)),
      'MemManager', mb_ok);
end.
unit MemForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    BtnRefresh1: TButton;
    BtnCreateNil: TButton;
    BtnCreateOwner: TButton;
    BtnGetMem: TButton;
    LblResult: TLabel;
    Btn100Strings: TButton;
    Bevel1: TBevel;
    BtnRefresh2: TButton;
    procedure BtnRefresh1Click(Sender: TObject);
    procedure BtnCreateNilClick(Sender: TObject);
    procedure BtnCreateOwnerClick(Sender: TObject);
    procedure BtnGetMemClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Btn100StringsClick(Sender: TObject);
    procedure BtnRefresh2Click(Sender: TObject);
  public
    procedure Refresh;
    procedure Refresh2;
  end;

var
  Form1: TForm1;

implementation

uses MemMan;

{$R *.DFM}

procedure TForm1.Refresh;
begin
  LblResult.Caption :=
    'Allocated: ' + IntToStr(GetMemCount) + #13 +
    'Free: ' + IntToStr(FreeMemCount) + #13 +
    'Existing: ' +
    IntToStr(GetMemCount - FreeMemCount) + #13 +
    'Re-allocated: ' + IntToStr(ReallocMemCount);
end;

procedure TForm1.Refresh2;
begin
  LblResult.Caption := Format(
    'Allocated: %d'#13'Free: %d'#13'Existing: %d'#13'Re-allocated %d'      ,
    [GetMemCount, FreeMemCount,
    GetMemCount - FreeMemCount, ReallocMemCount]);
end;

procedure TForm1.BtnRefresh1Click(Sender: TObject);
begin
  Refresh;
end;

procedure TForm1.BtnCreateNilClick(Sender: TObject);
begin
  TButton.Create(nil);
  Refresh;
end;

procedure TForm1.BtnCreateOwnerClick(Sender: TObject);
begin
  TButton.Create(self);
  Refresh;
end;

procedure TForm1.BtnGetMemClick(Sender: TObject);
var
  P: Pointer;
begin
  GetMem(P, 100);
  Integer(P^) := 0;
  Refresh;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Refresh;
end;

procedure TForm1.Btn100StringsClick(Sender: TObject);
var
  s1, s2: string;
  I: Integer;
begin
  s1 := 'hi';
  s2 := Btn100Strings.Caption;
  for I := 1 to 100 do
    s1 := s1 + ': hello world';
  Btn100Strings.Caption := s1;
  s1 := s2;
  Btn100Strings.Caption := s1;
  Refresh;
end;

procedure TForm1.BtnRefresh2Click(Sender: TObject);
begin
  Refresh2;
end;

end.
Скачать весь проект
Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.