home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH5 / SRC / PALANIM.BAS < prev    next >
Encoding:
BASIC Source File  |  1996-03-01  |  4.0 KB  |  70 lines
  1. Attribute VB_Name = "PalAnim"
  2. Option Explicit
  3.  
  4. Type PALETTEENTRY
  5.     peRed As Byte
  6.     peGreen As Byte
  7.     peBlue As Byte
  8.     peFlags As Byte
  9. End Type
  10. Public Const PC_EXPLICIT = &H2      ' Match to system palette index.
  11. Public Const PC_NOCOLLAPSE = &H4    ' Do not match color existing entries.
  12.  
  13. ' GetDeviceCaps constants.
  14. Global Const RASTERCAPS = 38    ' Raster device capabilities.
  15. Global Const RC_PALETTE = &H100 ' Has palettes.
  16. Global Const NUMRESERVED = 106  ' # reserved entries in palette.
  17. Global Const SIZEPALETTE = 104  ' Size of system palette.
  18.  
  19. #If Win32 Then  ' 32-bit VB.
  20.     Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Integer, ByVal nIndex As Integer) As Integer
  21.     Declare Function ResizePalette Lib "gdi32" (ByVal hPalette As Integer, ByVal nNumEntries As Integer) As Integer
  22.     Declare Function SetPaletteEntries Lib "gdi32" (ByVal hPalette As Integer, ByVal wStartIndex As Integer, ByVal wNumEntries As Integer, lpPaletteEntries As PALETTEENTRY) As Integer
  23.     Declare Function GetPaletteEntries Lib "gdi32" (ByVal hPalette As Integer, ByVal wStartIndex As Integer, ByVal wNumEntries As Integer, lpPaletteEntries As PALETTEENTRY) As Integer
  24.     Declare Function GetSystemPaletteEntries Lib "gdi32" (ByVal hDC As Integer, ByVal wStartIndex As Integer, ByVal wNumEntries As Integer, lpPaletteEntries As PALETTEENTRY) As Integer
  25.     Declare Function RealizePalette Lib "gdi32" (ByVal hDC As Long) As Long
  26.     Type POINTAPI
  27.         x As Long
  28.         y As Long
  29.     End Type
  30.     Declare Function Polygon Lib "gdi32" (ByVal hDC As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
  31.     Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
  32.     Global Const PS_SOLID = 0
  33.     Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
  34.     Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
  35.     Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  36.     Declare Function GetTickCount Lib "kernel32" () As Long
  37. #Else           ' 16-bit VB.
  38.     Declare Function GetDeviceCaps Lib "GDI" (ByVal hDC As Integer, ByVal nIndex As Integer) As Integer
  39.     Declare Function ResizePalette Lib "GDI" (ByVal hPalette As Integer, ByVal nNumEntries As Integer) As Integer
  40.     Declare Function SetPaletteEntries Lib "GDI" (ByVal hPalette As Integer, ByVal wStartIndex As Integer, ByVal wNumEntries As Integer, lpPaletteEntries As PALETTEENTRY) As Integer
  41.     Declare Function GetPaletteEntries Lib "GDI" (ByVal hPalette As Integer, ByVal wStartIndex As Integer, ByVal wNumEntries As Integer, lpPaletteEntries As PALETTEENTRY) As Integer
  42.     Declare Function GetSystemPaletteEntries Lib "GDI" (ByVal hDC As Integer, ByVal wStartIndex As Integer, ByVal wNumEntries As Integer, lpPaletteEntries As PALETTEENTRY) As Integer
  43.     Declare Function RealizePalette Lib "User" (ByVal hDC As Integer) As Integer
  44.     Type POINTAPI
  45.         x As Integer
  46.         y As Integer
  47.     End Type
  48.     Declare Function Polygon Lib "GDI" (ByVal hDC As Integer, lpPoints As POINTAPI, ByVal nCount As Integer) As Integer
  49.     Declare Function CreateSolidBrush Lib "GDI" (ByVal crColor As Long) As Integer
  50.     Global Const PS_SOLID = 0
  51.     Declare Function CreatePen Lib "GDI" (ByVal nPenStyle As Integer, ByVal nWidth As Integer, ByVal crColor As Long) As Integer
  52.     Declare Function SelectObject Lib "GDI" (ByVal hDC As Integer, ByVal hObject As Integer) As Integer
  53.     Declare Function DeleteObject Lib "GDI" (ByVal hObject As Integer) As Integer
  54.     Declare Function GetTickCount Lib "User" () As Long
  55. #End If
  56.  
  57. ' ************************************************
  58. ' Pause until GetTickCount shows the indicated
  59. ' time. This is accurate to within one clock tick
  60. ' (55 ms), not counting variability in DoEvents
  61. ' and Windows itself.
  62. ' ************************************************
  63. Sub WaitTill(next_time As Long)
  64.     Do
  65.         DoEvents
  66.     Loop While GetTickCount() < next_time
  67. End Sub
  68.  
  69.  
  70.