home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / programare / bass / vb / Spectrum / modSpectrum.bas < prev    next >
Encoding:
BASIC Source File  |  2005-09-21  |  4.3 KB  |  111 lines
  1. Attribute VB_Name = "modSpectrum"
  2. '/////////////////////////////////////////////////////////////////////////////////
  3. ' modSpectrum.bas - Copyright (c) 2002-2005 (: JOBnik! :) [Arthur Aminov, ISRAEL]
  4. '                                                         [http://www.jobnik.org]
  5. '                                                         [  jobnik@jobnik.org  ]
  6. '
  7. ' Other source: frmSpectrum.frm
  8. '
  9. ' Bass spectrum example
  10. ' Originally translated from - spectrum.c - Example of Ian Luck
  11. '/////////////////////////////////////////////////////////////////////////////////
  12.  
  13. Option Explicit
  14.  
  15. Public Const BI_RGB = 0&
  16. Public Const DIB_RGB_COLORS = 0&    'color table in RGBs
  17.  
  18. Public Type BITMAPINFOHEADER    '40 bytes
  19.         biSize As Long
  20.         biWidth As Long
  21.         biHeight As Long
  22.         biPlanes As Integer
  23.         biBitCount As Integer
  24.         biCompression As Long
  25.         biSizeImage As Long
  26.         biXPelsPerMeter As Long
  27.         biYPelsPerMeter As Long
  28.         biClrUsed As Long
  29.         biClrImportant As Long
  30. End Type
  31.  
  32. Public Type RGBQUAD
  33.         rgbBlue As Byte
  34.         rgbGreen As Byte
  35.         rgbRed As Byte
  36.         rgbReserved As Byte
  37. End Type
  38.  
  39. Public Type BITMAPINFO
  40.         bmiHeader As BITMAPINFOHEADER
  41.         bmiColors(255) As RGBQUAD
  42. End Type
  43.  
  44. Public Declare Function SetDIBitsToDevice Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long
  45.  
  46. 'NOTE: Using an API MM timer (may sometimes Crash your app in an IDE mode)
  47. Public Const TIME_PERIODIC = 1  ' program for continuous periodic event
  48. Public Declare Function timeSetEvent Lib "winmm.dll" (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As Long, ByVal dwUser As Long, ByVal uFlags As Long) As Long
  49. Public Declare Function timeKillEvent Lib "winmm.dll" (ByVal uID As Long) As Long
  50. Public timing As Long       ' an API timer Handle
  51.  
  52. Public SPECWIDTH As Long    'display width
  53. Public SPECHEIGHT As Long   'height (changing requires palette adjustments too)
  54.  
  55. Public chan As Long         'stream/music handle
  56.  
  57. Public specmode As Boolean, specpos As Long  'spectrum mode (and marker pos for 2nd mode)
  58. Public specbuf() As Byte    'a pointer
  59.  
  60. Public bh As BITMAPINFO     'bitmap header
  61.  
  62. Public Function Sqrt(ByVal num As Double) As Double
  63.     Sqrt = num ^ 0.5
  64. End Function
  65.  
  66. 'update the spectrum display - the interesting bit :)
  67. Public Sub UpdateSpectrum(ByVal uTimerID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As Long)
  68.     Dim X As Long, Y As Long, y1 As Long
  69.     Dim fft(1024) As Single     'get the FFT data
  70.     Call BASS_ChannelGetData(chan, fft(0), BASS_DATA_FFT2048)
  71.  
  72.     If (Not specmode) Then
  73.         ReDim specbuf(SPECWIDTH * (SPECHEIGHT + 1)) As Byte 'clear display
  74.         For X = 0 To (SPECWIDTH / 2) - 1
  75. #If 1 Then
  76.             Y = Sqrt(fft(X + 1)) * 3 * SPECHEIGHT - 4 'scale it (sqrt to make low values more visible)
  77. #Else
  78.             Y = fft(X + 1) * 10 * SPECHEIGHT 'scale it (linearly)
  79. #End If
  80.             If (Y > SPECHEIGHT) Then Y = SPECHEIGHT 'cap it
  81.             If (X) Then  'interpolate from previous to make the display smoother
  82.                 y1 = (Y + y1) / 2
  83.                 While (y1 >= 0)
  84.                     specbuf(y1 * SPECWIDTH + X * 2 - 1) = y1 + 1
  85.                     y1 = y1 - 1
  86.                 Wend
  87.             End If
  88.             y1 = Y
  89.             While (Y >= 0)
  90.                 specbuf(Y * SPECWIDTH + X * 2) = Y + 1 ' draw level
  91.                 Y = Y - 1
  92.             Wend
  93.         Next X
  94.     Else
  95.         For X = 0 To SPECHEIGHT - 1
  96.             Y = Sqrt(fft(X + 1)) * 3 * 127 'scale it (sqrt to make low values more visible)
  97.             If (Y > SPECHEIGHT) Then Y = 127 'cap it
  98.             specbuf(X * SPECWIDTH + specpos) = 128 + Y ' plot it
  99.         Next X
  100.         'move marker onto next position
  101.         specpos = (specpos + 1) Mod SPECWIDTH
  102.         For X = 0 To SPECHEIGHT - 1
  103.             specbuf(X * SPECWIDTH + specpos) = 255
  104.         Next X
  105.     End If
  106.  
  107.     'update the display
  108.     'to display in a PictureBox, simply change the .hDC to Picture1.hDC :)
  109.     Call SetDIBitsToDevice(frmSpectrum.hDC, 0, 0, SPECWIDTH, SPECHEIGHT, 0, 0, 0, SPECHEIGHT, specbuf(0), bh, 0)
  110. End Sub
  111.