VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsMidi"
Attribute VB_GlobalNameSpace = True
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Public Event NotesPlaying(ByVal Channel As Integer, ByVal NoteValue As Integer, ByVal NoteText As String, ByVal DrumsValue As Integer, ByVal DrumsText As String, ByVal NoteOn As Boolean)
Public Event MidiLevel(ByVal Channel As Integer, ByVal Level As Integer)
Public Event TextKar(ByVal TxtString As String, ByVal TextStart As Integer, ByVal AtualPhrase As String, ByVal NextPhrase As String)
Public Event Progress(ByVal midiTicks As Long, ByVal midiTime As String)
Public Event MidiInfo(ByVal TimeLength As String, ByVal TimeSignature As String)
Public Event Status(ByVal Status As Integer, ByVal StatusText As String)
Public Event VolumeChange(ByVal Channel As Integer, ByVal Value As Integer)
Public Event MasterVolumeChange(ByVal Value As Integer)
Public Event BalanceChange(ByVal Channel As Integer, ByVal Value As Integer)
Public Event InstrumentChange(ByVal Channel As Integer, ByVal InstrumentValue As Integer, ByVal InstrumentText As String)
Public Event ChannelMuteChange(ByVal Channel As Integer, ByVal bMute As Boolean)
Public Event TransposeChange(ByVal Value As Integer)
Public Event VelocityChange(ByVal Value As Integer)
Dim MidiFileName As String
Friend Sub FireEventText(ByVal kIndex As Long)

    On Error Resume Next
    If kIndex = 0 Then Exit Sub
    RaiseEvent TextKar(Lyric(kIndex).TxtString, Lyric(kIndex).TextStart, Phrase(Lyric(kIndex).FraseIndex), Phrase(Lyric(kIndex).FraseIndex + 1))

End Sub
Private Function GetTrackLyric() As Integer

        Dim B() As Byte
        GetTrackLyric = -1
        For i = 1 To mHeader.TrackCount
            Seek #1, mChunk(i).IniTrack + 8
            ReDim B(1 To mChunk(i).TrackLenght + 4)
            Get #1, , B
            TempTxt = StrConv(B, vbUnicode)
            If InStr(1, TempTxt, Chr(&HFF) & Chr(&H3) & Chr(5) & "words", vbTextCompare) > 0 Then
                GetTrackLyric = i
                Exit Function
            End If
        Next
        For i = 1 To mHeader.TrackCount
            Seek #1, mChunk(i).IniTrack + 8
            ReDim B(1 To mChunk(i).TrackLenght + 4)
            Get #1, , B
            TempTxt = StrConv(B, vbUnicode)
            If InStr(1, TempTxt, "@LENGL", vbTextCompare) > 0 Then
                GetTrackLyric = i
                Exit Function
            End If
            x = InStr(1, TempTxt, "@T", vbTextCompare)
            If x > 0 Then
                If InStr(x - 3, TempTxt, Chr(&HFF) & Chr(1), vbTextCompare) > 0 Then
                    GetTrackLyric = i
                    Exit Function
                End If
            End If
        Next

End Function
Public Function ListDevices(ByRef nDevs As Integer) As Collection

    Set ListDevices = New Collection
    nDevs = midiOutGetNumDevs
    For i = 0 To nDevs - 1
        midiOutGetDevCaps i, midiCaps, LenB(midiCaps)
        ListDevices.Add midiCaps.szPname
    Next

End Function
Friend Sub FireEventProgress()

    Static x As Long, j As Long
    mTime.wType = TIME_TICKS
    midiStreamPosition hMidi, mTime, Len(mTime)
    midiTime = Int(((mTime.u + MidiStartTime) * (midiDesc.Tempo / mHeader.DeltaTimeTick)) / 1000)
    h = midiTime \ 3600000
    m = (midiTime \ 60000) - (h * 60)
    s = (midiTime \ 1000) - ((h * 3600) + (m * 60))
    RaiseEvent Progress(mTime.u + MidiStartTime, Format(h & ":" & m & ":" & s, "hh:mm:ss"))
    
End Sub
Friend Sub FireExtEvent(ByVal Channel As Integer, ByVal NoteValue As Integer, ByVal NoteText As String, ByVal DrumsValue As Integer, ByVal DrumsText As String, ByVal NoteOn As Boolean, ByVal TypeEvent As Integer)
    
    Select Case TypeEvent
        Case 1
            RaiseEvent MidiLevel(Channel, NoteValue)
        Case 2
            RaiseEvent NotesPlaying(Channel, NoteValue, NoteText, DrumsValue, DrumsText, NoteOn)
    End Select
    
End Sub
Private Function GetPosition(ByVal evTime As Long) As Long
    
    GetPosition = 0
    For i = 1 To UBound(Ev)
        If evTime <= Ev(i).dwStreamID Then
            GetPosition = i
            Exit For
        End If
    Next

End Function
Sub PlayMidi()
    
    Dim lSize As Long, prop As MIDIPROPTEMPO
    Select Case mvarStatus
        Case MIDI_PLAYING
            StopEvents
        Case MIDI_INVALIDFILE
            Exit Sub
    End Select
    
    If hMidi <> 0 Then StopEvents
    HookForm FormProc
    Ret = midiStreamOpen(hMidi, CLng(mvarDevice), 1, FormProc.hWnd, App.hInstance, CALLBACK_WINDOW)
    If Ret <> 0 Then
        Call midiOutGetErrorText(Ret, MsgErr, 255)
        MsgBox MsgErr, vbCritical, App.Title
        Exit Sub
    End If
    midiStreamPause hMidi
    prop.cbStruct = Len(prop)
    prop.dwTempo = TimeDiv + ((TimeDiv / 10) * mvarVelocity)
    midiStreamProperty hMidi, prop, MIDIPROP_SET Or MIDIPROP_TEMPO
    bClose = False
    
    StartPoint = GetPosition(mvarPosition)
    MidiStartTime = mvarPosition
    EventRange = 0
    
    mvarStatus = MIDI_PLAYING
    RaiseEvent Status(MIDI_PLAYING, "Playing")
    SetMidiControls
    GetEvents
    Ret = midiStreamRestart(hMidi)
    If Ret <> 0 Then
        Call midiOutGetErrorText(Ret, MsgErr, 255)
        MsgBox MsgErr
        StopMidi
        Exit Sub
    End If
    FormProc.Timer1.Enabled = True

End Sub
Public Property Let Instrument(ByVal Channel As Integer, ByVal vData As String)
    
    mvarInstrument(Channel) = vData

End Property
Public Property Get Instrument(ByVal Channel As Integer) As String
    
    Instrument = mvarInstrument(Channel)

End Property
Private Sub ResetControls()
        
    mvarMasterVolume = MasterVolume
    mvarTranspose = 0
    mvarVelocity = 0
    RaiseEvent MasterVolumeChange(mvarMasterVolume)
    RaiseEvent TransposeChange(0)
    RaiseEvent VelocityChange(0)
    RaiseEvent Progress(0, "00:00:00")
    RaiseEvent Status(MIDI_STOPPED, "Stopped")
    RaiseEvent TextKar("", -1, "", "")
    For i = 0 To 15
        mvarInstrument(i) = 0
        mvarVolume(i) = 0
        mvarBalance(i) = 63
        mvarMuteChannel(i) = True
        mvarValidChannel(i) = False
        mvarChorus(i) = 0
        mvarPhaser(i) = 0
        mvarCeleste(i) = 0
        mvarTremulo(i) = 0
        RaiseEvent BalanceChange(i, mvarBalance(i))
        RaiseEvent ChannelMuteChange(i, True)
        RaiseEvent InstrumentChange(i, 0, "")
        RaiseEvent VolumeChange(i, 0)
    Next
    
End Sub
Private Sub SetMidiControls()
    
    For i = 0 To 15
        midiOutShortMsg hMidi, &H79B0 + i
        midiOutShortMsg hMidi, &HC0 + (mvarInstrument(i) * &H100) + i
        midiOutShortMsg hMidi, &H7B0 + (mvarVolume(i) * &H10000) + i
        midiOutShortMsg hMidi, &H8B0 + (mvarBalance(i) * &H10000) + i
        midiOutShortMsg hMidi, &H4080 + i
    Next
    RaiseEvent MasterVolumeChange(MasterVolume)
    
End Sub
Public Sub StopMidi()
    
    mvarStatus = MIDI_STOPPED
    RaiseEvent Status(MIDI_STOPPED, "Stopped")
    StopEvents
    For i = 0 To 15
        RaiseEvent NotesPlaying(i, 0, "", 0, "", False)
        RaiseEvent MidiLevel(i, 0)
    Next
    mvarPosition = 0
    RaiseEvent Progress(0, "00:00:00")
    RaiseEvent TextKar("", -1, "", "")
    FireEventText 0
    
End Sub
Public Sub Pause()
    
    mvarStatus = MIDI_PAUSED
    StopEvents
    For i = 0 To 15
        RaiseEvent NotesPlaying(i, 0, "", 0, "", False)
        RaiseEvent MidiLevel(i, 0)
    Next
    RaiseEvent Status(MIDI_PAUSED, "Paused")
    FireEventText 0
    MidiStartTime = GetCurrentPosition
    
End Sub
Friend Property Let ValidChannel(ByVal Channel As Integer, ByVal vData As Boolean)
    
    mvarValidChannel(Channel) = vData

End Property
Public Property Get ValidChannel(ByVal Channel As Integer) As Boolean
    
    ValidChannel = mvarValidChannel(Channel)

End Property
Public Property Let Volume(ByVal Channel As Integer, ByVal vData As Integer)
    
    mvarVolume(Channel) = vData
    midiOutShortMsg hMidi, &H7B0 + (mvarVolume(Channel) * &H10000) + Channel
    
End Property
Public Property Let Balance(ByVal Channel As Integer, ByVal vData As Integer)
    
    mvarBalance(Channel) = vData
    midiOutShortMsg hMidi, &H8B0 + (mvarBalance(Channel) * &H10000) + Channel
    
End Property
Public Property Let MasterVolume(ByVal vData As Long)
    
    mvarMasterVolume = vData
    Vol = ((mvarMasterVolume * 6553) + 5)
    Vol = "&H" & Hex(Vol) & Hex(Vol)
    midiOutSetVolume hMidi, Vol

End Property
Friend Property Let LyricText(ByVal vData As String)
    
    mvarLyricText = vData

End Property
Public Property Let SetDevice(ByVal vData As Integer)
    
    mvarDevice = vData

End Property
Public Property Let Transpose(ByVal vData As Integer)
    
    For i = 0 To 15
        midiOutShortMsg hMidi, &H78B0 + i
    Next
    mvarTranspose = vData
    RaiseEvent TransposeChange(mvarTranspose)
    
End Property
Public Property Let Velocity(ByVal vData As Integer)
    
    mvarVelocity = vData
    RaiseEvent VelocityChange(mvarVelocity)
    Dim prop As MIDIPROPTEMPO
    prop.cbStruct = Len(prop)
    prop.dwTempo = TimeDiv + ((TimeDiv / 10) * mvarVelocity)
    Call midiStreamProperty(hMidi, prop, MIDIPROP_SET Or MIDIPROP_TEMPO)

End Property
Public Property Let SetCurrentPosition(ByVal vData As Long)
    
    mvarPosition = vData
    If mvarPosition > mvarTimeLength Then mvarPosition = mvarTimeLength

End Property
Public Property Let Phaser(ByVal Channel As Integer, ByVal vData As Integer)
    
    mvarPhaser(Channel) = vData
    midiOutShortMsg hMidi, &H7F5BB0 + Channel
    midiOutShortMsg hMidi, &H7F0CB0 + Channel
    midiOutShortMsg hMidi, &H5FB0 + (mvarPhaser(Channel) * &H10000) + Channel
    
End Property
Public Property Let Tremulo(ByVal Channel As Integer, ByVal vData As Integer)
    
    mvarTremulo(Channel) = vData
    midiOutShortMsg hMidi, &H7F5BB0 + Channel
    midiOutShortMsg hMidi, &H5CB0 + (mvarTremulo(Channel) * &H10000) + Channel
    
End Property
Public Property Let Celeste(ByVal Channel As Integer, ByVal vData As Integer)
    
    mvarCeleste(Channel) = vData
    midiOutShortMsg hMidi, &H7F5BB0 + Channel
    midiOutShortMsg hMidi, &H5EB0 + (mvarCeleste(Channel) * &H10000) + Channel
    
End Property
Public Property Let Chorus(ByVal Channel As Integer, ByVal vData As Integer)
    
    mvarChorus(Channel) = vData
    midiOutShortMsg hMidi, &H7F5BB0 + Channel
    midiOutShortMsg hMidi, &H5DB0 + (mvarChorus(Channel) * &H10000) + Channel
    
End Property
Public Property Get Volume(ByVal Channel As Integer) As Integer
    
    Volume = mvarVolume(Channel)

End Property
Public Property Get Titles(ByVal nIndex As Integer) As String
    
    'array with 3 elements (0 to 2)
    Titles = mvarTitles(nIndex)
    
End Property
Public Property Get Balance(ByVal Channel As Integer) As Integer
    
    Balance = mvarBalance(Channel)

End Property
Public Property Get MasterVolume() As Long
   
    Dim lVol As Long
    midiOutGetVolume hMidi, lVol
    lVol = "&H" & Left(Hex(lVol), 4)
    mvarMasterVolume = Int((lVol - 5) / 6553)
    MasterVolume = mvarMasterVolume
    
End Property
Public Property Get LyricText() As String
    
    LyricText = mvarLyricText
    
End Property
Public Property Get Transpose() As Integer
    
    Transpose = mvarTranspose

End Property
Public Property Get TimeLength() As Long
    
    TimeLength = mvarTimeLength
    
End Property
Public Property Get Velocity() As Integer
    
    Velocity = mvarVelocity

End Property
Public Property Get GetCurrentPosition() As Long
    
    mTime.wType = TIME_TICKS
    midiStreamPosition hMidi, mTime, Len(mTime)
    mvarPosition = mTime.u + MidiStartTime
    GetCurrentPosition = mvarPosition

End Property
Public Property Get Status() As Integer
    
    Status = mvarStatus

End Property
Public Property Get Celeste(ByVal Channel As Integer) As Integer
    
    Celeste = mvarCeleste(Channel)

End Property
Public Property Get Chorus(ByVal Channel As Integer) As Integer
    
    Chorus = mvarChorus(Channel)

End Property
Public Property Get Phaser(ByVal Channel As Integer) As Integer
    
    Phaser = mvarPhaser(Channel)

End Property
Public Property Get Tremulo(ByVal Channel As Integer) As Integer
   
    Tremulo = mvarTremulo(Channel)

End Property
Public Property Let MuteChannel(ByVal Channel As Integer, ByVal vData As Boolean)
    
    mvarMuteChannel(Channel) = vData
    If Not mvarMuteChannel(Channel) Then midiOutShortMsg hMidi, &H79B0 + Channel

End Property
Public Property Get MuteChannel(ByVal Channel As Integer) As Boolean
    
    MuteChannel = mvarMuteChannel(Channel)

End Property
Private Sub BuildEventArray()
    
    Dim y() As Long, j As Long
    ReDim y(mHeader.TrackCount)
    l = 0
    For j = 0 To mTrk
        For i = 1 To mHeader.TrackCount
            If y(i) = 0 Then y(i) = 1
            If Ev1(y(i), i).dwStreamID = j Then
                Do
                    If Ev1(y(i), i).dwEvent > &H7F Then
                        l = l + 1
                        ReDim Preserve Ev(l)
                        Ev(l).dwStreamID = Ev1(y(i), i).dwStreamID
                        Ev(l).dwDeltaTime = Ev1(y(i), i).dwStreamID - Ev(l - 1).dwStreamID
                        Ev(l).dwEvent = Ev1(y(i), i).dwEvent
                        Ev(l).kIndex = Ev1(y(i), i).kIndex
                        mvarValidChannel(Ev(l).dwEvent And &HF) = True
                    End If
                    y(i) = y(i) + 1
                    If y(i) + 1 >= UBound(Ev1) Or Ev1(y(i), i).dwStreamID <> j Then Exit Do
                Loop
            End If
        Next
    Next
    Ev(1).dwDeltaTime = 0
    ReDim Ev1(0, 0)
    mvarTimeLength = Ev(l - 1).dwStreamID
    
    For i = 0 To 15
        If mvarValidChannel(i) Then
            If mvarVolume(i) = 0 Then mvarVolume(i) = &H5A
            If mvarBalance(i) = 0 Then mvarBalance(i) = &H40
            mvarMuteChannel(i) = False
            RaiseEvent VolumeChange(i, mvarVolume(i))
            RaiseEvent BalanceChange(i, mvarBalance(i))
            RaiseEvent InstrumentChange(i, mvarInstrument(i), GetPatches(mvarInstrument(i)))
            RaiseEvent ChannelMuteChange(i, False)
        Else
            mvarInstrument(i) = 0
            mvarVolume(i) = 0
            mvarBalance(i) = &H40
            RaiseEvent VolumeChange(i, 0)
            RaiseEvent BalanceChange(i, &H40)
            RaiseEvent InstrumentChange(i, 0, GetPatches(0))
            RaiseEvent ChannelMuteChange(i, True)
            mvarMuteChannel(i) = True
        End If
        DoEvents
    Next


End Sub
Public Sub ChangePatch(ByVal NewPatch As Byte, ByVal Channel As Byte)
    
    If hMidi = 0 Then Exit Sub
    midiOutShortMsg hMidi, &HC0 + (NewPatch * &H100) + Channel
    mvarInstrument(Channel) = NewPatch

End Sub
Public Sub CloseDevice()
    
    StopMidi
    DoEvents

End Sub
Private Function CvByte(ByVal B1 As Byte, ByVal B2 As Byte, ByVal B3 As Byte, ByVal B4 As Byte, ByVal nByts) As String

    Dim VarTemp As String
    VarTemp = IIf(Len(Hex(B1)) = 1, "0" & Hex(B1), Hex(B1))
    VarTemp = IIf(Len(Hex(B2)) = 1, VarTemp & "0" & Hex(B2), VarTemp & Hex(B2))
    VarTemp = IIf(Len(Hex(B3)) = 1, VarTemp & "0" & Hex(B3), VarTemp & Hex(B3))
    VarTemp = IIf(Len(Hex(B4)) = 1, VarTemp & "0" & Hex(B4), VarTemp & Hex(B4))
    CvByte = "&H" & Left(VarTemp, 2 * nByts)

End Function
Private Sub FillEventStructure(ByVal dwTime As Long, ByVal dwMessage As Long, ByVal dwTrack, ByVal kIndex As Long)
        
    nCt(dwTrack) = nCt(dwTrack) + 1
    Ptrs(dwTrack) = Ptrs(dwTrack) + dwTime
    Ev1(nCt(dwTrack), dwTrack).dwDeltaTime = dwTime
    Ev1(nCt(dwTrack), dwTrack).dwEvent = dwMessage
    Ev1(nCt(dwTrack), dwTrack).dwStreamID = Ptrs(dwTrack)
    Ev1(nCt(dwTrack), dwTrack).kIndex = kIndex
    
End Sub
Private Function GetDeltaTime(ByVal B1 As Byte, ByVal B2 As Byte, ByVal B3 As Byte, ByVal B4 As Byte, ByRef nBytes As Long) As Long
    
    Dim VarTemp As Long
    VarTemp = 0
    If B1 <= &H7F Then
        GetDeltaTime = B1
        nBytes = 1
        Exit Function
    End If
    If B2 <= &H7F Then
        GetDeltaTime = ((B1 And &H7F) * &H80) Or (B2 And &H7F)
        nBytes = 2
        Exit Function
    End If
    If B3 <= &H7F Then
        VarTemp = (B1 And &H7F) * &H80
        VarTemp = (VarTemp Or (B2 And &H7F)) * &H80
        GetDeltaTime = VarTemp Or (B3 And &H7F)
        nBytes = 3
        Exit Function
    End If
    If B4 <= &H7F Then
        VarTemp = (B1 And &H7F) * &H80
        VarTemp = (VarTemp Or (B2 And &H7F)) * &H80
        VarTemp = (VarTemp Or (B3 And &H7F)) * &H80
        GetDeltaTime = VarTemp Or (B4 And &H7F)
        nBytes = 4
        Exit Function
    End If
    GetDeltaTime = 0
    nBytes = 0
    
End Function
Public Sub OpenMidiFile(ByVal FileName As String)
    
    On Error Resume Next
    Close #1
    If mvarStatus = MIDI_PLAYING Then StopMidi

    Open FileName For Binary As #1
    Screen.MousePointer = 11
    ReadMidiHeader
    If mvarStatus = MIDI_INVALIDFILE Then
        Screen.MousePointer = 0
        Close #1
        Exit Sub
    End If
    MidiFileName = FileName
    ResetControls
    ReadMidiTracks
    ReadMidiEvents
    BuildEventArray
    TimeDiv = (midiDesc.Tempo / mHeader.DeltaTimeTick) * 24
    mvarStatus = MIDI_FILEOPEN
    RaiseEvent Status(MIDI_FILEOPEN, "File Open")
    mdTime = (mvarTimeLength * (midiDesc.Tempo / mHeader.DeltaTimeTick)) / 1000
    h = mdTime \ 3600000
    m = (mdTime \ 60000) - (h * 60)
    s = (mdTime \ 1000) - ((h * 3600) + (m * 60))
    RaiseEvent MidiInfo(Format(h & ":" & m & ":" & s, "hh:mm:ss"), midiDesc.Numerator & "/" & midiDesc.Denominator)
    Screen.MousePointer = 0
    
End Sub
Private Sub ReadMidiEvents()
    
    Dim LastEvent As Byte, nBytes As Long, B() As Byte, DeltaTime As Long, j As Long
    Dim SumOfTime As Long, TrackTxt As String, KarText As String, TrackLyric As Integer
    Dim TitleIndex As Integer
    ReDim nCt(mHeader.TrackCount)
    ReDim Ptrs(mHeader.TrackCount)
    ReDim midiDesc.TrackName(1 To mHeader.TrackCount)
    ReDim midiDesc.Instrument(1 To mHeader.TrackCount)
    ReDim Ev(1)
    ReDim Phrase(2)
    ReDim Lyric(0)
    
    mvarTitles(0) = MidiFileName
    mvarTitles(1) = ""
    mvarTitles(2) = ""
    mvarLyricText = ""
    TrackLyric = GetTrackLyric
    isMidiKar = (TrackLyric > 0)
    pIndex = 2
    mTrk = 0
    SumOfTime = 0
    TitleIndex = 0
    pIndex = 2
    
    For i = 1 To mHeader.TrackCount
        Seek #1, mChunk(i).IniTrack + 8
        ReDim B(1 To mChunk(i).TrackLenght + 4)
        Get #1, , B
        j = 1
        TrackTxt = StrConv(B, vbUnicode)
        If TrackLyric = i Then FillEventStructure 1, MEVT_SHORTMSG Or &HD0, i, 0
        Do
            If j > UBound(B) - 4 Then Exit Do
            LastTime = DeltaTime
            DeltaTime = GetDeltaTime(B(j), B(j + 1), B(j + 2), B(j + 3), nBytes)
            SumOfTime = SumOfTime + DeltaTime
            j = j + nBytes
            Select Case B(j)
                Case &H80 To &H8F
                    LastEvent = B(j)
                    FillEventStructure DeltaTime, MEVT_SHORTMSG Or CvByte(B(j + 2), B(j + 1), B(j), 0, 3), i, 0
                    j = j + 3
                Case &H90 To &H9F
                    LastEvent = B(j)
                    FillEventStructure DeltaTime, MEVT_SHORTMSG Or CvByte(B(j + 2), B(j + 1), B(j), 0, 3), i, 0
                    j = j + 3
                Case &HA0 To &HAF
                    LastEvent = B(j)
                    FillEventStructure DeltaTime, MEVT_SHORTMSG Or CvByte(B(j + 2), B(j + 1), B(j), 0, 3), i, 0
                    j = j + 3
                Case &HB0 To &HBF
                    LastEvent = B(j)
                    Select Case B(j + 1)
                        Case &H7
                            mvarVolume(B(j) - &HB0) = B(j + 2)
                        Case &H8
                            mvarBalance(B(j) - &HB0) = B(j + 2)
                    End Select
                    FillEventStructure DeltaTime, MEVT_SHORTMSG Or CvByte(B(j + 2), B(j + 1), B(j), 0, 3), i, 0
                    j = j + 3
                Case &HC0 To &HCF
                    LastEvent = B(j)
                    mvarInstrument(B(j) - &HC0) = B(j + 1)
                    FillEventStructure DeltaTime, MEVT_SHORTMSG Or CvByte(B(j + 1), B(j), 0, 0, 2), i, 0
                    j = j + 2
                Case &HD0 To &HDF
                    LastEvent = B(j)
                    FillEventStructure DeltaTime, MEVT_SHORTMSG Or CvByte(B(j + 1), B(j), 0, 0, 2), i, 0
                    j = j + 2
                Case &HE0 To &HEF
                    LastEvent = B(j)
                    FillEventStructure DeltaTime, MEVT_SHORTMSG Or CvByte(B(j + 2), B(j + 1), B(j), 0, 3), i, 0
                    j = j + 3
                Case &HF0
                    FillEventStructure DeltaTime, MEVT_SHORTMSG Or MEVT_NOP, i, 0
                    Do
                        j = j + 1
                        If B(j) = &HF7 Then Exit Do
                    Loop
                    j = j + 1
                Case &HF1 To &HFE
                    FillEventStructure DeltaTime, MEVT_SHORTMSG Or MEVT_NOP, i, 0
                    j = j + 1
                Case &HFF
                    Select Case B(j + 1)
                        Case &H0
                            j = j + B(j + 2) + 3
                        Case &H1
                            If (B(j + 3) = &H40 And B(j + 4) = &H54) Then
                                If TitleIndex <= 2 Then mvarTitles(TitleIndex) = Mid(TrackTxt, j + 5, B(j + 2) - 2)
                                TitleIndex = TitleIndex + 1
                            End If
                            If isMidiKar And TrackLyric = i Then
                                If SumOfTime > 0 Then
                                    KarText = Mid(TrackTxt, j + 3, B(j + 2))
                                    m = 0
                                    If Left(KarText, 1) <> "@" Then
                                        If Left(LTrim(KarText), 1) = "/" Then
                                            KarText = Right(LTrim(KarText), Len(LTrim(KarText)) - 1)
                                            mvarLyricText = mvarLyricText & Phrase(pIndex) & Chr(13) & Chr(10)
                                            pIndex = UBound(Phrase) + 1
                                            ReDim Preserve Phrase(pIndex)
                                            Phrase(pIndex) = KarText
                                            ts = 0
                                        ElseIf Left(LTrim(KarText), 1) = "\" Then
                                            KarText = (Right(LTrim(KarText), Len(LTrim(KarText)) - 1))
                                            mvarLyricText = mvarLyricText & Phrase(pIndex) & Chr(13) & Chr(10)
                                            pIndex = UBound(Phrase) + 1
                                            ReDim Preserve Phrase(pIndex)
                                            Phrase(pIndex) = KarText
                                            ts = 0
                                            kIndex = UBound(Lyric) + 1
                                            ReDim Preserve Lyric(kIndex)
                                            Lyric(kIndex).TxtString = ""
                                            Lyric(kIndex).FraseIndex = pIndex - 1
                                            Lyric(kIndex).TxtStringLen = 0
                                            Lyric(kIndex).TextStart = -1
                                            m = Int(DeltaTime / 2)
                                            FillEventStructure m, MEVT_SHORTMSG Or &HD0, i, kIndex
                                        Else
                                            ts = Len(Phrase(pIndex))
                                            Phrase(pIndex) = Phrase(pIndex) & KarText
                                        End If
                                        kIndex = UBound(Lyric) + 1
                                        ReDim Preserve Lyric(kIndex)
                                        Lyric(kIndex).TxtString = KarText
                                        Lyric(kIndex).FraseIndex = pIndex
                                        Lyric(kIndex).TxtStringLen = Len(KarText)
                                        Lyric(kIndex).TextStart = ts
                                        FillEventStructure DeltaTime - m, MEVT_SHORTMSG Or &HD0, i, kIndex
                                        DeltaTime = 0
                                    End If
                                End If
                            End If
                            j = j + B(j + 2) + 3
                        Case &H2
                            j = j + B(j + 2) + 3
                        Case &H3
                            midiDesc.TrackName(i) = Mid(TrackTxt, j + 3, B(j + 2))
                            j = j + B(j + 2) + 3
                        Case &H4
                            midiDesc.Instrument(i) = Mid(StrConv(B, vbUnicode), j + 3, B(j + 2))
                            j = j + B(j + 2) + 3
                        Case &H5
                            If Not isMidiKar Then
                                If SumOfTime > 0 Then
                                    KarText = Mid(TrackTxt, j + 3, B(j + 2))
                                    If Left(LTrim(KarText), 1) = "/" Or Left(LTrim(KarText), 1) = "\" Then
                                        KarText = (Right(LTrim(KarText), Len(LTrim(KarText)) - 1))
                                        mvarLyricText = mvarLyricText & Phrase(pIndex) & Chr(13) & Chr(10)
                                        pIndex = UBound(Phrase) + 1
                                        ReDim Preserve Phrase(pIndex)
                                        Phrase(pIndex) = KarText
                                        kIndex = UBound(Lyric) + 1
                                        ReDim Preserve Lyric(kIndex)
                                        Lyric(kIndex).TxtString = KarText
                                        Lyric(kIndex).FraseIndex = pIndex
                                        Lyric(kIndex).TxtStringLen = Len(KarText)
                                        Lyric(kIndex).TextStart = 0
                                    ElseIf B(j + 3) = &HD Then
                                        KarText = ""
                                        mvarLyricText = mvarLyricText & Phrase(pIndex) & Chr(13) & Chr(10)
                                        pIndex = UBound(Phrase) + 1
                                        ReDim Preserve Phrase(pIndex)
                                        ts = 0
                                    Else
                                        ts = Len(Phrase(pIndex))
                                        Phrase(pIndex) = Phrase(pIndex) & KarText
                                        kIndex = UBound(Lyric) + 1
                                        ReDim Preserve Lyric(kIndex)
                                        Lyric(kIndex).TxtString = KarText
                                        Lyric(kIndex).FraseIndex = pIndex
                                        Lyric(kIndex).TxtStringLen = Len(KarText)
                                        Lyric(kIndex).TextStart = ts
                                        FillEventStructure 0, MEVT_SHORTMSG Or &HD0, i, kIndex
                                    End If
                                Else
                                    kIndex = UBound(Lyric) + 1
                                    ReDim Preserve Lyric(kIndex)
                                    Lyric(kIndex).FraseIndex = pIndex - 1
                                    FillEventStructure 0, MEVT_SHORTMSG Or &HD0, i, kIndex
                                End If
                            End If
                            j = j + B(j + 2) + 3
                        Case &H6
                            j = j + B(j + 2) + 3
                        Case &H7
                            j = j + B(j + 2) + 3
                        Case &H8
                            j = j + B(j + 2) + 3
                        Case &H21
                            j = j + B(j + 2) + 3
                        Case &H2F
                            Exit Do
                        Case &H51
                            midiDesc.Tempo = CDec((CvByte(B(j + 3), B(j + 4), B(j + 5), 0, 3)))
                            j = j + B(j + 2) + 3
                        Case &H54
                            j = j + B(j + 2) + 3
                        Case &H58
                            midiDesc.Numerator = B(j + 3)
                            midiDesc.Denominator = 2 ^ B(j + 4)
                            midiDesc.MidiClock = B(j + 5)
                            midiDesc.MidiQuarterNote = B(j + 6)
                            j = j + B(j + 2) + 3
                        Case &H59
                            midiDesc.sfKeySignature = B(j + 3)
                            midiDesc.miKeySignature = B(j + 4)
                            j = j + B(j + 2) + 3
                        Case &H7F
                            j = j + B(j + 2) + 3
                        Case Else
                            j = j + B(j + 2) + 3
                    End Select
                    FillEventStructure DeltaTime, MEVT_SHORTMSG Or MEVT_NOP, i, 0
                Case Else
                    Select Case LastEvent
                        Case &H80 To &H8F
                            FillEventStructure DeltaTime, MEVT_SHORTMSG Or CvByte(B(j + 1), B(j), LastEvent, 0, 3), i, 0
                            j = j + 2
                        Case &H90 To &H9F
                            FillEventStructure DeltaTime, MEVT_SHORTMSG Or CvByte(B(j + 1), B(j), LastEvent, 0, 3), i, 0
                            j = j + 2
                        Case &HA0 To &HAF
                            FillEventStructure DeltaTime, MEVT_SHORTMSG Or CvByte(B(j + 1), B(j), LastEvent, 0, 3), i, 0
                            j = j + 2
                        Case &HB0 To &HBF
                            Select Case B(j)
                                Case &H7
                                    mvarVolume(LastEvent - &HB0) = B(j + 1)
                                Case &H8
                                    mvarBalance(LastEvent - &HB0) = B(j + 1)
                            End Select
                            FillEventStructure DeltaTime, MEVT_SHORTMSG Or CvByte(B(j + 1), B(j), LastEvent, 0, 3), i, 0
                            j = j + 2
                        Case &HC0 To &HCF
                            mvarInstrument(LastEvent - &HC0) = B(j)
                            FillEventStructure DeltaTime, MEVT_SHORTMSG Or CvByte(B(j), LastEvent, 0, 0, 2), i, 0
                            j = j + 1
                        Case &HD0 To &HDF
                            FillEventStructure DeltaTime, MEVT_SHORTMSG Or CvByte(B(j), LastEvent, 0, 0, 2), i, 0
                            j = j + 1
                        Case &HE0 To &HEF
                            FillEventStructure DeltaTime, MEVT_SHORTMSG Or CvByte(B(j + 1), B(j), LastEvent, 0, 3), i, 0
                            j = j + 2
                        Case Else
                            FillEventStructure DeltaTime, MEVT_SHORTMSG Or MEVT_NOP, i, 0
                            j = j + 1
                    End Select
            End Select
        Loop
        If mTrk < SumOfTime Then mTrk = SumOfTime
        SumOfTime = 0
    Next
    mvarLyricText = mvarLyricText & Phrase(UBound(Phrase)) & Chr(13) & Chr(10)
    pIndex = UBound(Phrase) + 1
    ReDim Preserve Phrase(pIndex)
    Phrase(pIndex) = ""
    Close #1
    
End Sub
Private Sub ReadMidiHeader()
    
    Dim B() As Byte
    ReDim B(1 To 14)
    Get #1, , B
    mHeader.FileSignature = Left(StrConv(B(), vbUnicode), 4)
    mHeader.SizeHeader = 6
    mHeader.FileFormat = CvByte(B(9), B(10), 0, 0, 2)
    mHeader.TrackCount = CvByte(B(11), B(12), 0, 0, 2)
    mHeader.DeltaTimeTick = CvByte(B(13), B(14), 0, 0, 2)
    If mHeader.FileSignature <> "MThd" Then
        MsgBox "Invalid file format"
        CloseDevice
        mvarStatus = MIDI_INVALIDFILE
        RaiseEvent Status(MIDI_INVALIDFILE, "Invalid File")
    End If

End Sub
Private Sub ReadMidiTracks()
    
    ReDim mChunk(1 To mHeader.TrackCount)
    Dim B() As Byte, n As Long
    For i = 1 To mHeader.TrackCount
        mChunk(i).IniTrack = Seek(1)
        ReDim B(1 To 8)
        Get #1, , B
        mChunk(i).TrackSignature = Left(StrConv(B, vbUnicode), 4)
        mChunk(i).TrackLenght = CvByte(B(5), B(6), B(7), B(8), 4)
        mChunk(i).TrackNumber = i
        Seek #1, Seek(1) + mChunk(i).TrackLenght
        mChunk(i).EndTrack = Seek(1) + 1
        If n < mChunk(i).TrackLenght Then n = mChunk(i).TrackLenght
    Next
    ReDim Ev1(1 To n, 1 To mHeader.TrackCount)
    
End Sub
Private Sub Class_Initialize()

    Set cMidi = Me
    mvarStatus = MIDI_FILENOTOPEN
    RaiseEvent Status(MIDI_FILENOTOPEN, "File not Open")
    
End Sub
Private Sub Class_Terminate()

    CloseDevice

End Sub
