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
