home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / WINSYS.BAS < prev    next >
BASIC Source File  |  1989-08-27  |  4KB  |  118 lines
  1. '***********************************************************
  2. '* 
  3. '* Program Name: WinSys.BAS
  4. '*
  5. '* Include File: WinSys.BI
  6. '*
  7. '* Functions   :
  8. '*               WinQuerySysValue
  9. '*               WinSetSysValue
  10. '*               WinQuerySysColor
  11. '*               WinSetSysColors
  12. '*
  13. '* Description : This is a test of the WinSys include file.
  14. '*               It queries and sets the system value for
  15. '*               double-click and the system colors for 
  16. '*               frame and background.
  17. '***********************************************************
  18.  
  19. '*********         Initialization section        ***********
  20.  
  21. REM $INCLUDE: 'PMBase.BI'
  22. REM $INCLUDE: 'WinSys.BI'
  23. REM $INCLUDE: 'GpiColor.BI'    Needed for LCOLFINDRGB constant
  24.  
  25. DIM aqmsg AS QMSG
  26.  
  27. flFrameFlags& =  FCFTITLEBAR      OR FCFSYSMENU OR _
  28.                  FCFSIZEBORDER    OR FCFMINMAX  OR _
  29.                  FCFSHELLPOSITION OR FCFTASKLIST
  30.  
  31. szClientClass$ = "ClassName" + CHR$(0)
  32.  
  33. hab&  = WinInitialize    (0)
  34. hmq&  = WinCreateMsgQueue(hab&, 0)
  35.  
  36. bool% = WinRegisterClass(_
  37.         hab&,_
  38.         MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  39.         RegBas,_
  40.         0,_
  41.         0)
  42.  
  43. hwndFrame& = WinCreateStdWindow (_
  44.              HWNDDESKTOP,_
  45.              WSVISIBLE,_
  46.              MakeLong(VARSEG(flFrameFlags&),  VARPTR(flFrameFlags&)),_
  47.              MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  48.              0,_
  49.              0,_
  50.              0,_
  51.              0,_
  52.              MakeLong(VARSEG(hwndClient&), VARPTR(hwndClient&)))
  53.  
  54. '**************         Sys Calls         *****************
  55.  
  56. ' get original and set new double-click with WinxxxxSysValue
  57.  
  58. ClickSpeed& = WinQuerySysValue&(HWNDDESKTOP,SVDBLCLKTIME)
  59. bool%       = WinSetSysValue   (HWNDDESKTOP,SVDBLCLKTIME,5000)
  60.  
  61. ' get original colors for frame and background and switch
  62.  
  63. BackGround& = WinQuerySysColor(HWNDDESKTOP,SYSCLRWINDOW,0)
  64. ForeFrame&  = WinQuerySysColor(HWNDDESKTOP,SYSCLRWINDOWFRAME,0)
  65.  
  66. bool% = WinSetSysColors(HWNDDESKTOP,  0,_
  67.         LCOLFCONSECRGB, SYSCLRWINDOW, 1,_
  68.         MakeLong(VARSEG(ForeFrame&),  VARPTR(ForeFrame&)))
  69.  
  70. bool% = WinSetSysColors(HWNDDESKTOP,       0,_
  71.         LCOLFCONSECRGB, SYSCLRWINDOWFRAME, 1,_
  72.         MakeLong(VARSEG(BackGround&),      VARPTR(BackGround&)))
  73.  
  74. '**************         Message loop         ***************
  75.  
  76. WHILE WinGetMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)), 0, 0, 0)
  77.   bool% = WinDispatchMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)))
  78. WEND
  79.  
  80. '***********         More Sys Calls         ****************
  81.  
  82. 'reset values to originals
  83.  
  84. bool% = WinSetSysColors(HWNDDESKTOP,       0,_
  85.         LCOLFCONSECRGB, SYSCLRWINDOWFRAME, 1,_
  86.         MakeLong(VARSEG(ForeFrame&),       VARPTR(ForeFrame&)))
  87.  
  88. bool% = WinSetSysColors(HWNDDESKTOP,  0,_
  89.         LCOLFCONSECRGB, SYSCLRWINDOW, 1,_
  90.         MakeLong(VARSEG(BackGround&), VARPTR(BackGround&)))
  91.  
  92. bool% = WinSetSysValue (HWNDDESKTOP,SVDBLCLKTIME,ClickSpeed&)
  93.  
  94. '***********         Finalize section        ***************
  95.  
  96. bool% = WinDestroyWindow   (hwndFrame&)
  97. bool% = WinDestroyMsgQueue (hmq&)
  98. bool% = WinTerminate       (hab&)
  99.  
  100. END
  101.  
  102. '***********         Window procedure        ***************
  103.  
  104. FUNCTION ClientWndProc& (hwnd&, msg%, mp1&, mp2&) STATIC
  105.      DIM ClientRect AS RECTL
  106.      ClientWndProc& = 0
  107.      SELECT CASE msg%
  108.      CASE WMPAINT     'Paint the window with background color
  109.         hps&  = WinBeginPaint(hwnd&, 0,_
  110.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)))
  111.         bool% = WinFillRect(hps&,_
  112.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)),0)
  113.         bool% = WinEndPaint(hps&)
  114.      CASE ELSE        'Pass control to system for other messages
  115.         ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  116.      END SELECT
  117. END FUNCTION
  118.