heapallocu.pas

DelphiWin32核心API参考光盘内容.是学习书籍中的源码,便于学习.

unit HeapAllocu;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    StringGrid1: TStringGrid;
    Button2: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Arrayptr: ^Byte;         // pointer to byte array
  Baseptr: Pointer;        // a pointer to access the byte array
  MyHeap: THandle;         // private heap handle
  MySize: integer;         // heap size

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
  iLoop: integer;          // loop counter
begin
  {Create a new private heap and test for errors}
  MyHeap := HeapCreate(HEAP_NO_SERIALIZE, $FFFF,0);
  if MyHeap = 0 then
  begin
    ShowMessage('Error creating private heap.');
    Exit;
  end;

  {Allocate memory for the array and test for errors}
  Arrayptr := HeapAlloc(MyHeap,HEAP_ZERO_MEMORY,200);
  if Arrayptr = nil then
  begin
    ShowMessage('Error Allocating memory');
    {release the heap if there was an error}
    if not HeapDestroy(MyHeap)
      then ShowMessage('Error destroying private heap');
  end;

  {fill memory}
  Baseptr := Arrayptr;
  for iLoop := 0 to 199 do
  begin
    Byte(Baseptr^) := iLoop;
    StringGrid1.Cells[iLoop,0] := IntToStr(Byte(Baseptr^));
    BasePtr := Pointer(Longint(BasePtr)+1);
  end;

  {How big is the heap?}
  MySize := HeapSize(MyHeap, 0, Arrayptr);
  Label1.Caption := 'HeapSize is ' + IntToStr(MySize);

  Button2.Enabled := TRUE;
  Button1.Enabled := FALSE;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  {Extend the Array size}
  Arrayptr := HeapReAlloc(MyHeap, HEAP_ZERO_MEMORY, Arrayptr, 600);
  StringGrid1.ColCount := 600;
  if Arrayptr = nil then ShowMessage('Error expanding array.');

  {check the current (expanded) size}
  MySize := HeapSize(MyHeap, 0, Arrayptr);
  Label1.Caption := 'HeapSize is ' + IntToStr(MySize);

  {We're done, release the memory}
  if not HeapFree(MyHeap,0,Arrayptr)
    then ShowMessage('Error returning memory to heap.');

  {Destroy the heap}
  if not HeapDestroy(MyHeap)
    then ShowMessage('Error destroying heap.');
end;

end.