home *** CD-ROM | disk | FTP | other *** search
/ Eagles Nest BBS 6 / Eagles_Nest_Mac_Collection_Disc_6.TOAST / Windows / VisBasAPIex / VBAPIGUIDE.image / PALTEST.BAS < prev    next >
BASIC Source File  |  1992-10-16  |  6KB  |  195 lines
  1. ' Project PalTest
  2.  
  3. ' Module containing global contstants and general purpose
  4. ' routines.
  5.  
  6.  
  7.  
  8. Option Explicit
  9. Global Const PC_RESERVED = &H1
  10. Global Const PC_EXPLICIT = &H2
  11. Global Const PC_NOCOLLAPSE = &H4
  12. Global Const DIB_RGB_COLORS = 0
  13. Global Const DIB_PAL_COLORS = 1
  14. Global Const SYSPAL_STATIC = 1
  15. Global Const SYSPAL_NOSTATIC = 2
  16. Global Const CF_TEXT = 1
  17. Global Const CF_BITMAP = 2
  18. Global Const CF_METAFILEPICT = 3
  19. Global Const CF_SYLK = 4
  20. Global Const CF_DIF = 5
  21. Global Const CF_TIFF = 6
  22. Global Const CF_OEMTEXT = 7
  23. Global Const CF_DIB = 8
  24. Global Const CF_PALETTE = 9
  25. Global Const CF_OWNERDISPLAY = &H80
  26. Global Const CF_DSPTEXT = &H81
  27. Global Const CF_DSPBITMAP = &H82
  28. Global Const CF_DSPMETAFILEPICT = &H83
  29. Global Const CF_PRIVATEFIRST = &H200
  30. Global Const CF_PRIVATELAST = &H2FF
  31.  
  32. ' Increase this number to 32 or 64 to see the effect of
  33. ' the Zorder on the palettes.
  34.  
  35. Global Const PALENTRIES = 15
  36.  
  37. '   This is similar to the LOGPALLETTE defined in
  38. '   APIDECS.BAS, however instead of using a buffer, we
  39. '   create a 64 entry palette for our use.
  40.  
  41. Type LOGPALETTE64
  42.     palVersion As Integer
  43.     palNumEntries As Integer
  44.     palPalEntry(PALENTRIES) As PALETTEENTRY
  45. End Type
  46.  
  47. ' And create a type safe alias to create palette that handles this structure
  48. Declare Function CreatePalette64% Lib "GDI" Alias "CreatePalette" (lpLogPalette As LOGPALETTE64)
  49.  
  50.  
  51. ' The six palettes that this program will use are defined here
  52. Global UsePalettes%(6)
  53. Global logPalettes(6) As LOGPALETTE64
  54.  
  55. ' This is a message used within Visual Basic to retrieve
  56. ' the handle of a palette
  57. Global Const VBM_GETPALETTE% = &H101C
  58.  
  59. '   This function creates 6 palettes that are used by
  60. '   the PalTest program
  61. '
  62. Sub CreateAllPalettes ()
  63.     Dim entrynum%
  64.     Dim oldmouseptr%
  65.     Dim x%
  66.  
  67.     oldmouseptr% = Screen.MousePointer
  68.     Screen.MousePointer = 11
  69.     ' Initialize the logical palette
  70.     For x% = 1 To 6
  71.     logPalettes(x%).palVersion = &H300
  72.     logPalettes(x%).palNumEntries = PALENTRIES
  73.     Next x%
  74.  
  75.     ' Palette 1 will be red
  76.     For entrynum% = 0 To PALENTRIES - 1
  77.     logPalettes(1).palPalEntry(entrynum%).peRed = Chr$((255 * entrynum%) / PALENTRIES)
  78.     logPalettes(1).palPalEntry(entrynum%).peGreen = Chr$(0)
  79.     logPalettes(1).palPalEntry(entrynum%).peBlue = Chr$(0)
  80.     logPalettes(1).palPalEntry(entrynum%).peFlags = Chr$(0)
  81.     Next entrynum%
  82.  
  83.     ' Palette 2 will be green
  84.     For entrynum% = 0 To PALENTRIES - 1
  85.     logPalettes(2).palPalEntry(entrynum%).peRed = Chr$(0)
  86.     logPalettes(2).palPalEntry(entrynum%).peGreen = Chr$((255 * entrynum%) / PALENTRIES)
  87.     logPalettes(2).palPalEntry(entrynum%).peBlue = Chr$(0)
  88.     logPalettes(2).palPalEntry(entrynum%).peFlags = Chr$(0)
  89.     Next entrynum%
  90.  
  91.     ' Palette 3 will be blue and can be animated
  92.     For entrynum% = 0 To PALENTRIES - 1
  93.     logPalettes(3).palPalEntry(entrynum%).peRed = Chr$(0)
  94.     logPalettes(3).palPalEntry(entrynum%).peGreen = Chr$(0)
  95.     logPalettes(3).palPalEntry(entrynum%).peBlue = Chr$((255 * entrynum%) / PALENTRIES)
  96.     logPalettes(3).palPalEntry(entrynum%).peFlags = Chr$(PC_RESERVED)
  97.     Next entrynum%
  98.  
  99.     ' Palette 4 will be yellow
  100.     For entrynum% = 0 To PALENTRIES - 1
  101.     logPalettes(4).palPalEntry(entrynum%).peRed = Chr$((255 * entrynum%) / PALENTRIES)
  102.     logPalettes(4).palPalEntry(entrynum%).peGreen = Chr$((255 * entrynum%) / PALENTRIES)
  103.     logPalettes(4).palPalEntry(entrynum%).peBlue = Chr$(0)
  104.     logPalettes(4).palPalEntry(entrynum%).peFlags = Chr$(0)
  105.     Next entrynum%
  106.  
  107.     ' Palette 5 will be Violet
  108.     For entrynum% = 0 To PALENTRIES - 1
  109.     logPalettes(5).palPalEntry(entrynum%).peRed = Chr$((255 * entrynum%) / PALENTRIES)
  110.     logPalettes(5).palPalEntry(entrynum%).peGreen = Chr$(0)
  111.     logPalettes(5).palPalEntry(entrynum%).peBlue = Chr$((255 * entrynum%) / PALENTRIES)
  112.     logPalettes(5).palPalEntry(entrynum%).peFlags = Chr$(0)
  113.     Next entrynum%
  114.  
  115.     ' Palette 6 will be grey
  116.     For entrynum% = 0 To PALENTRIES - 1
  117.     logPalettes(6).palPalEntry(entrynum%).peRed = Chr$((255 * entrynum%) / PALENTRIES)
  118.     logPalettes(6).palPalEntry(entrynum%).peGreen = Chr$((255 * entrynum%) / PALENTRIES)
  119.     logPalettes(6).palPalEntry(entrynum%).peBlue = Chr$((255 * entrynum%) / PALENTRIES)
  120.     logPalettes(6).palPalEntry(entrynum%).peFlags = Chr$(0)
  121.     Next entrynum%
  122.     
  123.     ' And create the palettes
  124.     For x% = 1 To 6
  125.     UsePalettes(x%) = CreatePalette64(logPalettes(x%))
  126.     Next x%
  127.  
  128.     Screen.MousePointer = oldmouseptr%
  129. End Sub
  130.  
  131. '
  132. '   We're doing color animation on the third picture box
  133. '   (that's blue)
  134. '
  135. Sub DoTheAnimate ()
  136.     Dim entrynum%
  137.     Dim usepal%
  138.     Dim holdentry As PALETTEENTRY
  139.  
  140.     ' Get a handle to the control's palette
  141.     usepal% = SendMessageByNum(PalTest.Picture1(2).hWnd, VBM_GETPALETTE, 0, 0)
  142.    
  143.     ' The following code simply loops the color values
  144.     LSet holdentry = logPalettes(3).palPalEntry(0)
  145.     For entrynum% = 0 To PALENTRIES - 2
  146.     LSet logPalettes(3).palPalEntry(entrynum%) = logPalettes(3).palPalEntry(entrynum% + 1)
  147.     Next entrynum%
  148.     LSet logPalettes(3).palPalEntry(PALENTRIES - 1) = holdentry
  149.     AnimatePalette usepal%, 0, PALENTRIES, logPalettes(3).palPalEntry(0)
  150.  
  151. End Sub
  152.  
  153. '   FillPicture draws a spectrum in the specified picture
  154. '   control using the appropriate palette for that control
  155. '
  156. Sub FillPicture (picnum%)
  157.     Dim totwidth&, startloc&, endloc&
  158.     Dim pic As control
  159.     Dim x&
  160.     'Dim rc As RECT
  161.     'Dim usebrush%
  162.     'Dim t%
  163.  
  164.     Set pic = PalTest.Picture1(picnum%)
  165.  
  166.     totwidth& = pic.ScaleWidth
  167.     For x& = 0 To PALENTRIES - 1
  168.     ' We're using long arithmetic for speed. Note the
  169.     ' ordering of operations to preserve precesion
  170.     startloc& = (totwidth& * x&) / PALENTRIES
  171.     endloc& = (totwidth& * (x& + 1)) / PALENTRIES
  172.     pic.Line (startloc&, 0)-(endloc&, pic.ScaleHeight), GetPalColor(picnum%, (x&)), BF
  173.     Next x&
  174.  
  175. End Sub
  176.  
  177. '
  178. '   Gets the Long RGB color for a palette entry
  179. '
  180. Function GetPalColor& (picnum%, entry%)
  181.     Dim res&
  182.     Dim pe As PALETTEENTRY
  183.     LSet pe = logPalettes(picnum% + 1).palPalEntry(entry%)
  184.     ' We build a long value using this rather awkward
  185.     ' shifting technique.
  186.     ' We actually could save time by performing a raw
  187.     ' memory copy from the pe object into a long variable.
  188.     ' since they are the same format.
  189.     res& = Asc(pe.peRed)
  190.     res& = res& Or (Asc(pe.peGreen) * 256&)
  191.     res& = res& Or (Asc(pe.peBlue) * 256& * 256&)
  192.     GetPalColor& = res&
  193. End Function
  194.  
  195.