home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / WINHEAP.BAS < prev    next >
BASIC Source File  |  1989-09-14  |  4KB  |  123 lines
  1. '************************************************************************
  2. '* 
  3. '* Program Name: WinHeap.BAS
  4. '*
  5. '* Include File: WinMisc.BI
  6. '*
  7. '* Functions   :
  8. '*               WinCreateHeap
  9. '*               WinDestroyHeap
  10. '*               WinAvailMem
  11. '*               WinAllocMem
  12. '*               WinReallocMem
  13. '*               WinFreeMem
  14. '*               WinLockMem
  15. '*
  16. '* Description : This program demonstrates allocating memory using
  17. '*               the heap functions provided with the Presentation
  18. '*               Manager. The allocated memory information is written
  19. '*               to a data file called "WinHeap.OUT".
  20. '************************************************************************
  21.  
  22. '*********         Initialization section        ***********
  23.  
  24. REM $INCLUDE: 'PMBase.BI'
  25. REM $INCLUDE: 'WinMisc.BI'
  26. CONST TRUE = 1
  27. CONST KByte = 1024
  28.  
  29. DIM aqmsg AS QMSG
  30.  
  31. flFrameFlags& =  FCFTITLEBAR      OR FCFSYSMENU OR _
  32.                  FCFSIZEBORDER    OR FCFMINMAX  OR _
  33.                  FCFSHELLPOSITION OR FCFTASKLIST
  34.  
  35. szClientClass$ = "ClassName" + CHR$(0)
  36.  
  37. hab&  = WinInitialize    (0)
  38. hmq&  = WinCreateMsgQueue(hab&, 0)
  39.  
  40. bool% = WinRegisterClass(_
  41.         hab&,_
  42.         MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  43.         RegBas,_
  44.         0,_
  45.         0)
  46.  
  47. hwndFrame& = WinCreateStdWindow (_
  48.              HWNDDESKTOP,_
  49.              WSVISIBLE,_
  50.              MakeLong (VARSEG(flFrameFlags&),  VARPTR(flFrameFlags&)),_
  51.              MakeLong (VARSEG(szClientClass$), SADD(szClientClass$)),_
  52.              0,_
  53.              0,_
  54.              0,_
  55.              0,_
  56.              MakeLong (VARSEG(hwndClient&), VARPTR(hwndClient&)))
  57.  
  58. '**************       WinHeap        **************
  59.  
  60. OPEN "WinHeap.OUT" FOR OUTPUT AS #1
  61.  
  62. ' Creating heap of 16K
  63.      hHeap& = WinCreateHeap(0,16*KByte,2*KByte,0,0,HMVALIDSIZE OR HMMOVEABLE)
  64.      Avail% = WinAvailMem  (hHeap&,TRUE,0)
  65.      PRINT #1,"Available Memory after WinCreateHeap:  ";HEX$(Avail%)
  66.  
  67. ' Allocating 1K block on heap
  68.      Alloc% = WinAllocMem(hHeap&,KByte)
  69.      Avail% = WinAvailMem(hHeap&,TRUE,0)
  70.      PRINT #1,"Available Memory after WinAllocMem 1024 bytes:  ";HEX$(Avail%)
  71.  
  72. ' Reallocating block to 1/2K
  73.      RAlloc%= WinReallocMem(hHeap&,Alloc%,KByte,KByte/2)
  74.      Avail% = WinAvailMem  (hHeap&,TRUE,0)
  75.      PRINT #1,"Available Memory after WinReallocMem 1024 to 512 bytes: ";HEX$(Avail%)
  76.  
  77. ' Freeing up 1/2K block of heap
  78.      Free%    = WinFreeMem (hHeap&,Alloc%,KByte/2)
  79.      Avail%   = WinAvailMem(hHeap&,TRUE,0)
  80.      PRINT #1,"Available Memory after WinFreeMem 512 bytes:  ";HEX$(Avail%)
  81.  
  82. 'Locking and getting Address of heap
  83.      WLock& = WinLockHeap(hHeap&)
  84.      PRINT #1,"Address of beginning of the heap after WinLockHeap: ";HEX$(WLock&)
  85.  
  86. ' Destroying the 16K heap
  87.      hHeap& = WinDestroyHeap(hHeap&)
  88.      Avail% = WinAvailMem   (hHeap&,TRUE,16*KByte)
  89.      PRINT #1,"Available Memory after WinDestroyHeap:  ";Avail%
  90.  
  91. CLOSE #1
  92.  
  93. '**************         Message loop         ***************
  94.  
  95. WHILE WinGetMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)), 0, 0, 0)
  96.   bool% = WinDispatchMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)))
  97. WEND
  98.  
  99. '***********         Finalize section        ***************
  100.  
  101. bool% = WinDestroyWindow   (hwndFrame&)
  102. bool% = WinDestroyMsgQueue (hmq&)
  103. bool% = WinTerminate       (hab&)
  104.  
  105. END
  106.  
  107. '***********         Window procedure        ***************
  108.  
  109. FUNCTION ClientWndProc& (hwnd&, msg%, mp1&, mp2&) STATIC
  110.      DIM ClientRect AS RECTL
  111.      ClientWndProc& = 0
  112.      SELECT CASE msg%
  113.      CASE WMPAINT     'Paint the window with background color
  114.         hps&  = WinBeginPaint(hwnd&, 0,_
  115.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)))
  116.         bool% = WinFillRect(hps&,_
  117.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)),0)
  118.         bool% = WinEndPaint(hps&)
  119.      CASE ELSE          'Pass control to system for other messages
  120.         ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  121.      END SELECT
  122. END FUNCTION
  123.