Multimedia Class Modules

[Merri]

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.php?s=&postid=1595068

[Merri]

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.

[Merri]

With the following modification you get a different visualization:


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.php?s=&postid=1595136

[aafuss]

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 ?

[Merri]

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.

[aafuss]

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

[Merri]

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


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


should be:


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?

[Merri]

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


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