'--------------------------------------------------------------
'ROLLOVER_SOUND.VBP               
'August 24, 1999
'
'Burt Abreu
'habreu@VBExplorer.com
'--------------------------------------------------------------
'This project was written to answer a FAQ - How to create
'rollover effects with sound. Thanks go to Rod Stephens
'of VB-Helper who cleaned up and tweaked the rollover
'code. You can check out his site at
'http://www.vb-helper.com.
'
'The code was also modified by Soren Christensen since
'I was only getting one of the sound files to play
'(whichever one I opened first). You can reach Soren
'at soren@VBExplorer.com
'
'Soren explained that once you open a sound with MCI and
'assign this sound an alias you can not use that sound
'again - meaning you have to store the alias. Also sounds
'must be stopped before they can be played again. It is
'very tedious work to figure this out - at least until you
'find the mciGetError function, which is an incredible help.
'
'The balance of the sound play part was based on the sample
'project for the "Sound & Games" tutorial in the tutorials
'section. This code is not complete in that you should probably
'build in some error checking in case the files are not found.
'
'--------------------------------------------------------------
' Visual Basic Explorer
' http://www.VBExplorer.com
'--------------------------------------------------------------
Option Explicit

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
  (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
   ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
   
Private Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" _
                                            (ByVal dwError As Long, _
                                             ByVal lpstrBuffer As String, _
                                             ByVal uLength As Long) As Long

Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" _
    (ByVal lpszLongPath As String, ByVal lpszShortPath As String, _
    ByVal cchBuffer As Long) As Long

'This is for the button rollovers
Dim MouseOver
Dim MousePress
Dim NewIndex

'This is for playing the wave files
Dim MouseOverSound As String
Dim MousePressSound As String
Dim MouseUpSound As String

Const MouseOverMCI As String = "WAVEOVER"
Const MousePressMCI As String = "WAVEPRESS"
Const MouseUpMCI As String = "WAVEUP11"


Private Sub ButtonPicture1_MouseDown(Index As Integer, Button As Integer, _
        Shift As Integer, X As Single, Y As Single)
If MousePress Then Exit Sub
   StopSounds
   ButtonPicture1(Index).Picture = DownImage.Picture
   lblStatus.Caption = "Mouse Down"
   PlayWav MousePressMCI
   MousePress = True
End Sub

Private Sub ButtonPicture1_MouseMove(Index As Integer, Button As Integer, _
        Shift As Integer, X As Single, Y As Single)
If MouseOver Then Exit Sub
   StopSounds
   ButtonPicture1(Index).Picture = OverImage.Picture
   lblStatus.Caption = "Mouse Over - Button"
   PlayWav MouseOverMCI
   NewIndex = Index
   MouseOver = True
End Sub

Private Sub ButtonPicture1_MouseUp(Index As Integer, Button As Integer, _
        Shift As Integer, X As Single, Y As Single)
If Not MousePress Then Exit Sub
       StopSounds
       PlayWav MouseUpMCI
       ButtonPicture1(Index).Picture = UpImage.Picture
       lblStatus.Caption = "Mouse Up"
       MousePress = False
End Sub

Private Sub Form_Load()
Dim str1 As String

str1 = Space$(255)
MouseOverSound = "boink.wav"
MousePressSound = "bleeb.wav"
MouseUpSound = "type.wav"

''Load the sounds
LoadSound MouseOverSound, MouseOverMCI
LoadSound MousePressSound, MousePressMCI
LoadSound MouseUpSound, MouseUpMCI

Debug.Print mciSendString("PLAY WAVEUP11 FROM 0", str1, 0, 0)

Dim i As Integer
    lblStatus.Caption = "Ready?"
    For i = ButtonPicture1.LBound To ButtonPicture1.UBound
        ButtonPicture1(i).Picture = UpImage.Picture
    Next i
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Not MouseOver Then Exit Sub
   StopSounds
   lblStatus.Caption = "Mouse Over - Form"
   MouseOver = False
   MousePress = False
   ButtonPicture1(NewIndex).Picture = UpImage.Picture
End Sub

Private Sub Form_Unload(Cancel As Integer)
 'This shouldn't be needed but it
 'can't hurt to stop the sound
  StopSounds
    
 'Unload the form and remove any references
  Unload Me
  Set Form1 = Nothing
End Sub

Public Function PlayWav(Alias As String)
 Dim rt As Long, ErrorString As String
 'Play the sound
 rt = mciSendString("PLAY " & Alias & " FROM 0", 0&, 0, 0)
 
 If rt <> 0 Then
    ErrorString = Space$(255)
    mciGetErrorString rt, ErrorString, Len(ErrorString)
    MsgBox "Error: " & ErrorString
 End If
 
End Function

Private Sub LoadSound(Filename As String, Alias As String)
Dim CommandString As String, ErrorString As String
Dim ShortPathName As String
Dim AppPath As String
Dim rt As Long

  ''Get the path name
  AppPath = App.Path
  If Right$(AppPath, 1) <> "\" Then
      AppPath = AppPath & "\"
  End If
    
  ''Allocate space for short path name
  ShortPathName = Space$(255)
  ''Get the short path name since MCI only accepts those
  GetShortPathName AppPath, ShortPathName, Len(ShortPathName)
  
  ''Remove empty spaces and the trailing NULL character
  ShortPathName = Left$(ShortPathName, Len(Trim$(ShortPathName)) - 1)
  'Build the command string
  CommandString = "OPEN " & ShortPathName & Filename & " TYPE WAVEAUDIO ALIAS " & Alias
  
  'Open the sound
   rt = mciSendString(CommandString, 0&, 0, 0)
   
   If rt <> 0 Then ''Non 0 = error
        ErrorString = Space$(255)
        mciGetErrorString rt, ErrorString, Len(ErrorString)
        MsgBox "Error: " & ErrorString
   End If

End Sub

Private Sub StopSounds()

    mciSendString "STOP " & MouseOverMCI, 0&, 0, 0
    mciSendString "STOP " & MouseUpMCI, 0&, 0, 0
    mciSendString "STOP " & MousePressMCI, 0&, 0, 0
    
End Sub