Multimedia Class Modules

Here is some work I have done lately:

- clsActiveMovie
- clsBrowseForFolderDialog
- clsFileDialog
- clsID3v1
- clsVisualization
- a sample program using these classes

Basically, should ease the life if you're making an application that uses multimedia. clsActiveMovie allows to play video and music without an extra OCX: only a reference to ActiveMovie control type library is required. The dialog ones allow selecting files and folders easily (yes, FileDialog supports multiple files!). ID3v1 is selfexplanary, and Visualization provides output of a soundcard in an array.

Now, here is a screenshot of the sample program in action:
http://www.vbforums.com/attachment.p...postid=1595068

And here is the code. Please note this is a work in progress and there might be bugs. There are some files I haven't included, such as ID3v2 Class Module (which lacks writing support).

Enjoy :) And comments welcome.

With the following modification you get a different visualization:

VB Code:

Private Sub Visualization_Timer()
    Static Max(255) As Integer, Avg(255) As Integer, Curs(255) As New Collection, Maxs(255) As New Collection
    Dim A As Integer, B As Byte, Cur(255) As Long, tMax(255) As Long, Bigger As Long, Smaller As Long
    Static C As Integer, D As Boolean, Mover(255) As Long
    Dim Red As Integer, Green As Integer, Blue As Integer, Soften As Single, NewTop As Integer
    On Error Resume Next
    If MyMedia.VideoWidth > 1 Then Exit Sub
    Visualization.Enabled = False
    Visual.Update
    For A = 0 To 255
        Cur(A) = CInt(Abs(CLng(Visual.GetData(A)) + CLng(Visual.GetData(A + 1))) / 2)
        If Cur(A) > Max(A) Then Max(A) = Cur(A)
        If Cur(A) Then Avg(A) = CInt((CLng(Avg(A)) + CLng(Cur(A))) / 2)
        Cur(A) = Cur(A) + Avg(A) / 2
        If Cur(A) < 0 Then Cur(A) = 0
        tMax(A) = Max(A) + Avg(A) / 2
        If tMax(A) = 0 Then tMax(A) = 1
        Curs(A).Add Cur(A)
        Maxs(A).Add tMax(A)
        If Curs(A).Count > 10 Then Curs(A).Remove 1
        If Maxs(A).Count > 10 Then Maxs(A).Remove 1
        Smaller = 0
        Bigger = 0
        For B = 1 To Curs(A).Count
            Soften = Abs(1 + (B - Curs(A).Count / 2) / 50)
            Smaller = Smaller + Val(Curs(A).Item(B)) * Soften
            Bigger = Bigger + Val(Maxs(A).Item(B)) * Soften
        Next B
        Red = 384 / Bigger * Smaller
        Blue = (768 + (Rnd * 256)) / Bigger * Smaller
        Green = (512 + (Rnd * 64)) / Bigger * Smaller
        If Red < 0 Then Red = 0
        If Green < 0 Then Green = 0
        If Blue < 0 Then Blue = 0
        If Red > 255 Then Red = 255
        If Green > 255 Then Green = 255
        If Blue > 255 Then Blue = 255
        Mover(A) = Mover(A) * 0.5 + (Max(A) - Avg(A) + 1) / (Cur(A) + 1) * 10
        If Mover(A) > VisBG.ScaleHeight Or Mover(A) = 0 Then Mover(A) = VisBG.ScaleHeight
        BitBlt VisBG.hdc, NewTop, 0, VisBG.ScaleWidth / 256 + 1, VisBG.ScaleHeight / Mover(A) * (Mover(A) - 1), VisBG.hdc, NewTop, VisBG.ScaleHeight / Mover(A), vbSrcCopy
        SetPixel VisBG.hdc, NewTop, VisBG.ScaleHeight - 1, RGB(CByte(Red), CByte(Green), CByte(Blue))
        StretchBlt VisBG.hdc, NewTop, VisBG.ScaleHeight / Mover(A) * (Mover(A) - 1), VisBG.ScaleWidth / 256 + 1, VisBG.ScaleHeight / Mover(A), VisBG.hdc, NewTop, VisBG.ScaleHeight - 1, 1, 1, vbSrcCopy
        NewTop = NewTop + VisBG.ScaleWidth / 256 + 1
        If NewTop > Video.ScaleWidth Then Exit For
    Next A
    If D Then
        C = C - 1
        If C < 1 Then C = 0: D = False
    Else
        C = C + 1
        If C > 254 Then C = 255: D = True
    End If
    VisBG.Refresh
    BitBlt Video.hdc, 0, 0, Video.ScaleWidth, Video.ScaleHeight, VisBG.hdc, 0, 0, vbSrcCopy
    Video.CurrentX = 5
    Video.CurrentY = Video.ScaleHeight - Video.TextHeight(Playlist.Tag) - 2
    Video.Print Playlist.Tag
    Video.Refresh
    Visualization.Enabled = True
End Sub

As seen below:
http://www.vbforums.com/attachment.p...postid=1595136

Merri,
I'm getting a invalid procedure or argument when i try to add *.mnp3 files with your app, any fixes, and can I release a version for my Babya System users ?

The code is as free as it can get, so yes, you can release your own version.

As for the error, are you able to locate it? I can't help unless I know where it happens, since I seem to have no problems using it.

I get a buffer overflow when a mp3 file is played-the invalid procedure when i add a file with the add files button.

Located the overflow (it should occur only with a maximum volume):

VB Code:

Cur(A) = CInt(Abs(CLng(Visual.GetData(A)) + CLng(Visual.GetData(A + 1))) / 2)

should be:

VB Code:

Cur(A) = CInt(Abs(CLng(Visual.GetData(A)) + CLng(Visual.GetData(A + 1)) - 1) / 2)

And I still don't know what might be wrong with Add files -button. Does the invalid procedure occur immediately when you push the button or after you've selected files?

Finally found the error. Apparently my VB has crashed when I fixed this before... replace this function in clsFileDialog with the new one:

VB Code:

Public Function FileOpen(ByRef Filename As String) As Boolean
    Dim A As Integer, Temp As String, Temps() As String
    'get filename
    FileOpen = CBool(GetOpenFileName(FileDialog))
    Temps = Split(Trim$(FileDialog.lpstrFile), vbNullChar)
    If Temps(0) = vbNullString Then
        FileOpen = False
    ElseIf Temps(1) = vbNullString Then
        Filename = Temps(0)
    Else
        If Right$(Temps(0), 1) <> "\" Then Temps(0) = Temps(0) & "\"
        For A = 1 To UBound(Temps)
            If Temps(A) <> vbNullString Then Filename = Filename & "|" & Temps(0) & Temps(A)
        Next A
        Filename = Mid$(Filename, 2)
    End If
End Function