home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PASDEMO2.ZIP / GRAPHT3.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-01-16  |  1.7 KB  |  59 lines
  1. program UserHeapManagement;
  2. { Illustarates how the user can steal the heap }
  3. { management routines used by the Graph unit }
  4.  
  5. uses
  6.    Graph;
  7.  
  8. var
  9.    GraphDriver, GraphMode: integer;
  10.    ErrorCode             : integer;  { Used to store GraphResult return code }
  11.    PreGraphExitProc: pointer;
  12.  
  13. {$F+}   { User routines must be far call model }
  14.  
  15. procedure MyGetMem( var P: Pointer; Size: word );
  16. { Allocate memory for graphics device drivers }
  17.    begin
  18.       GetMem( P, Size );
  19.    end; { of proc MyGetMem }
  20.  
  21. procedure MyFreeMem( var P: pointer; Size: word );
  22. { Deallocate memory for graphics device drivers }
  23.    begin
  24.       write( 'MyFreeMem was called, <HIT RETURN>:' ); readln;
  25.       if P <> nil then begin   { Don't free Nil pointers! }
  26.          FreeMem( P, Size );
  27.          P := nil;
  28.       end
  29.    end; { of proc MyFreeMem }
  30.  
  31. procedure MyExitProc;
  32. { Always gets called when program terminates }
  33.    begin
  34.       ExitProc := PreGraphExitProc;   { Restore original exit proc }
  35.       CloseGraph;                     { Do heap clean up }
  36.    end; { of proc MyExitProc }
  37.  
  38. {$F-}
  39.  
  40. begin
  41.    { install clean-up routine }
  42.    PreGraphExitProc := ExitProc;
  43.    ExitProc := @MyExitProc;
  44.  
  45.    GraphGetMemPtr := @MyGetMem;     { Steal memory allocation }
  46.    GraphFreeMemPtr := @MyFreeMem;   { Stral memory de-allocation }
  47.  
  48.    GraphDriver := Detect;
  49.    InitGraph( GraphDriver, GraphMode, '' );
  50.    ErrorCode := GraphResult;
  51.    if ErrorCode <> grOK then begin
  52.       writeln( 'Graphics error: ', GraphErrorMsg( ErrorCode ) );
  53.       readln;
  54.       Halt(1);
  55.    end;
  56.    Line( 0, 0, GetMaxX, GetMaxY );
  57.    OutTextXY( 1, 1, 'Press <RETURN>: ' );
  58.    readln;
  59. end.   { of prog UserHeapManagement }