home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / WINPOINT.BAS < prev    next >
BASIC Source File  |  1989-09-03  |  7KB  |  193 lines
  1. '***********************************************************
  2. '* 
  3. '* Program Name: WinPoint.BAS
  4. '*
  5. '* Include File: WinPoint.BI
  6. '*
  7. '* Functions   :
  8. '*               WinSetPointer
  9. '*               WinShowPointer
  10. '*               WinQuerySysPointer
  11. '*               WinLoadPointer
  12. '*               WinDestroyPointer
  13. '*               WinCreatePointer
  14. '*               WinQueryPointer
  15. '*               WinSetPointerPos
  16. '*               WinQueryPointerPos
  17. '*               WinQueryPointerInfo
  18. '*               WinDrawPointer
  19. '*               WinGetSysBitmap
  20. '*
  21. '* Description : This program demonstrates the various mouse
  22. '*               pointer functions. All calls are done in the
  23. '*               ClientWndProc. An array of handles for various
  24. '*               mouse pointers is set up on the creation of the
  25. '*               window. Each pointer is drawn in the window in
  26. '*               each style (normal, half-toned, inverted).
  27. '*
  28. '*               The following is a list of actions and effects
  29. '*               for this program:
  30. '*
  31. '*        Action              Effect
  32. '*        ------              ------
  33. '*        Create window       Set up array of handles
  34. '*        Key Pressed         Change mouse position (swap x,y)
  35. '*        Button 1 down       Get current handle and info then
  36. '*                            set pointer to next in array
  37. '*        Button 2 down       Make pointer invisible for 5 seconds
  38. '*        Close window        Destroy non-system pointers
  39. '***********************************************************
  40.  
  41. '*********         Initialization section        ***********
  42.  
  43. REM $INCLUDE: 'PMBase.BI'
  44. REM $INCLUDE: 'WinPoint.BI'
  45. REM $INCLUDE: 'OS2Def.BI'    Needed for POINTL
  46. REM $INCLUDE: 'WinInput.BI'    Needed for mouse and key messages
  47.  
  48. 'Number of pointers in array: all system ptrs, all system bmps, & 1 loaded ptr
  49. CONST NumPointers = SPTRCPTR + SBMPSIZEBOX + 1
  50.  
  51. DIM aqmsg AS QMSG
  52.  
  53. flFrameFlags& =  FCFTITLEBAR      OR FCFSYSMENU OR _
  54.                  FCFSIZEBORDER    OR FCFMINMAX  OR _
  55.                  FCFSHELLPOSITION OR FCFTASKLIST
  56.  
  57. szClientClass$ = "ClassName" + CHR$(0)
  58.  
  59. hab&  = WinInitialize    (0)
  60. hmq&  = WinCreateMsgQueue(hab&, 0)
  61.  
  62. bool% = WinRegisterClass(_
  63.         hab&,_
  64.         MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  65.         RegBas,_
  66.         0,_
  67.         0)
  68.  
  69. hwndFrame& = WinCreateStdWindow (_
  70.              HWNDDESKTOP,_
  71.              WSVISIBLE,_
  72.              MakeLong(VARSEG(flFrameFlags&),  VARPTR(flFrameFlags&)),_
  73.              MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  74.              0,_
  75.              0,_
  76.              0,_
  77.              0,_
  78.              MakeLong(VARSEG(hwndClient&), VARPTR(hwndClient&)))
  79.  
  80. 'Only data written to this file is PointerInfo on button 1 down
  81. OPEN "WinPoint.OUT" FOR OUTPUT AS #1
  82.  
  83. '**************         Message loop         ***************
  84.  
  85. WHILE WinGetMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)), 0, 0, 0)
  86.   bool% = WinDispatchMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)))
  87. WEND
  88.  
  89. '***********         Finalize section        ***************
  90.  
  91. CLOSE #1
  92.  
  93. bool% = WinDestroyWindow   (hwndFrame&)
  94. bool% = WinDestroyMsgQueue (hmq&)
  95. bool% = WinTerminate       (hab&)
  96.  
  97. END
  98.  
  99. '***********         Window procedure        ***************
  100.  
  101. FUNCTION ClientWndProc& (hwnd&, msg%, mp1&, mp2&) STATIC
  102.      DIM ClientRect AS RECTL
  103.      ClientWndProc& = 0
  104.      SELECT CASE msg%
  105.      CASE WMCREATE
  106.  
  107.     '** Set up array for pointer handles
  108.         DIM HPointers(NumPointers - 1) AS LONG
  109.         FOR i% = 0 TO NumPointers - 1
  110.  
  111.        IF i% < SPTRCPTR THEN      ' First part of array is sys pointers
  112.          HPointers(i%) = WinQuerySysPointer& (HWNDDESKTOP, i%+1, DPNORMAL)
  113.  
  114.        ELSEIF i% < SPTRCPTR + SBMPSIZEBOX THEN    'Second is sys bitmaps
  115.          HPointers(i%) = WinCreatePointer (HWNDDESKTOP,_
  116.                              WinGetSysBitmap&(HWNDDESKTOP, i% - SPTRCPTR),_
  117.                              1, 1, 1)
  118.  
  119.        ELSE                ' One pointer loaded from resource
  120.              HPointers(i%) = WinLoadPointer(HWNDDESKTOP, 0, 1)
  121.        END IF
  122.     NEXT i%
  123.  
  124.      CASE WMCHAR
  125.  
  126.     '** Change pointer position; swap x and y
  127.     DIM ptl AS POINTL
  128.     IF (mp1& AND KCKEYUP) = 0 THEN
  129.       Bool% = WinQueryPointerPos (HWNDDESKTOP,_
  130.                   MakeLong(VARSEG(ptl), VARPTR(ptl)))
  131.       Bool% = WinSetPointerPos   (HWNDDESKTOP, ptl.y, ptl.x)
  132.     END IF
  133.  
  134.      CASE WMBUTTON1DOWN
  135.  
  136.     '** Query current pointer and info. Then write info to file
  137.     DIM PInfo AS POINTERINFO
  138.         HPoint& = WinQueryPointer     (HWNDDESKTOP)
  139.         Bool%   = WinQueryPointerInfo (HPoint&,_
  140.                   MakeLong(VARSEG(PInfo), VARPTR(PInfo)))
  141.     PRINT #1, "Pointer  #";HIndex%
  142.     PRINT #1, "   Flags  ";HEX$(PInfo.fPointer)
  143.     PRINT #1, "   XHot   ";PInfo.xHotspot
  144.     PRINT #1, "   YHot   ";PInfo.yHotspot
  145.     PRINT #1, "   Handle ";HEX$(PInfo.hbmPointer)
  146.  
  147.     '** Set pointer to next in array
  148.     HIndex% = (HIndex% + 1) MOD NumPointers
  149.         Bool%   = WinSetPointer(HWNDDESKTOP, HPointers(HIndex%))
  150.  
  151.      CASE WMBUTTON2DOWN
  152.  
  153.     '** Make pointer invisible for 5 seconds
  154.     Bool% = WinShowPointer(HWNDDESKTOP, 0)
  155.     SLEEP 5
  156.     Bool% = WinShowPointer(HWNDDESKTOP, 1)
  157.  
  158.      CASE WMPAINT    'Paint the window with background color & display pointers
  159.  
  160.         hps&  = WinBeginPaint(hwnd&, 0,_
  161.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)))
  162.         bool% = WinFillRect(hps&,_
  163.         MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)),0)
  164.  
  165.     '** Calculate proportional spacing for pointers
  166.         yDelta% = ClientRect.yTop   \ 12
  167.     xDelta% = ClientRect.xRight \ (1 + (NumPointers \ 4))
  168.  
  169.     '** Display all pointers in all styles
  170.     FOR i% = 0 TO NumPointers - 1     'Pointer index
  171.        FOR DrawStyle% = 0 TO 2     'Style:  Normal, Half-toned, Inverted
  172.           bool% = WinDrawPointer (hps&,_
  173.                       xDelta% * (i% \ 4),_
  174.                       yDelta% * ((DrawStyle% * 4) + (i% MOD 4)),_
  175.                       HPointers(i%), DrawStyle%)
  176.        NEXT DrawStyle%
  177.     NEXT i%
  178.  
  179.     bool% = WinEndPaint(hps&)
  180.      CASE WMCLOSE
  181.  
  182.     '** Destroy all non-system pointers
  183.     FOR i% = SPTRCPTR TO NumPointers -1
  184.        Bool% = WinDestroyPointer(HPointers(i%))
  185.     NEXT i%
  186.  
  187.     '** Pass control back to default for rest of WMCLOSE
  188.         ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  189.      CASE ELSE        'Pass control to system for other messages
  190.         ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  191.      END SELECT
  192. END FUNCTION
  193.