home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / GPICOLOR.BAS < prev    next >
BASIC Source File  |  1989-09-11  |  10KB  |  272 lines
  1. '************************************************************************
  2. '* 
  3. '* Program Name: GpiColor.BAS
  4. '*
  5. '* Include File: GpiColor.BI
  6. '*
  7. '* Functions   :
  8. '*               GpiSetBackColor
  9. '*               GpiQueryBackColor
  10. '*               GpiSetColor
  11. '*               GpiQueryColor
  12. '*               GpiCreateLogColorTable
  13. '*               GpiRealizeColorTable     called, but no effect in OS2 1.10
  14. '*               GpiUnrealizeColorTable   called, but no effect in OS2 1.10
  15. '*               GpiQueryColorData
  16. '*               GpiQueryLogColorTable
  17. '*               GpiQueryRealColors
  18. '*               GpiQueryNearestColor
  19. '*               GpiQueryColorIndex
  20. '*               GpiQueryRGBColor
  21. '*
  22. '* Description : This program demonstrates the functions from GpiColor.BI.
  23. '*               By adjusting the size of the window, the image adjusts
  24. '*               to be proportional to the window size.  The program also
  25. '*               writes results of non-visual functions to "GpiColor.OUT".
  26. '*
  27. '*               The display is either a palette of color bars or a shading
  28. '*               of 2 colors.  The user chooses between these options with
  29. '*               the menu defined in GpiColor.RC
  30. '*
  31. '*               In the color bars, each bar also has a marker to show
  32. '*               background color.  The palette can be changed by pressing
  33. '*               a mouse button.  Button 1 will move the first color to
  34. '*               the end and shift everything down.  Button 2 will choose
  35. '*               random colors.
  36. '*
  37. '*               The shading option allows the user to display 81 shades
  38. '*               of combinations of any two of the three primary colors.
  39. '************************************************************************
  40.  
  41. '*********         Initialization section        ***********
  42.  
  43. REM $INCLUDE: 'PMBase.BI'
  44. REM $INCLUDE: 'OS2Def.BI'
  45. REM $INCLUDE: 'WinMan1.BI'
  46. REM $INCLUDE: 'WinInput.BI'
  47. REM $INCLUDE: 'GpiColor.BI'
  48. REM $INCLUDE: 'GpiLine.BI'
  49. REM $INCLUDE: 'GpiArea.BI'
  50. REM $INCLUDE: 'GpiMark.BI'
  51.  
  52. DIM aqmsg AS QMSG
  53.  
  54. OPEN "GpiColor.Out" FOR OUTPUT AS #1
  55.  
  56. flFrameFlags&  = FCFTITLEBAR      OR FCFSYSMENU  OR _
  57.                  FCFSIZEBORDER    OR FCFMINMAX   OR _
  58.                  FCFSHELLPOSITION OR FCFTASKLIST OR _
  59.                  FCFMENU
  60.  
  61. szClientClass$ = "ClassName" + CHR$(0)
  62.  
  63. hab&  = WinInitialize    (0)
  64. hmq&  = WinCreateMsgQueue(hab&, 0)
  65.  
  66. bool% = WinRegisterClass(_
  67.         hab&,_
  68.         MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  69.         RegBas,_
  70.         CSSIZEREDRAW,_
  71.         0)
  72.  
  73. hwndFrame& = WinCreateStdWindow (_
  74.              HWNDDESKTOP,_
  75.              WSVISIBLE,_
  76.              MakeLong (VARSEG(flFrameFlags&),  VARPTR(flFrameFlags&)),_
  77.              MakeLong (VARSEG(szClientClass$), SADD  (szClientClass$)),_
  78.              0,_
  79.              0,_
  80.              0,_
  81.              1,_
  82.              MakeLong (VARSEG(hwndClient&), VARPTR(hwndClient&)))
  83.  
  84. RANDOMIZE TIMER
  85.  
  86. '**************         Message loop         ***************
  87.  
  88. WHILE WinGetMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)), 0, 0, 0)
  89.   bool% = WinDispatchMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)))
  90. WEND
  91.  
  92. '***********         Finalize section        ***************
  93.  
  94. CLOSE #1
  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.      DIM ptl AS POINTL
  107.      DIM alTable&(16)
  108.      DIM alData&(2)
  109.      ClientWndProc& = 0
  110.      SELECT CASE msg%
  111.      CASE WMCREATE
  112.         hps&   = WinGetPS       (hwnd&)
  113.  
  114.         DisplayFlag% = 1           'Default display is color bars
  115.         bool%  = GpiSetBackMix  (hps&, BMOVERPAINT) 'SetBackMix to show Background
  116.         bool%  = GpiSetMarkerSet(hps&, LCIDDEFAULT) 'SetMarker  to show Background
  117.         bool%  = GpiSetMarker   (hps&, MARKSYMDOT)
  118.  
  119.         '**** Test non-displaying GpiColor functions
  120.  
  121.         Result&  = GpiQueryBackColor(hps&)
  122.         PRINT #1, "GpiQueryBackColor:", HEX$(Result&)
  123.  
  124.         Result&  = GpiQueryColor(hps&)
  125.         PRINT #1, "GpiQueryColor:", HEX$(Result&)
  126.  
  127.         Result&  = GpiQueryLogColorTable(hps&, 0, 0, 16,_
  128.                    MakeLong(VARSEG(alTable&(0)), VARPTR(alTable&(0))))
  129.         PRINT #1, "GpiQueryLogColorTable:", Result&
  130.         CALL PrintTable(alTable&())
  131.  
  132.         bool%    = GpiQueryColorData(hps&, 3,_
  133.                    MakeLong(VARSEG(alData&(0)),VARPTR(alData&(0))))
  134.         PRINT #1, "GpiQueryColorData:", bool%
  135.         PRINT #1, "Color Data:"
  136.         PRINT #1, "Format:",  HEX$(alData&(0))
  137.         PRINT #1, "LoIndex:", HEX$(alData&(1))
  138.         PRINT #1, "HiIndex:", HEX$(alData&(2))
  139.  
  140.         Result&  = GpiQueryRealColors(hps&, LCOLOPTREALIZED, 0, 16,_
  141.                    MakeLong(VARSEG(alTable&(0)), VARPTR(alTable&(0))))
  142.         PRINT #1, "GpiQueryRealColors:", Result&
  143.         CALL PrintTable(alTable&())
  144.  
  145.         Result&  = GpiQueryNearestColor(hps&, LCOLOPTREALIZED, &HFFFF)
  146.         PRINT #1, "GpiQueryNearestColor:", HEX$(Result&)
  147.  
  148.         Result&  = GpiQueryColorIndex(hps&, LCOLOPTREALIZED, 1)
  149.         PRINT #1, "GpiQueryColorIndex:", Result&
  150.  
  151.         Result&  = GpiQueryRGBColor(hps&, LCOLOPTREALIZED, 4)
  152.         PRINT #1, "GpiQueryRGBColor:", HEX$(Result&)
  153.  
  154.      CASE WMBUTTON1DOWN         'Button 1 causes palette cycle
  155.  
  156.         Result& = GpiQueryLogColorTable(hps&, 0, 0, 16,_
  157.                   MakeLong(VARSEG(alTable&(0)), VARPTR(alTable&(0))))
  158.         alTable&(16) = alTable&(0)
  159.         bool% = GpiCreateLogColorTable(hps&, LCOLREALIZABLE,_
  160.                 LCOLFCONSECRGB, 0, 16,_
  161.                 MakeLong(VARSEG(alTable&(1)), VARPTR(alTable&(1))))
  162.  
  163.         '*** RealizeColorTable should physically change palette, but it has
  164.         bool%    = GpiRealizeColorTable(hps&)        'no effect in OS/2 1.1
  165.         PRINT #1, "GpiRealizeColorTable:", bool%
  166.  
  167.         ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  168.         bool% = WinSendMsg(hwnd&, WMPAINT, 0, 0)
  169.  
  170.      CASE WMBUTTON2DOWN         'Button 2 sets a random palette
  171.  
  172.         FOR i% = 0 TO 15
  173.            alTable&(i%) =  RND * &HFFFFFF
  174.         NEXT i%
  175.         bool% = GpiCreateLogColorTable(hps&,LCOLREALIZABLE,_
  176.                 LCOLFCONSECRGB, 0, 16,_
  177.                 MakeLong(VARSEG(alTable&(0)), VARPTR(alTable&(0))))
  178.         ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  179.         bool% = WinSendMsg(hwnd&, WMPAINT, 0, 0)
  180.  
  181.      CASE WMCOMMAND          'Menu items to choose color bars or shading
  182.         CALL BreakLong(mp1&, hiword%, DisplayFlag%)
  183.         bool% = WinSendMsg(hwnd&, WMPAINT, 0, 0)
  184.      CASE WMPAINT            'Paint draws color bars and markers or shading
  185.         bool% = WinInvalidateRect(hwnd&, 0, 0)
  186.  
  187.         hps2& = WinBeginPaint(hwnd&, 0,_
  188.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)))
  189.         bool% = WinFillRect(hps&,_
  190.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)),0)
  191.  
  192.         IF DisplayFlag% = 1 THEN
  193.            'draw color bars
  194.            ptl.x  = 0
  195.            delta& = ClientRect.xRight / 16
  196.            FOR c% = 0 TO 15
  197.               ptl.y = 0
  198.               bool% = GpiMove(hps&, MakeLong(VARSEG(ptl), VARPTR(ptl)))
  199.               bool% = GpiSetColor (hps&, c%)
  200.               ptl.y = ClientRect.yTop
  201.               ptl.x = ptl.x + delta&
  202.               bool% = GpiBox(hps&, DROFILL,_
  203.                       MakeLong(VARSEG(ptl), VARPTR(ptl)), 0, 0)
  204.            NEXT c%
  205.  
  206.            'draw markers
  207.            ptl.x  = ClientRect.xRight / 32
  208.            ptl.y  = ClientRect.yTop / 2
  209.            FOR c% = 0 TO 15
  210.               bool% = GpiSetColor (hps&, c%)
  211.               bool% = GpiSetBackColor (hps&, 15 - c%)
  212.               bool% = GpiMarker(hps&, MakeLong(VARSEG(ptl), VARPTR(ptl)))
  213.               ptl.x = ptl.x + delta&
  214.            NEXT c%
  215.         ELSE
  216.            SELECT CASE DisplayFlag%
  217.               CASE 2
  218.                  xFactor& = &H10
  219.                  yFactor& = &H1000
  220.               CASE 3
  221.                  xFactor& = &H1000
  222.                  yFactor& = &H100000
  223.               CASE 4
  224.                  xFactor& = &H100000
  225.                  yFactor& = &H10
  226.               CASE ELSE
  227.            END SELECT
  228.  
  229.            deltaY& = ClientRect.yTop / 16
  230.            deltaX& = ClientRect.xRight / 16
  231.            ptl.x  = 0
  232.  
  233.            FOR dx% = 0 TO 15
  234.               FOR dy% = 0 TO 15
  235.               Clr& = dx% * xFactor& + dy% * yFactor&
  236.               bool% = GpiCreateLogColorTable(hps&,LCOLREALIZABLE,_
  237.                       LCOLFCONSECRGB,1,1,_
  238.                       MakeLong(VARSEG(Clr&), VARPTR(Clr&)))
  239.               ptl.x = dx% * deltaX&
  240.               ptl.y = dy% * deltaY&
  241.               bool% = GpiMove(hps&, MakeLong(VARSEG(ptl), VARPTR(ptl)))
  242.               bool% = GpiSetColor (hps&, 1)
  243.               ptl.y = ptl.y + deltaY&
  244.               ptl.x = ptl.x + deltaX&
  245.               bool% = GpiBox(hps&, DROFILL,_
  246.                       MakeLong(VARSEG(ptl), VARPTR(ptl)), 0, 0)
  247.               NEXT dy%
  248.            NEXT dx%
  249.         END IF
  250.  
  251.         bool% = WinEndPaint(hps2&)
  252.  
  253.      CASE WMCLOSE
  254.  
  255.         '*** UnrealizeColorTable should set palette back to default, but has
  256.         bool%    = GpiUnrealizeColorTable(hps&)       'no effect in OS/2 1.1
  257.         PRINT #1, "GpiUnrealizeColorTable:", bool%
  258.         ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  259.  
  260.      CASE ELSE        'Pass control to system for other messages
  261.         ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  262.      END SELECT
  263. END FUNCTION
  264.  
  265.  
  266. SUB PrintTable(alTable&())
  267.    PRINT #1, "Color Table:"
  268.    FOR i% = 0 TO 15
  269.       PRINT #1, "", i%, HEX$(alTable&(i%))
  270.    NEXT i%
  271. END SUB
  272.