'-------------------------------------------------------------- '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 Downloads In IE right-click and select 'Save Target As...' or in Netscape right-click and select 'Save Link As...'    View Plain Text  Download Demo Project  Not Available