Option Explicit
Dim strFileName As String
Dim dblTrackPosition As Double
Dim intRed As Integer
Dim intGreen As Integer
Dim intBlue As Integer
Private Sub form_load()
'Open the midi player
mciMidi.Command = "Open"
'Colors
hsbRed.Value = 228
hsbGreen.Value = 147
hsbBlue.Value = 136
OptStyle(0).Value = True
OptShape(0).Value = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Close midi player
mciMidi.Command = "Close"
End Sub
Private Sub mciMidi_StatusUpdate()
'Display the status
If mciMidi.Mode = mciModeNotOpen Then
txtStatus.Text = "Not ready"
ElseIf mciMidi.Mode = mciModeStop Then
txtStatus.Text = "Stopped"
ElseIf mciMidi.Mode = mciModePlay Then
txtStatus.Text = "Play"
ElseIf mciMidi.Mode = mciModeRecord Then
txtStatus.Text = "Record"
ElseIf mciMidi.Mode = mciModePause Then
txtStatus.Text = "Pause"
ElseIf mciMidi.Mode = mciModeReady Then
txtStatus.Text = "Ready"
End If
'Display the filename being played
txtFileName.Text = mciMidi.FileName
'If no file is selected; do not calculate
' the slide position
If Not strFileName = "" Then dblTrackPosition = mciMidi.position / mciMidi.Length
'Caluculate the slider position
Slider1.Value = dblTrackPosition * 1000
If dblTrackPosition = 1 Then
Slider1.Value = 0
mciMidi.Command = ""
End If
End Sub
Private Sub mnuFileOpen_Click()
On Error GoTo Errhandler
mciMidi.Command = "Stop"
mciMidi.DeviceType = "sequencer"
cdlFile.Filter = "All Files (*.*) |*.*|Wave Files (*.wav)|*.wav|Midi Files(*.mid)|*.mid|MP3 Files(*.mp3)|*.mp3|Windows Media Files(*.wmv)|*.wmv|Avi Files(*.avi)|*.avi|Windows Media Audio Files(*.wma)|*.wma|"
cdlFile.ShowOpen 'Display dialog box
strFileName = cdlFile.FileName 'Select file name
mciMidi.FileName = strFileName
mciMidi.Command = "Open"
mciMidi.UpdateInterval = 100
Exit Sub
Errhandler:
MsgBox Err.Number & "|" & Err.Description
End Sub
Private Sub hsbBlue_Change()
intBlue = hsbBlue.Value
Shape1.FillColor = RGB(intRed, intGreen, intBlue)
lblBlue.Caption = "Blue:" & CStr(intBlue)
End Sub
Private Sub hsbGreen_Change()
intGreen = hsbGreen.Value
Shape1.FillColor = RGB(intRed, intGreen, intBlue)
lblgreen.Caption = "Green:" & CStr(intGreen)
End Sub
Private Sub hsbRed_Change()
intRed = hsbRed.Value
Shape1.FillColor = RGB(intRed, intGreen, intBlue)
lblRed.Caption = "Red:" & CStr(intRed)
End Sub
Private Sub OptShape_Click(Index As Integer)
Select Case Index
Case 0 'The Rectangle
Shape1.Shape = 0
Case 1 'The Square
Shape1.Shape = 1
Case 2 'The Oval
Shape1.Shape = 2
Case 3 'The Circle
Shape1.Shape = 3
Case 4 'The Rounded Rectangle
Shape1.Shape = 4
Case 5 'The Rounded Square
Shape1.Shape = 5
End Select
End Sub
Private Sub OptStyle_Click(Index As Integer)
Select Case Index
Case 0 'The Solid FillStyle
Shape1.FillStyle = 0
Case 1 'The Transparent FillStyle
Shape1.FillStyle = 1
Case 2 'The Horizontal Line FillStyle
Shape1.FillStyle = 2
Case 3 'The Vertical Line FillStyle
Shape1.FillStyle = 3
Case 4 'The Upward Diagonal Line FillStyle
Shape1.FillStyle = 4
Case 5 'The Downward Diagonal FillStyle
Shape1.FillStyle = 5
Case 6 'The Cross FillStyle
Shape1.FillStyle = 6
Case 7 'The Diagonal Cross FillStyle
Shape1.FillStyle = 7
End Select
End Sub
