unit Unit1;

interface

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

type 
  TForm1 =class (TForm)
    Memo1: TMemo;
    Memo2: TMemo;
    Button1: TButton;
    procedure FormCreate (Sender: TObject);
    procedure Button1Click (Sender: TObject);
  end ;

var
  Form1: TForm1;

implementation

{$ R * .dfm}

{Extract common parts of the following two processes into a separate process}
procedure GetHeaps (List: TStrings);
var 
  HeapArr:array [0..9] of THandle; {For list arrays, assume 10 heaps first}
  n: Integer;
  i: Integer;
begin
   {Get the list of heaps in the process; parameter 1 of the function is the size of the array, parameter 2 is the first element of the array, and the actual number of heaps is returned}
  n: = GetProcessHeaps (Length (HeapArr), HeapArr [0]);
  List.Add (Format ('Current process has% d heaps', [n]));

  List.Add ('Their handles are:');

  for i: =0 to n-1 do
    List.Add (IntToStr (HeapArr [i]));
end ;


procedure TForm1.FormCreate (Sender: TObject);
begin
  Memo1.Clear;

  {Call public procedure, display heap handle list in Memo1}
  GetHeaps (Memo1.Lines);

  {Add the handle of the default heap again}
  Memo1.Lines.Add ('');
  Memo1.Lines.Add ('The handle of the default heap is:');
  Memo1.Lines.Add (IntToStr (GetProcessHeap));
end ;


procedure TForm1.Button1Click (Sender: TObject);
var
  MyHeap: THandle;
begin
   {create new heap}
  MyHeap: = HeapCreate (0, 1024*1024*2, 0); {Build a 2M heap}

  Memo2.Clear;

  {Call public procedure, display heap handle list in Memo2}
  GetHeaps (Memo2.Lines);

  {Add the new heap handle again}
  Memo2.Lines.Add ('');
  Memo2.Lines.Add ('The handle to the new heap is:');
  Memo2.Lines.Add (IntToStr (MyHeap));

  {Destroy new heap}
  HeapDestroy (MyHeap);
end ;

end .