home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / programare / bass / vb / LiveSpec / modLiveSpec.bas < prev    next >
Encoding:
BASIC Source File  |  2005-09-20  |  4.8 KB  |  126 lines
  1. Attribute VB_Name = "modLiveSpec"
  2. '/////////////////////////////////////////////////////////////////////////////////
  3. ' modLiveSpec.bas - Copyright (c) 2002-2005 (: JOBnik! :) [Arthur Aminov, ISRAEL]
  4. '                                                         [http://www.jobnik.org]
  5. '                                                         [  jobnik@jobnik.org  ]
  6. ' Other source: frmLiveSpec.frm
  7. '
  8. ' BASS "Live" spectrum analyser example
  9. ' Originally translated from - livespec.c - Example of Ian Luck
  10. '/////////////////////////////////////////////////////////////////////////////////
  11.  
  12. Option Explicit
  13.  
  14. Public Const BI_RGB = 0&
  15. Public Const DIB_RGB_COLORS = 0&    'color table in RGBs
  16.  
  17. Public Type BITMAPINFOHEADER    '40 bytes
  18.         biSize As Long
  19.         biWidth As Long
  20.         biHeight As Long
  21.         biPlanes As Integer
  22.         biBitCount As Integer
  23.         biCompression As Long
  24.         biSizeImage As Long
  25.         biXPelsPerMeter As Long
  26.         biYPelsPerMeter As Long
  27.         biClrUsed As Long
  28.         biClrImportant As Long
  29. End Type
  30.  
  31. Public Type RGBQUAD
  32.         rgbBlue As Byte
  33.         rgbGreen As Byte
  34.         rgbRed As Byte
  35.         rgbReserved As Byte
  36. End Type
  37.  
  38. Public Type BITMAPINFO
  39.         bmiHeader As BITMAPINFOHEADER
  40.         bmiColors(255) As RGBQUAD
  41. End Type
  42.  
  43. 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
  44.  
  45. Public SPECWIDTH As Long    'display width
  46. Public SPECHEIGHT As Long   'height (changing requires palette adjustments too)
  47. Public specmode As Boolean, specpos As Integer  ' spectrum mode (and marker pos for 2nd mode)
  48. Public specbuf() As Byte    'a pointer
  49.  
  50. Public chan As Long         'recording channel
  51.  
  52. Public bh As BITMAPINFO     'bitmap header
  53.  
  54. Public Function Sqrt(ByVal num As Double) As Double
  55.     Sqrt = num ^ 0.5
  56. End Function
  57.  
  58. 'update the spectrum display - the interesting bit :)
  59. Public Sub UpdateSpectrum()
  60.     Static quietcount As Integer
  61.     Dim X As Long, Y As Long, Y1 As Long
  62.     Dim fft(2048) As Single     'get the FFT data
  63.     Call BASS_ChannelGetData(chan, fft(0), BASS_DATA_FFT4096)
  64.  
  65.     If (Not specmode) Then    '"normal" FFT
  66.         ReDim specbuf(SPECWIDTH * (SPECHEIGHT + 1)) As Byte  'clear display
  67.         For X = 0 To (SPECWIDTH / 2) - 1
  68. #If 1 Then
  69.             Y = Sqrt(fft(X + 1)) * 3 * SPECHEIGHT - 4 'scale it (sqrt to make low values more visible)
  70. #Else
  71.             Y = fft(X + 1) * 10 * SPECHEIGHT 'scale it (linearly)
  72. #End If
  73.             If (Y > SPECHEIGHT) Then Y = SPECHEIGHT 'cap it
  74.             If (X) Then  'interpolate from previous to make the display smoother
  75.                 Y1 = (Y + Y1) / 2
  76.                 Y1 = Y1 - 1
  77.                 While (Y1 >= 0)
  78.                     specbuf(Y1 * SPECWIDTH + X * 2 - 1) = Y1 + 1
  79.                     Y1 = Y1 - 1
  80.                 Wend
  81.             End If
  82.             Y1 = Y
  83.             Y = Y - 1
  84.             While (Y >= 0)
  85.                 specbuf(Y * SPECWIDTH + X * 2) = Y + 1 'draw level
  86.                 Y = Y - 1
  87.             Wend
  88.         Next X
  89.     Else    '"3D"
  90.         For X = 0 To SPECHEIGHT - 1
  91.             Y = Sqrt(fft(X + 1)) * 3 * 127 'scale it (sqrt to make low values more visible)
  92.             If (Y > 127) Then Y = 127 'cap it
  93.             specbuf(X * SPECWIDTH + specpos) = 128 + Y 'plot level
  94.         Next X
  95.         'move marker onto next position
  96.         specpos = (specpos + 1) Mod SPECWIDTH
  97.         For X = 0 To SPECHEIGHT - 1
  98.             specbuf(X * SPECWIDTH + specpos) = 255
  99.         Next X
  100.     End If
  101.  
  102.     'update the display
  103.     'to display in a PictureBox, simply change the .hDC to Picture1.hDC :)
  104.     Call SetDIBitsToDevice(frmLiveSpec.hdc, 0, 0, SPECWIDTH, SPECHEIGHT, 0, 0, 0, SPECHEIGHT, specbuf(0), bh, 0)
  105.     If (LoWord(BASS_ChannelGetLevel(chan)) < 500) Then ' check if it's quiet
  106.         quietcount = quietcount + 1
  107.         If (quietcount > 40 And (quietcount And 16)) Then 'it's been quiet for over a second
  108.             Dim sNoise As String
  109.             sNoise = "make some noise!"
  110.             With frmLiveSpec
  111.                 .ForeColor = &HFFFFFF
  112.                 .CurrentX = (SPECWIDTH - .TextWidth(sNoise)) / 2
  113.                 .CurrentY = (SPECHEIGHT - .TextHeight(sNoise)) / 2
  114.                 frmLiveSpec.Print sNoise
  115.             End With
  116.         End If
  117.     Else
  118.         quietcount = 0 'not quiet
  119.     End If
  120. End Sub
  121.  
  122. 'Recording callback - not doing anything with the data
  123. Public Function DuffRecording(ByVal handle As Long, ByVal buffer As Long, ByVal length As Long, ByVal user As Long) As Integer
  124.     DuffRecording = BASSTRUE 'continue recording
  125. End Function
  126.