Public _result As Boolean = False
Public _form As ConvertCtrlForm = New ConvertCtrlForm()
Private Const CODEC_AUDIO_MSAUDIO As Integer = 353 ' Microsoft WMAudio
Private Const CODEC_VIDEO_WMV1 As Integer = 827739479 ' FOURCC( "W"c, "M"c, "V"c, "1"c )
Public Sub AddStreamExample()
Dim convertctrl As ConvertCtrl = _form.ConvertCtrl
Dim inFile As String = Path.Combine(LEAD_VARS.MediaDir, "ConvertCtrl_Source.avi")
Dim outFile As String = Path.Combine(LEAD_VARS.MediaDir, "WMProfile_RemoveStreamExample.avi")
Try
Dim manager As WMProfileManager = New WMProfileManager()
' create a WMProfile
convertctrl.WMProfile = CreateCustomProfile(manager)
' get the video stream and remove it from the config
Dim strm As WMStreamConfig = convertctrl.WMProfile.GetStream(0)
convertctrl.WMProfile.RemoveStream(strm)
' dispose of the manager
manager.Dispose()
Catch e1 As Exception
_result = False
End Try
' we'll loop on the state and pump messages for this example.
' but you should not need to if running from a Windows Forms application.
Do While convertctrl.State = ConvertState.Running
Application.DoEvents()
Loop
End Sub
Private Function CreateCustomProfile(ByVal manager As WMProfileManager) As WMProfile
Dim profile As WMProfile = manager.CreateEmptyProfile(WMT_Version.V8)
profile.Name = "Custom Profile"
profile.Description = "Custom Profile Description"
Dim added As Boolean = AddAudioStream(manager, profile, 1, CODEC_AUDIO_MSAUDIO, 8000, 8000, 1, True)
Dim i As Integer = 0
Do While (i <= 4)
AddVideoStream(manager, profile, (2 + i), CODEC_VIDEO_WMV1, (1024 * 20) + i * 1024, 320, 240, 5 * (i + 1), 0, 8)
i += 1
Loop
' mark all the video streams for mutual exclusion
AddMutexObject(profile, 2, 5)
Return profile
End Function
Private Function AddVideoStream(ByVal manager As WMProfileManager, ByVal profile As WMProfile, ByVal streamnum As Integer, ByVal fourcc As Long, ByVal bitrate As Integer, ByVal width As Integer, ByVal height As Integer, ByVal fps As Integer, ByVal quality As Integer, ByVal secperkey As Integer) As Boolean
Dim codecformat As WMStreamConfig
Dim mediatype As MediaType
Dim vih As VideoInfoHeader
Dim candidate As Boolean
Dim candidatevih As VideoInfoHeader = New VideoInfoHeader()
Dim candidatemt As MediaType = Nothing
Dim mt As MediaType = Nothing
Dim candidatestream As WMStreamConfig = Nothing
Dim added As Boolean = False
Dim viharr As Byte() = New Byte(87) {}
candidate = False
Dim codecs As Integer = manager.GetCodecInfoCount(Leadtools.Multimedia.Constants.MEDIATYPE_Video)
Dim sinfo As String = String.Empty
' search for matching codec
Dim codecindex As Integer = 0
Do While codecindex < codecs
sinfo &= manager.GetCodecName(Leadtools.Multimedia.Constants.MEDIATYPE_Video, codecindex)
Dim formats As Integer = manager.GetCodecFormatCount(Leadtools.Multimedia.Constants.MEDIATYPE_Video, codecindex)
Dim formatindex As Integer = 0
Do While formatindex < formats
sinfo &= manager.GetCodecFormatDesc(Leadtools.Multimedia.Constants.MEDIATYPE_Video, codecindex, formatindex)
codecformat = manager.GetCodecFormat(Leadtools.Multimedia.Constants.MEDIATYPE_Video, codecindex, formatindex)
mediatype = codecformat.GetMediaType()
If mediatype.FormatType = Leadtools.Multimedia.Constants.FORMAT_VideoInfo Then
vih = mediatype.GetVideoFormatData()
If vih.bmiHeader.biCompression = fourcc Then
candidate = True
candidatevih = vih
candidatemt = mediatype
candidatestream = codecformat
End If
End If
formatindex += 1
Loop
codecindex += 1
Loop
If candidate Then
' modify the selected codec to support this bitrate and size
candidatevih.dwBitRate = bitrate
candidatevih.rcSource.Right = width
candidatevih.rcSource.Bottom = height
candidatevih.rcTarget.Right = width
candidatevih.rcTarget.Bottom = height
candidatevih.bmiHeader.biWidth = width
candidatevih.bmiHeader.biHeight = height
candidatevih.AvgTimePerFrame.lowpart = CInt((10000000 / fps) Mod 65536)
candidatevih.AvgTimePerFrame.highpart = CInt((10000000 / fps) / 65536)
StructToByteArray(candidatevih, viharr)
candidatestream.Quality = quality
candidatestream.MaxKeyFrameSpacing = secperkey
candidatestream.StreamNumber = streamnum
candidatestream.StreamName = "Video Stream"
candidatestream.ConnectionName = "Video"
candidatestream.Bitrate = bitrate
candidatestream.SetMediaType(candidatemt)
profile.AddStream(candidatestream)
added = True
End If
Return added
End Function
Private Function AddAudioStream(ByVal manager As WMProfileManager, ByVal profile As WMProfile, ByVal streamnum As Integer, ByVal formattag As Integer, ByVal prefbitrate As Integer, ByVal samplespersec As Integer, ByVal channels As Integer, ByVal withvideo As Boolean) As Boolean
Dim codecformat As WMStreamConfig
Dim mediatype As MediaType
Dim wfex As WaveFormatEx = New WaveFormatEx()
Dim added As Boolean = False
Dim candidate As Boolean
Dim candidatewfex As WaveFormatEx = New WaveFormatEx()
Dim candidatemt As MediaType = Nothing
Dim mt As MediaType
Dim stream As WMStreamConfig
candidate = False
Dim codecs As Integer = manager.GetCodecInfoCount(Leadtools.Multimedia.Constants.MEDIATYPE_Audio)
' search for matching codec
Dim codecindex As Integer = 0
Do While codecindex < codecs
Dim formats As Integer = manager.GetCodecFormatCount(Leadtools.Multimedia.Constants.MEDIATYPE_Audio, codecindex)
Dim formatindex As Integer = 0
Do While formatindex < formats
codecformat = manager.GetCodecFormat(Leadtools.Multimedia.Constants.MEDIATYPE_Audio, codecindex, formatindex)
mediatype = codecformat.GetMediaType()
If mediatype.FormatType = Leadtools.Multimedia.Constants.FORMAT_WaveFormatEx Then
ByteArrayToStruct(mediatype.Format, wfex)
Dim diff As Integer = ((wfex.nAvgBytesPerSec * 8) - prefbitrate)
If diff < 250 AndAlso diff > -250 AndAlso wfex.nSamplesPerSec = samplespersec AndAlso wfex.nChannels = channels AndAlso wfex.wFormatTag = formattag Then
If candidate Then
If withvideo Then
'
' For audio/video configurations, we want to
' find the smaller blockalign. In this case,
' the blockalign is larger, so we want to
' use the old format.
If wfex.nBlockAlign <= candidatewfex.nBlockAlign Then
candidatewfex = wfex
candidatemt = mediatype
End If
ElseIf wfex.nBlockAlign >= candidatewfex.nBlockAlign Then
candidatewfex = wfex
candidatemt = mediatype
End If
Else
candidate = True
candidatewfex = wfex
candidatemt = mediatype
End If
End If
End If
formatindex += 1
Loop
codecindex += 1
Loop
If candidate Then
' modify the selected codec to support this bitrate and format
mt = New MediaType()
mt.Type = Leadtools.Multimedia.Constants.MEDIATYPE_Audio
mt.SubType = "{" & String.Format("{08:X}", formattag) & "-0000-0010-8000-00AA00389B71}"
mt.FixedSizeSamples = True
mt.TemporalCompression = False
mt.SampleSize = candidatewfex.nBlockAlign
mt.FormatType = Leadtools.Multimedia.Constants.FORMAT_WaveFormatEx
mt.SetFormatData(-1, candidatemt.Format)
stream = profile.CreateNewStream(Leadtools.Multimedia.Constants.MEDIATYPE_Audio)
stream.StreamNumber = streamnum
stream.StreamName = "Audio Stream"
stream.ConnectionName = "Audio"
stream.Bitrate = (candidatewfex.nAvgBytesPerSec * 8)
stream.SetMediaType(mt)
profile.AddStream(stream)
profile.ReconfigStream(stream)
added = True
End If
Return added
End Function
Private Sub StructToByteArray(ByVal o As Object, ByRef dest As Byte())
Try
'convert the structure to a byte array
Dim rawSize As Integer = Marshal.SizeOf(o)
Dim handle As GCHandle = New GCHandle()
Dim buffer As IntPtr
handle = GCHandle.Alloc(dest, GCHandleType.Pinned)
buffer = handle.AddrOfPinnedObject()
Marshal.StructureToPtr(o, buffer, False)
handle.Free()
Catch ex As Exception
Throw ex
End Try
End Sub
Private Sub ByteArrayToStruct(ByVal buffer As Object, ByRef vih As WaveFormatEx)
Try
Dim handle As GCHandle = New GCHandle()
'convert the structure to a byte array
handle = GCHandle.Alloc(buffer, GCHandleType.Pinned)
Dim ptr As IntPtr = handle.AddrOfPinnedObject()
vih = CType(Marshal.PtrToStructure(ptr, GetType(WaveFormatEx)), WaveFormatEx)
handle.Free()
Catch ex As Exception
Throw ex
End Try
End Sub
Private Function AddMutexObject(ByVal profile As WMProfile, ByVal basestream As Integer, ByVal streamcount As Integer) As Boolean
Dim excl As WMMutualExclusion = profile.CreateNewMutualExclusion()
' indicate that the streams differ by bit rate
excl.Type = "{D6E22A01-35DA-11D1-9034-00A0C90349BE}"
Dim i As Integer = 0
Do While i < streamcount
excl.AddStream(basestream + i)
i += 1
Loop
' assign the exclusion object to the profile
profile.AddMutualExclusion(excl)
Return True
End Function
Private Function RemoveMutexObject(ByVal profile As WMProfile, ByVal excl As WMMutualExclusion, ByVal basestream As Integer, ByVal streamcount As Integer) As Boolean
' indicate that the streams differ by bit rate
excl.Type = "{D6E22A01-35DA-11D1-9034-00A0C90349BE}"
Dim i As Integer = 0
Do While i < streamcount
excl.RemoveStream(basestream + i)
i += 1
Loop
' remove the exclusion object from the profile
profile.RemoveMutualExclusion(excl)
Return True
End Function
Public NotInheritable Class LEAD_VARS
Public Const MediaDir As String = "C:\Program Files (x86)\LEAD Technologies\LEADTOOLS 17\Media"
End Class |
Syntax
Copy Code