home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / WINTRACK.BAS < prev    next >
BASIC Source File  |  1989-08-27  |  4KB  |  129 lines
  1. '***********************************************************
  2. '* 
  3. '* Program Name: WinTrack.BAS
  4. '*
  5. '* Include File: WinTrack.BI
  6. '*
  7. '* Functions   :
  8. '*               WinTrackRect
  9. '*               WinShowTrackRect  Not shown; see below
  10. '*
  11. '* Description : This program demonstrates using the tracking
  12. '*               rectangle.  Every time mouse button 1 is
  13. '*               pressed, the mouse (or keyboard) movement
  14. '*               is tracked and the new location is printed to
  15. '*               the file "WinTrack.OUT".  WinShowTrackRect is
  16. '*               not demonstrated because the only time this
  17. '*               function would be used is during asynchronous
  18. '*               drawing in different threads.  Since BASIC
  19. '*               does not support multi-threaded applications,
  20. '*               this function is not useful.  It has been left
  21. '*               in the INCLUDE file for possible future
  22. '*               implementations.
  23. '***********************************************************
  24.  
  25. '*********         Initialization section        ***********
  26.  
  27. REM $INCLUDE: 'PMBase.BI'
  28. REM $INCLUDE: 'OS2Def.BI'      Needed for POINTL for TRACKINFO
  29. REM $INCLUDE: 'WinTrack.BI'
  30. REM $INCLUDE: 'WinInput.BI'    Needed for mouse messages
  31.  
  32. DIM aqmsg AS QMSG
  33.  
  34. flFrameFlags& =  FCFTITLEBAR      OR FCFSYSMENU OR _
  35.                  FCFSIZEBORDER    OR FCFMINMAX  OR _
  36.                  FCFSHELLPOSITION OR FCFTASKLIST
  37.  
  38. szClientClass$ = "ClassName" + CHR$(0)
  39.  
  40. hab&  = WinInitialize    (0)
  41. hmq&  = WinCreateMsgQueue(hab&, 0)
  42.  
  43. bool% = WinRegisterClass(_
  44.         hab&,_
  45.         MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  46.         RegBas,_
  47.         0,_
  48.         0)
  49.  
  50. hwndFrame& = WinCreateStdWindow (_
  51.              HWNDDESKTOP,_
  52.              WSVISIBLE,_
  53.              MakeLong (VARSEG(flFrameFlags&),  VARPTR(flFrameFlags&)),_
  54.              MakeLong (VARSEG(szClientClass$), SADD(szClientClass$)),_
  55.              0,_
  56.              0,_
  57.              0,_
  58.              0,_
  59.              MakeLong (VARSEG(hwndClient&), VARPTR(hwndClient&)))
  60.  
  61. OPEN "WinTrack.OUT" FOR OUTPUT AS #1
  62.  
  63. '**************         Message loop         ***************
  64.  
  65. WHILE WinGetMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)), 0, 0, 0)
  66.   bool% = WinDispatchMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)))
  67. WEND
  68.  
  69. '***********         Finalize section        ***************
  70.  
  71. CLOSE #1
  72. bool% = WinDestroyWindow   (hwndFrame&)
  73. bool% = WinDestroyMsgQueue (hmq&)
  74. bool% = WinTerminate       (hab&)
  75.  
  76. END
  77.  
  78. '***********         Window procedure        ***************
  79.  
  80. FUNCTION ClientWndProc& (hwnd&, msg%, mp1&, mp2&) STATIC
  81.      DIM ti         AS TRACKINFO
  82.      DIM ClientRect AS RECTL
  83.      ClientWndProc& = 0
  84.      SELECT CASE msg%
  85.      CASE WMBUTTON1DOWN           'Track mouse whenever button is down
  86.  
  87.         IF ti.cxBorder  = 0 THEN      'Initialize track info
  88.       ti.cxBorder    = 1
  89.       ti.cyBorder    = 1
  90.       ti.cxGrid    = 4
  91.       ti.cyGrid    = 4
  92.       ti.cxKeyboard = 4
  93.       ti.cyKeyboard = 4
  94.  
  95.       ti.rclTrack.xLeft   = 0
  96.       ti.rclTrack.yBottom = 0
  97.       ti.rclTrack.xRight  = 32
  98.       ti.rclTrack.yTop    = 32
  99.  
  100.       ti.rclBoundary.xLeft     = 0
  101.       ti.rclBoundary.yBottom = 0
  102.       ti.rclBoundary.xRight  = 640
  103.       ti.rclBoundary.yTop     = 480
  104.  
  105.       ti.ptlMinTrackSize.x = 2
  106.       ti.ptlMinTrackSize.y = 2
  107.  
  108.       ti.ptlMaxTrackSize.x = 512
  109.       ti.ptlMaxTrackSize.y = 512
  110.  
  111.       ti.fs = TFMOVE OR TFSTANDARD
  112.     END IF
  113.  
  114.     '*** Track rectangle and print new location to file
  115.  
  116.     bool% = WinTrackRect (HWNDDESKTOP, 0, MakeLong(VARSEG(ti), VARPTR(ti)))
  117.         PRINT #1, "("; ti.rclTrack.xLeft;  ","; ti.rclTrack.yBottom; ") - ";
  118.         PRINT #1, "("; ti.rclTrack.xRight; ","; ti.rclTrack.yTop;    ")"
  119.      CASE WMPAINT     'Paint the window with background color
  120.         hps&  = WinBeginPaint(hwnd&, 0,_
  121.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)))
  122.         bool% = WinFillRect(hps&,_
  123.         MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)),0)
  124.         bool% = WinEndPaint(hps&)
  125.      CASE ELSE        'Pass control to system for other messages
  126.         ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  127.      END SELECT
  128. END FUNCTION
  129.