frmlivespec.frm

bass player system api c++

VERSION 5.00
Begin VB.Form frmLiveSpec 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "BASS ""live"" spectrum (click to toggle mode)"
   ClientHeight    =   1905
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5520
   BeginProperty Font 
      Name            =   "Arial"
      Size            =   9.75
      Charset         =   177
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   127
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   368
   StartUpPosition =   2  'CenterScreen
   Begin VB.Timer tmrLiveSpec 
      Enabled         =   0   'False
      Interval        =   25
      Left            =   5040
      Top             =   1440
   End
End
Attribute VB_Name = "frmLiveSpec"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'/////////////////////////////////////////////////////////////////////////////////
' frmLiveSpec.frm - Copyright (c) 2002-2007 (: JOBnik! :) [Arthur Aminov, ISRAEL]
'                                                         [http://www.jobnik.org]
'                                                         [  [e-mail]  ]
' Other source: modLiveSpec.bas
'
' BASS "Live" spectrum analyser example
' Originally translated from - livespec.c - Example of Ian Luck
'/////////////////////////////////////////////////////////////////////////////////

Option Explicit

' display error messages
Public Sub Error_(ByVal es As String)
    Call MsgBox(es & vbCrLf & vbCrLf & "error code: " & BASS_ErrorGetCode, vbExclamation, "Error")
End Sub

Private Sub Form_Load()
    ' change and set the current path, to prevent from VB not finding BASS.DLL
    ChDrive App.Path
    ChDir App.Path

    ' check the correct BASS was loaded
    If (HiWord(BASS_GetVersion) <> BASSVERSION) Then
        Call MsgBox("An incorrect version of BASS.DLL was loaded", vbCritical)
        End
    End If

    ' initialize BASS recording (default device)
    If (BASS_RecordInit(-1) = 0) Then
        Call Error_("Can't initialize device")
        End
    End If

    ' start recording (44100hz mono 16-bit)
    chan = BASS_RecordStart(44100, 1, 0, AddressOf DuffRecording, 0)
    If chan = 0 Then
        Call Error_("Can't start recording")
        End
    End If

    specpos = 0
    specmode = 0

    ' create bitmap to draw spectrum in - 8 bit for easy updating :)
    With bh.bmiHeader
        .biSize = Len(bh.bmiHeader)
        .biWidth = SPECWIDTH
        .biHeight = SPECHEIGHT  ' upside down (line 0=bottom)
        .biPlanes = 1
        .biBitCount = 8
        .biClrUsed = 256
        .biClrImportant = 256
    End With

    Dim a As Byte

    ' setup palette
    For a = 1 To 127
        bh.bmiColors(a).rgbGreen = 256 - 2 * a
        bh.bmiColors(a).rgbRed = 2 * a
    Next a
    For a = 0 To 31
        bh.bmiColors(128 + a).rgbBlue = 8 * a
        bh.bmiColors(128 + 32 + a).rgbBlue = 255
        bh.bmiColors(128 + 32 + a).rgbRed = 8 * a
        bh.bmiColors(128 + 64 + a).rgbRed = 255
        bh.bmiColors(128 + 64 + a).rgbBlue = 8 * (31 - a)
        bh.bmiColors(128 + 64 + a).rgbGreen = 8 * a
        bh.bmiColors(128 + 96 + a).rgbRed = 255
        bh.bmiColors(128 + 96 + a).rgbGreen = 255
        bh.bmiColors(128 + 96 + a).rgbBlue = 8 * a
    Next a

    ' update timer 25ms (40hz)
    tmrLiveSpec.Enabled = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
    tmrLiveSpec.Enabled = False
    Call BASS_RecordFree
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    specmode = (specmode + 1) Mod 4  ' swap spectrum mode
    ReDim specbuf(SPECWIDTH * (SPECHEIGHT + 1)) As Byte ' clear display
End Sub

Private Sub tmrLiveSpec_Timer()
    Call UpdateSpectrum
End Sub