Wrox Programmer Forums

Need to download code?

View our list of code downloads.

Go Back   Wrox Programmer Forums > Visual Basic > VB 6 Visual Basic 6 > Pro VB 6
Password Reminder
Register
| FAQ | Members List | Calendar | Search | Today's Posts | Mark Forums Read
Pro VB 6 For advanced Visual Basic coders working in version 6 (not .NET). Beginning-level questions will be redirected to other forums, including Beginning VB 6.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Pro VB 6 section of the Wrox Programmer to Programmer discussions. This is a community of tens of thousands of software programmers and website developers including Wrox book authors and readers. As a guest, you can read any forum posting. By joining today you can post your own programming questions, respond to other developers’ questions, and eliminate the ads that are displayed to guests. Registration is fast, simple and absolutely free .
DRM-free e-books 300x50
Reply
 
Thread Tools Search this Thread Display Modes
  #1 (permalink)  
Old June 15th, 2005, 05:58 AM
Friend of Wrox
Points: 1,075, Level: 12
Points: 1,075, Level: 12 Points: 1,075, Level: 12 Points: 1,075, Level: 12
Activity: 0%
Activity: 0% Activity: 0% Activity: 0%
 
Join Date: Jun 2005
Location: , , United Kingdom.
Posts: 244
Thanks: 3
Thanked 4 Times in 4 Posts
Default Media Play

Hello,

 I was wondering if anyone had a multimedia Class which worked i've tried making one(copied from peter wrights VB5 book) and the mmOpen doesn't work. Alternativly anyone who can use a MCI and make that play mp3's or wma's

Thanks Callum
__________________
Apocolypse2005, I'm a programmer - of sorts.
Reply With Quote
  #2 (permalink)  
Old June 15th, 2005, 12:24 PM
Friend of Wrox
 
Join Date: Jun 2003
Location: Alameda, ca, USA.
Posts: 627
Thanks: 0
Thanked 0 Times in 0 Posts
Default

I wrote this five years ago (according to the file timestamp), it was working... use as
    Set m_cMM = New CMultiMedia
    m_cMM.ParentHwnd = pctMedia.hwnd
where pctMedia is a Form/PictureBox where you want the file to be displayed (if it is a movie)
Marco

Code:
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CMultiMedia"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public Enum EMMStatus
    EMM_notReady
    EMM_playing
    EMM_paused
    EMM_stopped
    EMM_unknow
End Enum

Private m_strAlias As String
Private m_strPath As String
Private m_lParentHwnd As Long
Private m_bRepeat As Boolean
Private m_dLength As Double
Private m_lFrames As Long
Private m_bWait As Boolean
Private m_lWhere(3) 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 Declare Function mciGetErrorString Lib "winmm.dll" _
    Alias "mciGetErrorStringA" (ByVal dwError As Long, _
    ByVal lpstrBuffer As String, ByVal uLength As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Declare Function GetWindowRect Lib "user32" _
    (ByVal hwnd As Long, lpRect As RECT) As Long


Public Function mmOpen(ByVal sTheFile As String) As Long
    Dim lReturn As Long
    Static lCount As Long

    mmClose

    m_strPath = sTheFile

    lCount = lCount + 1
    m_strAlias = Right$(sTheFile, 3) & lCount
    If InStr(sTheFile, " ") Then sTheFile = Chr(34) & sTheFile & Chr(34)

    Dim str As String
    str = "Open " & sTheFile & " alias " & m_strAlias
    If m_lParentHwnd <> 0 Then
        str = str & " parent " & m_lParentHwnd & " style child"
    End If
    str = str & " wait"
    lReturn = mciSendString(str, "", 0, 0)
    mmOpen = lReturn

    If lReturn <> 0 Then
        Exit Function
    End If
'    If m_lParentHwnd <> 0 Then
'        SendString "window", "handle " & Format(m_lParentHwnd)
'    End If

    GetLength
    SendString "window", "state show"
'    str = SendString("setvideo", "brightness to 50")
    str = SendString("status", "video source")
'    str = SendString("status", "sharpness")
'    str = SendString("status", "tint")

    Dim ss As String
    ss = SendString("where", "source")
    Dim pvar As Variant
    pvar = Split(ss, " ")
    If VarType(pvar) And vbArray <> 0 Then
        If UBound(pvar) > 2 Then
            m_lWhere(0) = pvar(0)
            m_lWhere(1) = pvar(1)
            m_lWhere(2) = pvar(2)
            m_lWhere(3) = pvar(3)
        End If
    End If

End Function

Public Property Get mmErrorString(ByVal lErr As Long) As String
    Dim str As String
    str = Space(128)
    If mciGetErrorString(lErr, str, 128) = 0 Then
        mmErrorString = "Unknow error: & hex(lerr)"
    Else
        Dim k As Integer
        k = InStr(str, Chr(0))
        If k > 0 Then
            str = Left$(str, k)
        End If
        mmErrorString = str
    End If
End Property

Public Function mmClose() As Long
    mmClose = 0
    If m_strAlias = "" Then Exit Function
    mmClose = mciSendString("Close " & m_strAlias, "", 0, 0)
    m_strAlias = ""
    m_strPath = ""
    m_dLength = 0
    m_lWhere(0) = 0
    m_lWhere(1) = 0
    m_lWhere(2) = 0
    m_lWhere(3) = 0
End Function

Public Function mmPause() As Long
    mmPause = 0
    If m_strAlias = "" Then Exit Function
    mmPause = mciSendString("Pause " & m_strAlias, "", 0, 0)
End Function

Public Function mmPlay() As Long
    If m_strAlias = "" Then Exit Function
'    SendString "put", "destination"
    Dim str As String
    str = "Play " & m_strAlias
    If m_bWait Then
        str = str & " wait"
    End If
    If m_bRepeat Then
        str = str & " repeat"
    End If
    mmPlay = mciSendString(str, "", 0, 0)
    Dim ks As Long
    ks = GetTickCount
    Dim k As Integer
    Do
        If Me.Status = EMM_playing Then Exit Do
        k = k + 1
        If GetTickCount - ks > 1000 Then Exit Do
    Loop
    Debug.Print "Play status: ", Me.Status, k
End Function

Public Function mmStop() As Long
    If m_strAlias = "" Then Exit Function
    mmStop = mciSendString("Stop " & m_strAlias, "", 0, 0)
End Function

Public Function mmSeek(ByVal nPosition As Single) As Long
    If m_strAlias = "" Then Exit Function
    mmSeek = mciSendString("Seek " & m_strAlias & " to " & nPosition, "", 0, 0)
End Function

Public Function mmStep(ByVal lstep As Long) As Long
    mmStep = mciSendString("step " & m_strAlias & " by " & lstep, "", 0, 0)
End Function

Public Property Get FilePath() As String
    FilePath = m_strPath
End Property
Public Property Let FilePath(ByVal sFile As String)
    mmOpen sFile
End Property
Public Property Get Filename() As String
    Dim k As Integer
    k = InStrRev(m_strPath, "\")
    If k = 0 Then
        Filename = m_strPath
    Else
        Filename = Right$(m_strPath, Len(m_strPath) - k)
    End If
End Property

Public Property Let ParentHwnd(ByVal hwnd As Long)
    m_lParentHwnd = hwnd
End Property

Public Property Get Wait() As Boolean
    Wait = m_bWait
End Property
Public Property Let Wait(bWaitValue As Boolean)
    m_bWait = bWaitValue
End Property

Public Property Get HasVideo() As Boolean
    Dim str As String
    str = GetCapability("has video")
    HasVideo = (str = "true")
End Property
Public Property Get HasAudio() As Boolean
    Dim str As String
    str = GetCapability("has audio")
    HasAudio = (str = "true")
End Property
Public Property Get HasReverse() As Boolean
    Dim str As String
    str = GetCapability("has reverse")
    HasReverse = (str = "true")
End Property

Public Property Get Length() As Double
    Length = m_dLength
End Property
Public Property Get Frames() As Long
    Frames = m_lFrames
End Property
Public Property Get Repeat() As Boolean
    Repeat = m_bRepeat
End Property
Public Property Let Repeat(ByVal rpt As Boolean)
    m_bRepeat = rpt
End Property

Public Property Get Volume() As Double
    Dim st As String
    st = GetStatus("volume")
    If Len(st) > 0 Then
        Volume = st / 1000
    End If
End Property
Public Property Let Volume(ByVal fact As Double)
    If fact > 1 Then fact = 1
    If fact < 0 Then fact = 0
    SendString "setaudio", "volume to " & fact * 1000
End Property

Public Property Get AudioMute() As Boolean
    Dim st As String
    st = GetStatus("audio")
    AudioMute = Not (st = "on")
End Property
Public Property Let AudioMute(ByVal mute As Boolean)
    SendString "setaudio", IIf(mute, "off", "on")
End Property

Public Property Let Position(ByVal nPosition As Single)
    mmSeek nPosition
End Property
Public Property Get Position() As Single
    On Error Resume Next
    Dim str As String
    str = GetStatus("position")
    Position = str
End Property

Public Property Let SpeedFactor(ByVal sp As Double)
    SendString "set", "speed " & (sp * 1000)
End Property

Public Property Get Status() As EMMStatus
    Dim str As String
    str = GetStatus("mode")
    str = StrConv(str, vbLowerCase)
    Select Case str
    Case "not ready"
        Status = EMM_notReady
    Case "playing"
        Status = EMM_playing
    Case "paused"
        Status = EMM_paused
    Case "stopped"
        Status = EMM_stopped
    Case Else
        Status = EMM_unknow
    End Select
End Property
Public Property Get StatusString() As String
    StatusString = GetStatus("mode")
End Property

Public Property Get XOffset() As Long
    XOffset = m_lWhere(0)
End Property
Public Property Get XSize() As Long
    XSize = m_lWhere(2)
End Property
Public Property Get YOffset() As Long
    YOffset = m_lWhere(1)
End Property
Public Property Get YSize() As Long
    YSize = m_lWhere(3)
End Property

Public Sub SetNormalSize()
    SendString "put", "window client at 0 0 " & m_lWhere(2) & " " & m_lWhere(3)
End Sub
Public Sub StretchDisplay()
    Dim rc As RECT
    If m_strAlias = "" Then Exit Sub
    GetWindowRect m_lParentHwnd, rc
    Dim w As Long
    Dim h As Long
    w = rc.Right - rc.Left
    h = rc.Bottom - rc.Top
    Dim xx As Long
    xx = w * m_lWhere(3) / m_lWhere(2)
    If xx > h Then
        w = h * m_lWhere(2) / m_lWhere(3)
    Else
        h = w * m_lWhere(3) / m_lWhere(2)
'        xx = h * m_lWhere(2) / m_lWhere(3)
'        If xx > w Then
'        End If
    End If
    SendString "put", "window client at 0 0 " & w & " " & h
End Sub

Private Function GetStatus(ByVal cmd As String) As String
    On Error Resume Next
    GetStatus = SendString("status", cmd)
End Function
Private Function GetCapability(ByVal cmd As String) As String
    On Error Resume Next
    Dim sStatus As String
    sStatus = SendString("capability", cmd)
    GetCapability = StrConv(sStatus, vbLowerCase)
End Function

Private Function SendString(ByVal scommand As String, ByVal soption As String) As String
    On Error Resume Next
    Dim lRet As Long
    Dim sStatus As String
    sStatus = Space(256)
    lRet = mciSendString(scommand & " " & m_strAlias & " " & soption, sStatus, 255, 0)
    Dim nLength As Integer
    nLength = InStr(sStatus, Chr$(0))
    If nLength > 0 Then
        sStatus = Left$(sStatus, nLength - 1)
    End If
    SendString = sStatus
End Function

Private Sub GetLength()
    Dim wRate As Double
    Dim ss As String
    ss = SendString("status", "time format")

    Select Case ss
    Case "milliseconds"
        m_dLength = GetStatus("length")
        m_lFrames = m_dLength
        m_dLength = m_dLength / 1000
    Case Else
        SendString "set", "time format frames"
        wRate = GetStatus("nominal frame rate") / 1000
        m_lFrames = GetStatus("length")
        m_dLength = m_lFrames / wRate
    End Select
    Debug.Print "Time,Frames: " & m_dLength & " " & m_lFrames
    Debug.Print "Audio,Video,Reverse: " & HasAudio & " " & HasVideo & " " & HasReverse
End Sub

Private Sub Class_Terminate()
    mmClose
End Sub
Reply With Quote
  #3 (permalink)  
Old June 15th, 2005, 01:11 PM
Friend of Wrox
Points: 1,075, Level: 12
Points: 1,075, Level: 12 Points: 1,075, Level: 12 Points: 1,075, Level: 12
Activity: 0%
Activity: 0% Activity: 0% Activity: 0%
 
Join Date: Jun 2005
Location: , , United Kingdom.
Posts: 244
Thanks: 3
Thanked 4 Times in 4 Posts
Default

Thanks for that,
Reply With Quote
  #4 (permalink)  
Old June 15th, 2005, 01:15 PM
Friend of Wrox
Points: 1,075, Level: 12
Points: 1,075, Level: 12 Points: 1,075, Level: 12 Points: 1,075, Level: 12
Activity: 0%
Activity: 0% Activity: 0% Activity: 0%
 
Join Date: Jun 2005
Location: , , United Kingdom.
Posts: 244
Thanks: 3
Thanked 4 Times in 4 Posts
Default

Thanks for that,
       I am not a pro at vb not much as a beginner but i know some stuff (i put it in here because i thought i would get better feedback!), does all that go in the class and do i use it with peter wrights stuff.
Reply With Quote
  #5 (permalink)  
Old June 15th, 2005, 04:08 PM
Friend of Wrox
 
Join Date: Jun 2003
Location: Alameda, ca, USA.
Posts: 627
Thanks: 0
Thanked 0 Times in 0 Posts
Default

I do not know peter wright's code
Create a new class, call it CMultiMedia, and paste my code after the 'Option explicit' line
It is a completely enclosed class, that exposes most of the possible actions of the winmm library
Marco
Reply With Quote
  #6 (permalink)  
Old June 16th, 2005, 01:30 PM
Friend of Wrox
Points: 1,075, Level: 12
Points: 1,075, Level: 12 Points: 1,075, Level: 12 Points: 1,075, Level: 12
Activity: 0%
Activity: 0% Activity: 0% Activity: 0%
 
Join Date: Jun 2005
Location: , , United Kingdom.
Posts: 244
Thanks: 3
Thanked 4 Times in 4 Posts
Default

thanks again,
     Do you have the VD Project to hand because that would be very useful,

Callum
Reply With Quote
  #7 (permalink)  
Old June 16th, 2005, 03:11 PM
Friend of Wrox
 
Join Date: Jun 2003
Location: Alameda, ca, USA.
Posts: 627
Thanks: 0
Thanked 0 Times in 0 Posts
Default

did you mean VB project? The only place I use that class is in a huge project that I cannot publish (it is basically a replacement for the MultiMedia player plus an image editor and slide show)
To give you a head start:

dim c as new CMultiMedia
c.mmOpen(nameOfTheFile)
c.mmPlay

all methods return 0 on success.
to get the error use mmErrorString
you can monitor the status using the Status property
well, all methods are really self-explanatory (like mmPause...)

let me know if you get in any trouble
Marco
Reply With Quote
  #8 (permalink)  
Old August 9th, 2007, 04:05 PM
Friend of Wrox
Points: 1,075, Level: 12
Points: 1,075, Level: 12 Points: 1,075, Level: 12 Points: 1,075, Level: 12
Activity: 0%
Activity: 0% Activity: 0% Activity: 0%
 
Join Date: Jun 2005
Location: , , United Kingdom.
Posts: 244
Thanks: 3
Thanked 4 Times in 4 Posts
Default

I'm back but with more knowledge know, i've learnt alot since then, looking back what i've asked all seems rather trivial!
Anyways the question is, how do you use the SpeedFactor Property?
Reply With Quote
Reply


Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is Off
HTML code is Off
Trackbacks are Off
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
play multiple song using embeded media player kumiko Javascript 0 September 10th, 2008 11:10 AM
Help. How to play media files using DirectX dextergaisie Pro VB 6 0 May 15th, 2007 06:09 AM
Link Play Window Media in GridView johnpie99 ASP.NET 2.0 Professional 0 April 12th, 2007 12:01 AM
Play Audio sumith ASP.NET 1.0 and 1.1 Basics 1 February 23rd, 2007 09:03 AM
Anyone play with XAML yet? HuhOiC C# 1 March 29th, 2004 05:30 PM



All times are GMT -4. The time now is 03:35 PM.


Powered by vBulletin®
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
© 2013 John Wiley & Sons, Inc.