home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / WINTIMER.BAS < prev    next >
BASIC Source File  |  1989-08-27  |  3KB  |  102 lines
  1. '************************************************************************
  2. '* 
  3. '* Program Name: WinTimer.BAS
  4. '*
  5. '* Include File: WinMisc.BI
  6. '*
  7. '* Functions   :
  8. '*               WinStartTimer
  9. '*               WinStopTimer
  10. '*               WinGetCurrentTime
  11. '*
  12. '* Description : This is a PM program which demonstrates
  13. '*               the use of WinStartTimer, WinStopTimer and
  14. '*               WinGetCurrentTime.  The program monitors sets a
  15. '*               time out for every second (1000 milliseconds). When
  16. '*               a time out occurs, a WMTIMER message is sent and
  17. '*               the current time (from WinGetCurrentTime) is written
  18. '*               to a file ("WinTimer.OUT")
  19. '*
  20. '************************************************************************
  21.  
  22. '*********         Initialization section        ***********
  23.  
  24. REM $INCLUDE: 'PMBase.BI'
  25. REM $INCLUDE: 'WinMisc.BI'
  26.  
  27. CONST IDTIMER = 1     ' Constant for WinStartTimer, WinStopTimer
  28.  
  29. DIM aqmsg AS QMSG
  30. DIM SHARED hab&
  31.  
  32. flFrameFlags& =  FCFTITLEBAR      OR FCFSYSMENU OR _
  33.                  FCFSIZEBORDER    OR FCFMINMAX  OR _
  34.                  FCFSHELLPOSITION OR FCFTASKLIST
  35.  
  36. szClientClass$ = "ClassName" + CHR$(0)
  37.  
  38. hab&  = WinInitialize    (0)
  39. hmq&  = WinCreateMsgQueue(hab&, 0)
  40.  
  41. bool% = WinRegisterClass(_
  42.         hab&,_
  43.         MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  44.         RegBas,_
  45.         0,_
  46.         0)
  47.  
  48. hwndFrame& = WinCreateStdWindow (_
  49.              HWNDDESKTOP,_
  50.              WSVISIBLE,_
  51.              MakeLong(VARSEG(flFrameFlags&),  VARPTR(flFrameFlags&)),_
  52.              MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  53.              0,_
  54.              0,_
  55.              0,_
  56.              0,_
  57.              MakeLong(VARSEG(hwndClient&), VARPTR(hwndClient&)))
  58.  
  59. '***********          WinStartTimer          ***************
  60.  
  61.     OPEN "WinTimer.OUT" FOR OUTPUT AS #1
  62.     bool% = WinStartTimer(hab&, hwndClient&, IDTIMER, 1000)
  63.  
  64. '**************         Message loop         ***************
  65.  
  66. WHILE WinGetMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)), 0, 0, 0)
  67.   bool% = WinDispatchMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)))
  68. WEND
  69.  
  70. '***********          WinStopTimer          ***************
  71.  
  72.     bool% = WinStopTimer(hab&, hwndClient&, IDTIMER)
  73.     CLOSE #1
  74.  
  75. '***********         Finalize section        ***************
  76.  
  77. bool% = WinDestroyWindow   (hwndFrame&)
  78. bool% = WinDestroyMsgQueue (hmq&)
  79. bool% = WinTerminate       (hab&)
  80.  
  81. END
  82.  
  83. '***********         Window procedure        ***************
  84.  
  85. FUNCTION ClientWndProc& (hwnd&, msg%, mp1&, mp2&) STATIC
  86.      DIM ClientRect AS RECTL
  87.      ClientWndProc& = 0
  88.      SELECT CASE msg%
  89.      CASE WMPAINT     'Paint the window with background color
  90.         hps&  = WinBeginPaint(hwnd&, 0,_
  91.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)))
  92.         bool% = WinFillRect(hps&,_
  93.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)),0)
  94.         bool% = WinEndPaint(hps&)
  95.      CASE WMTIMER      'Occurs every second (1000 milliseconds)
  96.     CurrTime& = WinGetCurrentTime(hab&)
  97.         PRINT #1,  "WinGetCurrentTime:", CurrTime&
  98.      CASE ELSE          'Pass control to system for other messages
  99.         ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  100.      END SELECT
  101. END FUNCTION
  102.