VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsZdSPC"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'Realiased calls
Private Declare Function vInitSPC Lib "ZDSPCdll.dll" Alias "InitialiseSPC" (ByVal dwFlags As Long, ByVal nChannels As Long, ByVal nBits As Long, ByVal nFrequency As Long, ByVal nVolMultiplier As Long) As Long
Private Declare Sub vDeinitSPC Lib "ZDSPCdll.dll" Alias "DeinitialiseSPC " (ByVal dwFlags As Long)
Private Declare Sub vRestoreSPC Lib "ZDSPCdll.dll" Alias "RestoreSPC" ()
Private Declare Function vLoadSPC Lib "ZDSPCdll.dll" Alias "LoadSPC" (ByVal strFilename As String) As Long
Private Declare Sub vPlaySPC Lib "ZDSPCdll.dll" Alias "PlaySPC" ()
Private Declare Sub vPauseSPC Lib "ZDSPCdll.dll" Alias "PauseSPC" ()

Private Const SPC_APU = 1
Private Const SPC_SND = 2

Private Const MMSYSERR_NOERROR = 0  '  no error
Private Const MAXERRORLENGTH = 128  '  max error text length (including final NULL)

Private Declare Function waveOutGetErrorText Lib "winmm.dll" Alias "waveOutGetErrorTextA" (ByVal err As Long, ByVal lpText As String, ByVal uSize As Long) As Long

Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type

Private Const MAX_PATH = 260
Private Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
End Type

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Const INVALID_FILE_HANDLE As Long = -1

'Wrapper variables, and enums
Private nChannels As Long
Private nBits As Long
Private nFreq As Long
Private nVolMultiplier As Long
Private bIsPlaying As Boolean
Private strFilename As String

Public Enum eZdSPCChannels
    ZdSpcMono = 1
    ZdSpcStereo = 2
End Enum

Public Enum eZdSPCBits
    ZdSpc8Bit = 8
    ZdSpc16Bit = 16
End Enum

Public Enum eZdSPCFreq
    ZdSpc11khz = 11025
    ZdSpc16khz = 16000
    ZdSpc22khz = 22050
    ZdSpc32khz = 32000
    ZdSpc44khz = 44100
    ZdSpc48khz = 48000
End Enum

Public Enum eZdSPCVolMultiplier
    ZdSpcOnce = 1
    ZdSpcTwice = 2
    ZdSpcFour = 4
    ZdSpcEight = 8
End Enum


Public Property Get Channels() As eZdSPCChannels
    Channels = nChannels
End Property

Public Property Let Channels(ByVal eNewValue As eZdSPCChannels)
    nChannels = eNewValue
End Property

Public Property Get Bits() As eZdSPCBits
    Bits = nBits
End Property

Public Property Let Bits(ByVal eNewValue As eZdSPCBits)
    nBits = eNewValue
End Property

Public Property Get Frequency() As eZdSPCFreq
    Frequency = nFreq
End Property

Public Property Let Frequency(ByVal eNewValue As eZdSPCFreq)
    nFreq = eNewValue
End Property

Public Sub PlaySPC()
If Not bIsPlaying Then
    If FileExists(strFilename) Then
    
        Dim nResult As Long
    
        nResult = vInitSPC(SPC_APU Or SPC_SND, nChannels, nBits, nFreq, nVolMultiplier)
        
        If nResult = MMSYSERR_NOERROR Then
        
            vLoadSPC strFilename
            vPlaySPC
        
            bIsPlaying = True
        
        Else
        
            Dim strBuffer As String, nLen As Long
            
            strBuffer = String$(MAXERRORLENGTH, 0)
            nLen = waveOutGetErrorText(nResult, strBuffer, MAXERRORLENGTH)
            
            strBuffer = Left$(strBuffer, nLen)
            
            MsgBox "Failed to initialise ZD-SPC Dll!" & vbCrLf & vbCrLf & strBuffer
        
        End If
        
    
    Else
    
        MsgBox "Error!" & vbCrLf & vbCrLf & "The file to play didn't exist!", vbCritical
    
    End If
End If
End Sub


Private Function FileExists(ByVal Filename As String) As Boolean
Dim WFD As WIN32_FIND_DATA
Dim hFile As Long
Dim fn As String

If Right$(Filename, 1) <> Chr$(0) Then
    fn = Filename & Chr$(0)
Else
    fn = Filename
End If

hFile = FindFirstFile(Filename, WFD)
FileExists = (hFile <> INVALID_FILE_HANDLE)

FindClose hFile
End Function



Public Sub StopSPC()
    DeinitialiseSPC SPC_SND Or SPC_APU
    bIsPlaying = False
End Sub

Public Property Get VolumeMultiplier() As eZdSPCVolMultiplier
    VolumeMultiplier = nVolMultiplier
End Property

Public Property Let VolumeMultiplier(ByVal eNewValue As eZdSPCVolMultiplier)
    nVolMultiplier = eNewValue
End Property

Public Property Get Filename() As String
    Filename = strFilename
End Property

Public Property Let Filename(ByVal strNewValue As String)
    strFilename = strNewValue
End Property

Public Property Get IsPlaying() As Boolean
    IsPlaying = bIsPlaying
End Property

Private Sub Class_Terminate()
    If bIsPlaying Then StopSPC
End Sub