globalreallocu.pas

Delphi Win32核心API参考光盘

unit GlobalReAllocu;

interface

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

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

var
  Form1: TForm1;
  Arrayptr: ^Byte;        // pointer to a dynamic array
  Arrayhandle: HGLOBAL;   // handle to the array object
  PtrHandle: HGLOBAL;     // handle from GlobalHandle
  UnlockResult: Boolean;  // Unlock error checking
  ArrayFlags: integer;    // result of GlobalFlags call
  FreeResult: Hglobal;    // Free error checking
  FlagCount: integer;     // number of lock flags set
  Arraysize : integer;    // size of the memory object

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
  iLoop: Byte;             // loop counter
  Baseptr: Pointer;        // temporary pointer
begin
  {allocate global memory}
  Arrayhandle := GlobalAlloc(GHND,200);

  {retrieve a pointer to the global memory}
  Arrayptr := GlobalLock(Arrayhandle);

  {do something with the global memory block}
  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;

  {retrieve a pointer from the global memory handle}
  PtrHandle := GlobalHandle(Arrayptr);
  if PtrHandle <> Arrayhandle then
    ShowMessage('Memory Object Handle Error');

  {retrieve information on the global memory block}
  ArrayFlags := GlobalFlags(PtrHandle);
  Flagcount := ArrayFlags and GMEM_LOCKCOUNT;
  Showmessage('# of global locks on Arrayhandle is '
                 +IntToStr(Flagcount));

  {get the size of the global memory block}
  ArraySize := GlobalSize(PtrHandle);
  Showmessage('Initial object size is ' + IntToStr(Arraysize));

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


procedure TForm1.Button2Click(Sender: TObject);
var
  iLoop: Integer;
  Baseptr: Pointer;
begin
  {unlock the global memory block. this is not required
   if GMEM_FIXED was set on allocation.}
  if Flagcount > 0 then GlobalUnlock(Arrayhandle);

  {discard the memory block}
  Arrayhandle := GlobalDiscard(Arrayhandle);
  if Arrayhandle = 0 then
  begin
    ShowMessage('GlobalDiscard failed');
    exit;
  end;

  {our global memory handle is still valid}
  Arraysize := GlobalSize(Arrayhandle);
  Showmessage('Discarded object size is ' + IntToStr(Arraysize));

  {reallocate global memory}
  Arrayhandle := GlobalReAlloc(Arrayhandle,400,GMEM_ZEROINIT);
  if Arrayhandle = 0 then
  begin
    ShowMessage('Error in GlobalAlloc');
    exit;
  end;

  {retrieve the new size of the global memory block}
  ArraySize := GlobalSize(Arrayhandle);
  Showmessage('ReAlloc''ed object size is ' + IntToStr(ArraySize));

  {do something with the new memory block}
  StringGrid1.ColCount := ArraySize;
  Baseptr := Arrayptr;
  for iLoop := 0 to 399 do
  begin
    StringGrid1.Cells[iLoop,0] := IntToStr(Byte(Baseptr^));
    BasePtr := Pointer(Longint(BasePtr)+1);
  end;

  {unlock the global memory block}
  SetLastError(NO_ERROR);           //Reset error trapping
  UnlockResult := GlobalUnlock(Arrayhandle);
  if UnlockResult then ShowMessage('Lock count is nonzero');
  if (not UnlockResult) and (GetLastError <> NO_ERROR) then
    ShowMessage('Error unlocking memory');

  {Free the global memory and invalidate its handle. Note
   that GlobalFree will free a locked memory block, and calling
   GlobalUnlock will not affect the behaviour of GlobalFree.}
  FreeResult := GlobalFree(Arrayhandle);
  if (FreeResult <> 0)
    then ShowMessage('Error Freeing Memory');
end;

end.