home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / TPBOOK / MEMALLOC.PAS < prev    next >
Pascal/Delphi Source File  |  1992-08-07  |  1KB  |  53 lines
  1. {  MEMALLOC.PAS
  2.    Demonstrates use of the Turbo Vision MemAlloc function.
  3. }
  4. Program DemoMemAlloc;
  5. uses
  6.     Memory;
  7. label 99;
  8. var
  9.    APointer  : Pointer;
  10.    I : Integer;
  11.  
  12. function HeapFunc(Size : Word): Integer; far;
  13. { Returns 1 = force memory manager to return NIL on out of memory
  14.   set to alternate values as shown:
  15.           0 = force a Heap Overflow error
  16.           2 = tells the memory manger to try again (for instance,
  17.               you might dispose of some items in this routine, thereby
  18.               freeing up some memory)
  19. }
  20. begin
  21.  
  22.   HeapFunc := 1;
  23.  
  24. end;
  25.  
  26.  
  27. begin
  28.   { Initialize the Heap Overflow checker }
  29.   HeapError := @HeapFunc;
  30.  
  31.   { Allocate some blocks of memory until running out of free space.
  32.     You may have to use a value higher than 20 or a larger block size }
  33.   for i:=1 to 20 do
  34.   begin
  35.     APointer := MemAlloc(20000);
  36.  
  37.     writeln(longint(Apointer));
  38.     if  APointer = NIL  then
  39.     begin
  40.        writeln('OUT OF MEMORY');
  41.        Goto 99;
  42.     end;
  43.  
  44.     Write('Press Enter to continue');
  45.     readln;
  46.   end;
  47.  
  48. 99:
  49.   Write('Program completed.  Press Enter to continue');
  50.   Readln;
  51.  
  52. end.
  53.