VERSION 5.00 Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX" Begin VB.Form frmMain BackColor = &H00000000& BorderStyle = 3 'Fixed Dialog Caption = "ZDSpc Dll - VB Example" ClientHeight = 2760 ClientLeft = 45 ClientTop = 330 ClientWidth = 5010 BeginProperty Font Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 2760 ScaleWidth = 5010 StartUpPosition = 3 'Windows Default Begin VB.CommandButton cmdEject Caption = "5" BeginProperty Font Name = "Webdings" Size = 12 Charset = 2 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Left = 3210 TabIndex = 3 Top = 1320 Width = 675 End Begin VB.CommandButton cmdStop Caption = "<" BeginProperty Font Name = "Webdings" Size = 12 Charset = 2 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Left = 2520 TabIndex = 2 Top = 1320 Width = 675 End Begin VB.CommandButton cmdPause Caption = ";" BeginProperty Font Name = "Webdings" Size = 12 Charset = 2 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Left = 1830 TabIndex = 1 Top = 1320 Width = 675 End Begin MSComDlg.CommonDialog cdlFile Left = 30 Top = 30 _ExtentX = 847 _ExtentY = 847 _Version = 393216 Filter = "SPC Files (*.spc)|*.spc" End Begin VB.CommandButton cmdPlay Caption = "4" BeginProperty Font Name = "Webdings" Size = 12 Charset = 2 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Left = 1140 TabIndex = 0 Top = 1320 Width = 675 End Begin VB.Label lblFilename Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "(Load a file)" ForeColor = &H00FFFFFF& Height = 225 Left = 690 TabIndex = 5 Top = 1860 Width = 3615 End Begin VB.Label lblHeader Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "ZDSpc Dll Demo" BeginProperty Font Name = "Verdana" Size = 14.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00FFFFFF& Height = 315 Left = 1140 TabIndex = 4 Top = 510 Width = 2685 End Begin VB.Shape shpBkg FillColor = &H00808000& FillStyle = 0 'Solid Height = 2475 Index = 0 Left = 180 Shape = 2 'Oval Top = 150 Width = 4605 End Begin VB.Shape shpBkg FillColor = &H00800080& FillStyle = 0 'Solid Height = 2175 Index = 1 Left = 360 Top = 330 Width = 4275 End End Attribute VB_Name = "frmMain" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Private bIsPlaying As Boolean Private strFilename As String Private bIsPaused As Boolean 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 Private Function FileExists(ByVal Filename As String) As Boolean 'Check whether a file exists via API. 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 Private Sub PlayFile(ByVal strFilename As String) 'Plays the specified spc file. Dim mmResult As Long Dim iChan As Long, iBits As Long, iFreq As Long, iVM As Long iChan = 2 iBits = 16 iFreq = 32000 iVM = 4 mmResult = InitialiseSPC(SPC_SND Or SPC_APU, iChan, iBits, iFreq, iVM) If mmResult = MMSYSERR_NOERROR Then If LoadSPC(strFilename) = 0 Then Call PlaySPC Else MsgBox "Load failed!" End If Else Dim strBuffer As String, nLen As Long strBuffer = String$(MAXERRORLENGTH, 0) nLen = waveOutGetErrorText(ByVal mmResult, strBuffer, MAXERRORLENGTH) strBuffer = Left$(strBuffer, nLen) MsgBox "Failed to initialise ZD-SPC Dll!" & vbCrLf & vbCrLf & strBuffer End If End Sub Private Sub cmdEject_Click() 'Selects a filename On Error GoTo ErrorHandler With cdlFile .CancelError = True .Flags = cdlOFNFileMustExist Or cdlOFNHideReadOnly .ShowOpen End With lblFilename.Caption = LCase(cdlFile.Filename) strFilename = cdlFile.Filename Exit Sub ErrorHandler: Exit Sub End Sub Private Sub cmdPause_Click() 'Pauses the SPC playing. If bIsPlaying Then PauseSPC bIsPaused = True lblFilename.Caption = "Paused: " & LCase(strFilename) End If End Sub Private Sub cmdPlay_Click() 'Plays the spc, or unpauses if paused. 'If it's not playing then.. If Not bIsPlaying Then If FileExists(strFilename) Then PlayFile strFilename bIsPlaying = True lblFilename.Caption = "Playing: " & LCase(strFilename) End If Else 'If it is playing, check if paused. If paused, then resume. If bIsPaused Then PlaySPC bIsPaused = False lblFilename.Caption = "Playing: " & LCase(strFilename) End If End If End Sub Private Sub cmdStop_Click() 'If playing, then stop If bIsPlaying Then DeinitialiseSPC SPC_SND Or SPC_APU bIsPlaying = False lblFilename.Caption = "Stopped: " & LCase(strFilename) End If End Sub Private Sub Form_Load() 'Center the form Move Screen.Width / 2 - Width / 2, Screen.Height / 2 - Height / 2 End Sub Private Sub Form_Unload(Cancel As Integer) 'If exiting, then make sure to deinit the dll if playing. If bIsPlaying Then DeinitialiseSPC SPC_SND Or SPC_APU End If End Sub