128 lines
4 KiB
Text
128 lines
4 KiB
Text
|
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]
|
||
|
|
' [ jobnik@jobnik.org ]
|
||
|
|
' 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
|