VBcoders Guest



Don't have an account yet? Register
 


Forgot Password?



Multimedia Module 1.0. A module with all the basic sub-routines and functions required to interface

by Jonathan Liu (9 Submissions)
Category: Sound/MP3
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Thu 7th February 2002
Date Added: Mon 8th February 2021
Rating: (1 Votes)

Multimedia Module 1.0. A module with all the basic sub-routines and functions required to interface with MCI in order to play all kinds of

API Declarations


'by Buttress Root Software
'
'Programmed by Jonathan Liu
'Copyright ©1999-2371 Buttress Root Software. All rights reserved.

Option Explicit
Private Declare Function GetShortPathName Lib "kernel32" _
Alias "GetShortPathNameA" (ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
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 blnReturnSeekingStatus As Boolean
Private strStatus As String
Private mmAliases() As mmAlias
Public Const MM_ALIAS_ALREADY_EXISTS = 289
Public Const MM_ALIAS_NOT_EXIST = 263
Public Const MM_PAUSE_FAILED = 302
Public Const MM_PAUSE_FAILED_NOT_PLAYING = 302
Public Const MM_PAUSE_FAILED_NOT_EXIST = 263
Public Const MM_STOP_FAILED = 263
Public Const MM_INVALID_MULTIMEDIA = "invalid_multimedia"
Public Const MM_COMMAND_SUCCESSFUL = 0
Public Const MM_COMMAND_FAILED = 263

Private Type mmAlias
Alias As String
FileName As String
Handle As Long
End Type

Private Type mmRawID3Tags
Tag As String * 3
SongName As String * 30
Artist As String * 30
Album As String * 30
Year As String * 4
Comment As String * 30
Genre As String * 1
End Type

Public Type mmID3Tags
Tag As String
SongName As String
Artist As String
Album As String
Year As String
Comment As String
Genre As String
End Type

Rate Multimedia Module 1.0. A module with all the basic sub-routines and functions required to interface



Function mmCreateAlias(ByVal strFileName As String, _
    ByVal strAlias As String, Optional ByVal lngHandle As Long) As Long
Dim lngIgnore As Long
Dim lngReturn As Long
Dim strReturn As String
Dim strShortPath As String

strShortPath = Space$(255)
strReturn = Space$(255)
lngReturn = GetShortPathName(strFileName, strShortPath, 255)
strShortPath = Left(strShortPath, lngReturn)

lngReturn = mciSendString("open " & strShortPath & " alias " & _
    strAlias, strReturn, 255, 0)

If lngHandle > 0 Then _
    lngIgnore = mciSendString("window " & strAlias & " handle " & _
        CStr(lngHandle), strReturn, 255, 0)

Select Case lngReturn
    Case MM_COMMAND_SUCCESSFUL
        mmAddEntry strFileName, strAlias, lngHandle
        strStatus = "Alias was created successfully"
    Case MM_ALIAS_ALREADY_EXISTS
        strStatus = "Alias already exists"
End Select

mmCreateAlias = lngReturn
End Function

Function mmDestroyAlias(ByVal strAlias As String) As Long
Dim lngReturn As Long
Dim strReturn As String
Dim i As Single

strReturn = Space$(255)
lngReturn = mciSendString("close " & strAlias, strReturn, 255, 0)

Select Case lngReturn
    Case MM_COMMAND_SUCCESSFUL
        mmRemoveEntry strAlias
        strStatus = "Alias was destroyed successfully"
    Case MM_ALIAS_NOT_EXIST
        strStatus = "Alias doesn't exist"
End Select

mmDestroyAlias = lngReturn
End Function

Function mmPlay(ByVal strMultimedia As String) As Long
Dim lngReturn As Long
Dim sngEntry As Single
Dim strReturn As String
Dim strShortPath As String

strShortPath = Space$(255)
strReturn = Space$(255)
lngReturn = GetShortPathName(strMultimedia, strShortPath, 255)
strShortPath = Left(strShortPath, lngReturn)

If strShortPath <> "" Then
    If mmPaused(strShortPath) = False Then _
        lngReturn = mmSeekPosition(strShortPath, 0)
    lngReturn = mciSendString("play " & strShortPath, _
        strReturn, 255, 0)
Else
    strShortPath = strMultimedia
    
    If mmPaused(strShortPath) = False Then _
        lngReturn = mmSeekPosition(strShortPath, 0)
    lngReturn = mciSendString("play " & strShortPath, _
        strReturn, 255, 0)
End If

strStatus = "PlaySound command successful"
mmPlay = lngReturn
End Function

Function mmPause(ByVal strMultimedia As String) As Long
Dim lngReturn As Long
Dim sngEntry As Single
Dim strReturn As String
Dim strShortPath As String

strShortPath = Space$(255)
strReturn = Space$(255)
lngReturn = GetShortPathName(strMultimedia, strShortPath, 255)
strShortPath = Left(strShortPath, lngReturn)
If strShortPath = "" Then strShortPath = strMultimedia
lngReturn = mciSendString("pause " & strShortPath, strReturn, 255, 0)

Select Case lngReturn
    Case MM_COMMAND_SUCCESSFUL
        strStatus = "PauseSound command successful"
    Case MM_PAUSE_FAILED_NOT_PLAYING
        strStatus = "PauseSound can't pause a file that is not playing"
    Case MM_PAUSE_FAILED_NOT_EXIST
        strStatus = "PauseSound can't pause a file that doesn't exist"
    Case MM_PAUSE_FAILED
        strStatus = "PauseSound command failed"
End Select

mmPause = lngReturn
End Function

Function mmStop(ByVal strMultimedia As String) As Long
Dim lngReturn As Long
Dim strReturn As String
Dim strShortPath As String

strShortPath = Space$(255)
strReturn = Space$(255)
lngReturn = GetShortPathName(strMultimedia, strShortPath, 255)
strShortPath = Left(strShortPath, lngReturn)
If strShortPath = "" Then strShortPath = strMultimedia
lngReturn = mciSendString("seek " & strShortPath & " to 0", strReturn, 255, 0)
lngReturn = mciSendString("stop " & strShortPath, strReturn, 255, 0)

Select Case lngReturn
    Case MM_COMMAND_SUCCESSFUL
        strStatus = "StopSound command successful"
    Case MM_STOP_FAILED
        strStatus = "StopSound command failed"
End Select

mmStop = lngReturn
End Function

Function mmSeekPosition(ByVal strMultimedia As String, _
    ByVal sngPosition As Single) As Long
Dim blnPlaying As Boolean
Dim lngReturn As Long
Dim lngHandle As Long
Dim strReturn As String
Dim strFileName As String
Dim i As Single

If mmPlaybackStatus(strMultimedia) = "playing" Then blnPlaying = True
strReturn = Space$(255)
blnReturnSeekingStatus = True

lngReturn = mciSendString("set " & strMultimedia & " time format milliseconds", _
    strReturn, 255, 0)
lngReturn = mciSendString("set " & strMultimedia & " seek exactly on", _
    strReturn, 255, 0)
lngReturn = mciSendString("seek " & strMultimedia & " to " & sngPosition, _
    strReturn, 255, 0)

blnReturnSeekingStatus = False

If blnPlaying = True Then _
    lngReturn = mciSendString("play " & strMultimedia, strReturn, 255, 0)

mmSeekPosition = lngReturn

Select Case lngReturn
    Case MM_COMMAND_SUCCESSFUL
        strStatus = "Seek command successful"
    Case MM_ALIAS_ALREADY_EXISTS
        strStatus = "Seek command failed"
End Select
End Function

Function mmLength(ByVal strMultimedia As String) As Single
Dim lngReturn As Long
Dim strReturn As String

strReturn = Space$(255)
lngReturn = mciSendString("set " & strMultimedia & " time format milliseconds", _
    strReturn, 255, 0)
lngReturn = mciSendString("status " & strMultimedia & " Length", strReturn, 255, 0)

If lngReturn = 0 Then
    mmLength = CSng(strReturn)
Else
    mmLength = -1
End If

Select Case lngReturn
    Case MM_COMMAND_SUCCESSFUL
        strStatus = "Length retreived successfully"
    Case MM_ALIAS_ALREADY_EXISTS
        strStatus = "Length retreival failed"
End Select
End Function

Function mmPosition(ByVal strMultimedia As String) As Single
Dim lngReturn As Long
Dim strReturn As String

strReturn = Space$(255)
lngReturn = mciSendString("set " & strMultimedia & " time format milliseconds", _
    strReturn, 255, 0)
lngReturn = mciSendString("status " & strMultimedia & " position", strReturn, 255, 0)

If lngReturn = 0 Then
    mmPosition = CSng(strReturn)
Else
    mmPosition = -1
End If

Select Case lngReturn
    Case MM_COMMAND_SUCCESSFUL
        strStatus = "Position retreived successfully"
    Case MM_ALIAS_ALREADY_EXISTS
        strStatus = "Position retreival failed"
End Select
End Function

Function mmPlaybackStatus(ByVal strMultimedia As String) As String
Dim lngReturn As Long
Dim strReturn As String

strReturn = Space$(255)
lngReturn = mciSendString("status " & strMultimedia & " mode", strReturn, 255, 0)

If lngReturn = 0 Then
    strReturn = Left(strReturn, InStr(1, strReturn, Chr(0), vbTextCompare) - 1)
    If blnReturnSeekingStatus = True Then mmPlaybackStatus = "Seeking"
    mmPlaybackStatus = strReturn
Else
    mmPlaybackStatus = "invalid_multimedia"
End If

Select Case lngReturn
    Case MM_COMMAND_SUCCESSFUL
        strStatus = "Position retreived successfully"
    Case MM_ALIAS_ALREADY_EXISTS
        strStatus = "Position retreival failed"
End Select
End Function

Function mmPaused(ByVal strMultimedia As String) As Boolean
Dim strStatus As String

strStatus = mmPlaybackStatus(strMultimedia)
If strStatus = "paused" Or strStatus = "stopped" Then mmPaused = True
End Function

Function mmContainsVideo(ByVal strMultimedia As String) As Boolean
mmContainsVideo = True
If mmVideoHeight(strMultimedia) + mmVideoWidth(strMultimedia) = 0 Then _
    mmContainsVideo = False
End Function

Function mmVideoHeight(ByVal strMultimedia As String) As Single
Dim strValues() As String
Dim lngReturn As Long
Dim strReturn As String

strReturn = Space$(255)
lngReturn = mciSendString("where " & strMultimedia & " destination", _
    strReturn, 255, 0)
strValues = Split(strReturn, Chr(32), -1, vbTextCompare)
If UBound(strValues) >= 3 Then mmVideoHeight = strValues(3)
End Function

Function mmVideoWidth(ByVal strMultimedia As String) As Single
Dim strValues() As String
Dim lngReturn As Long
Dim strReturn As String

strReturn = Space$(255)
lngReturn = mciSendString("where " & strMultimedia & " destination", _
    strReturn, 255, 0)
strValues = Split(strReturn, Chr(32), -1, vbTextCompare)
If UBound(strValues) >= 2 Then mmVideoWidth = strValues(2)
End Function

Function mmContainsID3Tags(strMultimedia As String) As Boolean
Dim intFreeFile As Integer
Dim strFileName As String
Dim strTag As String

strFileName = mmGetFileName(strMultimedia)
If strFileName = "" Then Exit Function
If LOF(strFileName) < 128 Then Exit Function
strTag = Space$(3)
intFreeFile = FreeFile()

Open strFileName For Binary As #intFreeFile
Get #intFreeFile, LOF(intFreeFile) - 127, strTag
Close #intFreeFile

If strTag = "TAG" Then mmContainsID3Tags = True
End Function

Function mmGetID3Tags(ByVal strMultimedia As String) As mmID3Tags
Dim intFreeFile As Integer
Dim strFileName As String
Dim RawTags As mmRawID3Tags

strFileName = mmGetFileName(strMultimedia)
If strFileName = "" Then Exit Function
If LOF(strFileName) < 128 Then Exit Function
intFreeFile = FreeFile()

Open strFileName For Binary As #intFreeFile
With RawTags
    Get #intFreeFile, LOF(intFreeFile) - 127, .Tag
    
    If .Tag <> "TAG" Then
        Close #intFreeFile
        Exit Function
    End If
    
    Get #intFreeFile, , .SongName
    Get #intFreeFile, , .Artist
    Get #intFreeFile, , .Album
    Get #intFreeFile, , .Year
    Get #intFreeFile, , .Comment
    Get #intFreeFile, , .Genre
End With

With mmGetID3Tags
    .Tag = RTrim$(RawTags.Tag)
    .SongName = RTrim$(RawTags.SongName)
    .Artist = RTrim$(RawTags.Artist)
    .Album = RTrim$(RawTags.Album)
    .Year = RTrim$(RawTags.Year)
    .Comment = RTrim$(RawTags.Comment)
    .Genre = mmGetID3TagGenre(Asc(RTrim$(RawTags.Genre)))
End With
Close #intFreeFile
End Function

Function mmGetID3TagGenre(ByVal intGenreCode As Integer) As String
Select Case intGenreCode
    Case 0
        mmGetID3TagGenre = "Blues"
    Case 1
        mmGetID3TagGenre = "Classic Rock"
    Case 2
        mmGetID3TagGenre = "Country"
    Case 3
        mmGetID3TagGenre = "Dance"
    Case 4
        mmGetID3TagGenre = "Disco"
    Case 5
        mmGetID3TagGenre = "Funk"
    Case 6
        mmGetID3TagGenre = "Grunge"
    Case 7
        mmGetID3TagGenre = "Hip-Hop"
    Case 8
        mmGetID3TagGenre = "Jazz"
    Case 9
        mmGetID3TagGenre = "Metal"
    Case 10
        mmGetID3TagGenre = "New Age"
    Case 11
        mmGetID3TagGenre = "Oldies"
    Case 12
        mmGetID3TagGenre = "Other"
    Case 13
        mmGetID3TagGenre = "Pop"
    Case 14
        mmGetID3TagGenre = "R&B"
    Case 15
        mmGetID3TagGenre = "Rap"
    Case 16
        mmGetID3TagGenre = "Reggae"
    Case 17
        mmGetID3TagGenre = "Rock"
    Case 18
        mmGetID3TagGenre = "Techno"
    Case 19
        mmGetID3TagGenre = "Industrial"
    Case 20
        mmGetID3TagGenre = "Alternative"
    Case 21
        mmGetID3TagGenre = "Ska"
    Case 22
        mmGetID3TagGenre = "Death Metal"
    Case 23
        mmGetID3TagGenre = "Pranks"
    Case 24
        mmGetID3TagGenre = "Soundtrack"
    Case 25
        mmGetID3TagGenre = "Euro-Techno"
    Case 26
        mmGetID3TagGenre = "Ambient"
    Case 27
        mmGetID3TagGenre = "Trip-Hop"
    Case 28
        mmGetID3TagGenre = "Vocal"
    Case 29
        mmGetID3TagGenre = "Jazz+Funk"
    Case 30
        mmGetID3TagGenre = "Fusion"
    Case 31
        mmGetID3TagGenre = "Trance"
    Case 32
        mmGetID3TagGenre = "Classical"
    Case 33
        mmGetID3TagGenre = "Instrumental"
    Case 34
        mmGetID3TagGenre = "Acid"
    Case 35
        mmGetID3TagGenre = "House"
    Case 36
        mmGetID3TagGenre = "Game"
    Case 37
        mmGetID3TagGenre = "Sound Clip"
    Case 38
        mmGetID3TagGenre = "Gospel"
    Case 39
        mmGetID3TagGenre = "Noise"
    Case 40
        mmGetID3TagGenre = "Alternative Rock"
    Case 41
        mmGetID3TagGenre = "Bass"
    Case 42
        mmGetID3TagGenre = "Soul"
    Case 43
        mmGetID3TagGenre = "Punk"
    Case 44
        mmGetID3TagGenre = "Space"
    Case 45
        mmGetID3TagGenre = "Meditative"
    Case 46
        mmGetID3TagGenre = "Instrumental Pop"
    Case 47
        mmGetID3TagGenre = "Instrumental Rock"
    Case 48
        mmGetID3TagGenre = "Ethic"
    Case 49
        mmGetID3TagGenre = "Gothic"
    Case 50
        mmGetID3TagGenre = "Darkwave"
    Case 51
        mmGetID3TagGenre = "Techno-Industrial"
    Case 52
        mmGetID3TagGenre = "Electronic"
    Case 53
        mmGetID3TagGenre = "Pop-Folk"
    Case 54
        mmGetID3TagGenre = "Eurodance"
    Case 55
        mmGetID3TagGenre = "Dream"
    Case 56
        mmGetID3TagGenre = "Southern Rock"
    Case 57
        mmGetID3TagGenre = "Comedy"
    Case 58
        mmGetID3TagGenre = "Cult"
    Case 59
        mmGetID3TagGenre = "Gangsta"
    Case 60
        mmGetID3TagGenre = "Top 40"
    Case 61
        mmGetID3TagGenre = "Christian Rap"
    Case 62
        mmGetID3TagGenre = "Pop/Funk"
    Case 63
        mmGetID3TagGenre = "Jungle"
    Case 64
        mmGetID3TagGenre = "Native US"
    Case 65
        mmGetID3TagGenre = "Cabaret"
    Case 66
        mmGetID3TagGenre = "New Wave"
    Case 67
        mmGetID3TagGenre = "Psychadelic"
    Case 68
        mmGetID3TagGenre = "Rave"
    Case 69
        mmGetID3TagGenre = "Showtunes"
    Case 70
        mmGetID3TagGenre = "Trailer"
    Case 71
        mmGetID3TagGenre = "Lo-Fi"
    Case 72
        mmGetID3TagGenre = "Tribal"
    Case 73
        mmGetID3TagGenre = "Acid Punk"
    Case 74
        mmGetID3TagGenre = "Acid Jazz"
    Case 75
        mmGetID3TagGenre = "Polka"
    Case 76
        mmGetID3TagGenre = "Retro"
    Case 77
        mmGetID3TagGenre = "Musical"
    Case 78
        mmGetID3TagGenre = "Rock & Roll"
    Case 79
        mmGetID3TagGenre = "Hard Rock"
    Case 80
        mmGetID3TagGenre = "Folk"
    Case 81
        mmGetID3TagGenre = "Folk-Rock"
    Case 82
        mmGetID3TagGenre = "National Folk"
    Case 83
        mmGetID3TagGenre = "Swing"
    Case 84
        mmGetID3TagGenre = "Fast Fusion"
    Case 85
        mmGetID3TagGenre = "Bebob"
    Case 86
        mmGetID3TagGenre = "Latin"
    Case 87
        mmGetID3TagGenre = "Revival"
    Case 88
        mmGetID3TagGenre = "Celtic"
    Case 89
        mmGetID3TagGenre = "Bluegrass"
    Case 90
        mmGetID3TagGenre = "Avantgarde"
    Case 91
        mmGetID3TagGenre = "Gothic Rock"
    Case 92
        mmGetID3TagGenre = "Progressive Rock"
    Case 93
        mmGetID3TagGenre = "Psychedelic Rock"
    Case 94
        mmGetID3TagGenre = "Symphonic Rock"
    Case 95
        mmGetID3TagGenre = "Slow Rock"
    Case 96
        mmGetID3TagGenre = "Big Band"
    Case 97
        mmGetID3TagGenre = "Chorus"
    Case 98
        mmGetID3TagGenre = "Easy Listening"
    Case 99
        mmGetID3TagGenre = "Acoustic"
    Case 100
        mmGetID3TagGenre = "Humour"
    Case 101
        mmGetID3TagGenre = "Speech"
    Case 102
        mmGetID3TagGenre = "Chanson"
    Case 103
        mmGetID3TagGenre = "Opera"
    Case 104
        mmGetID3TagGenre = "Chamber Music"
    Case 105
        mmGetID3TagGenre = "Sonata"
    Case 106
        mmGetID3TagGenre = "Symphony"
    Case 107
        mmGetID3TagGenre = "Booty Bass"
    Case 108
        mmGetID3TagGenre = "Primus"
    Case 109
        mmGetID3TagGenre = "Porn Groove"
    Case 110
        mmGetID3TagGenre = "Satire"
    Case 111
        mmGetID3TagGenre = "Slow Jam"
    Case 112
        mmGetID3TagGenre = "Club"
    Case 113
        mmGetID3TagGenre = "Tango"
    Case 114
        mmGetID3TagGenre = "Samba"
    Case 115
        mmGetID3TagGenre = "Folklore"
    Case 116
        mmGetID3TagGenre = "Ballad"
    Case 117
        mmGetID3TagGenre = "Power Ballad"
    Case 118
        mmGetID3TagGenre = "Rhythmic Soul"
    Case 119
        mmGetID3TagGenre = "Freestyle"
    Case 120
        mmGetID3TagGenre = "Duet"
    Case 121
        mmGetID3TagGenre = "Punk Rock"
    Case 122
        mmGetID3TagGenre = "Drum Solo"
    Case 123
        mmGetID3TagGenre = "Acapella"
    Case 124
        mmGetID3TagGenre = "Euro-House"
    Case 125
        mmGetID3TagGenre = "Dance Hall"
    Case 126
        mmGetID3TagGenre = "Goa"
    Case 127
        mmGetID3TagGenre = "Drum & Bass"
    Case 128
        mmGetID3TagGenre = "Club-House"
    Case 129
        mmGetID3TagGenre = "Hardcore"
    Case 130
        mmGetID3TagGenre = "Terror"
    Case 131
        mmGetID3TagGenre = "Indie"
    Case 132
        mmGetID3TagGenre = "BritPop"
    Case 133
        mmGetID3TagGenre = "Negerpunk"
    Case 134
        mmGetID3TagGenre = "Polsk Punk"
    Case 135
        mmGetID3TagGenre = "Beat"
    Case 136
        mmGetID3TagGenre = "Christian Gangsta"
    Case 137
        mmGetID3TagGenre = "Heavy Metal"
    Case 138
        mmGetID3TagGenre = "Black Metal"
    Case 139
        mmGetID3TagGenre = "Crossover"
    Case 140
        mmGetID3TagGenre = "Contemporary Classical"
    Case 141
        mmGetID3TagGenre = "Christian Rock"
    Case 142
        mmGetID3TagGenre = "Merengue"
    Case 143
        mmGetID3TagGenre = "Salsa"
    Case 144
        mmGetID3TagGenre = "Thrash Metal"
    Case 145
        mmGetID3TagGenre = "Anime"
    Case 146
        mmGetID3TagGenre = "JPop"
    Case 147
        mmGetID3TagGenre = "SynthPop"
End Select
End Function

Function mmSendMCIString(ByVal strMCIString As String, _
    ByRef strReturnString As String) As Long
Dim lngReturn As Long
Dim strReturn As String

strReturn = Space$(255)
lngReturn = mciSendString(strMCIString, strReturn, 255, 0)
strReturnString = strReturn
mmSendMCIString = lngReturn
End Function

Function mmIsArrayEmpty() As Boolean
On Error Resume Next
Dim lngUBound As Long

lngUBound = UBound(mmAliases)
If Err.Number <> 0 Then mmIsArrayEmpty = True
End Function

Sub mmInitArray()
If mmIsArrayEmpty() = False Then Exit Sub
ReDim mmAliases(0)
End Sub

Private Sub mmAddEntry(ByVal strFileName As String, _
    ByVal strAlias As String, Optional ByVal lngHandle As Long)
Dim sngFreeSlot As Single
Dim i As Single

Call mmInitArray
sngFreeSlot = -1

For i = 0 To UBound(mmAliases)
    If mmAliases(i).Alias = "" Then
        sngFreeSlot = i
        Exit For
    End If
Next i

If sngFreeSlot = -1 Then
    sngFreeSlot = UBound(mmAliases) + 1
    ReDim Preserve mmAliases(sngFreeSlot)
End If

mmAliases(sngFreeSlot).Alias = strAlias
mmAliases(sngFreeSlot).FileName = strFileName
mmAliases(sngFreeSlot).Handle = lngHandle
Call mmOptimiseArray
End Sub

Private Sub mmRemoveEntry(ByVal strAlias As String)
Dim sngSlot As Single
Dim i As Single

Call mmInitArray
sngSlot = -1

For i = 0 To UBound(mmAliases)
    If LCase$(mmAliases(i).Alias) = LCase$(strAlias) Then
        sngSlot = i
        Exit For
    End If
Next i

If sngSlot = -1 Then Exit Sub

If sngSlot > 0 And sngSlot < UBound(mmAliases) Then
    For i = UBound(mmAliases) To sngSlot + 1 Step -1
        mmAliases(i - 1).Alias = mmAliases(i).Alias
        mmAliases(i - 1).FileName = mmAliases(i).FileName
    Next i
End If

If UBound(mmAliases) > 0 Then
    ReDim Preserve mmAliases(UBound(mmAliases) - 1)
Else
    ReDim mmAliases(0)
End If

Call mmOptimiseArray
End Sub

Private Sub mmOptimiseArray()
Dim sngEmptyAlias As Single
Dim i As Single

Call mmInitArray

Do
sngEmptyAlias = -1

For i = 1 To UBound(mmAliases)
    If mmAliases(i).Alias = "" Then
        sngEmptyAlias = i
        Exit For
    End If
Next i

If sngEmptyAlias > 0 And sngEmptyAlias < UBound(mmAliases) Then
    For i = UBound(mmAliases) To sngEmptyAlias + 1 Step -1
        mmAliases(i - 1).Alias = mmAliases(i).Alias
        mmAliases(i - 1).FileName = mmAliases(i).FileName
    Next i
End If

If sngEmptyAlias > 0 And sngEmptyAlias < UBound(mmAliases) Then
    ReDim Preserve mmAliases(UBound(mmAliases) - 1)
ElseIf sngEmptyAlias = 0 Then
    ReDim mmAliases(0)
End If
Loop Until sngEmptyAlias = -1
End Sub

Function mmGetFileName(strMultimedia As String) As String
Dim i As Single

Call mmInitArray

For i = 0 To UBound(mmAliases)
    If LCase$(mmAliases(i).Alias) = LCase$(strMultimedia) Then
        mmGetFileName = mmAliases(i).FileName
        Exit For
    End If
Next i

If mmGetFileName = "" Then Exit Function
If Dir(strMultimedia) <> "" Then mmGetFileName = strMultimedia
End Function

Function mmGetHandle(strAlias As String) As String
Dim i As Single

Call mmInitArray

For i = 0 To UBound(mmAliases)
    If LCase$(mmAliases(i).Alias) = LCase$(strAlias) Then
        mmGetHandle = mmAliases(i).Handle
        Exit For
    End If
Next i
End Function

Property Get Status() As String
Status = strStatus
End Property


Download this snippet    Add to My Saved Code

Multimedia Module 1.0. A module with all the basic sub-routines and functions required to interface Comments

No comments have been posted about Multimedia Module 1.0. A module with all the basic sub-routines and functions required to interface. Why not be the first to post a comment about Multimedia Module 1.0. A module with all the basic sub-routines and functions required to interface.

Post your comment

Subject:
Message:
0/1000 characters