AddStream Method (WMProfile)

Imports Leadtools 
Imports Leadtools.Multimedia 
Imports LeadtoolsMultimediaExamples.Fixtures 
 
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) 
 
      ' run the conversion 
      convertctrl.SourceFile = inFile 
      convertctrl.TargetFormat = TargetFormatType.WMV 
      convertctrl.TargetFile = outFile 
      convertctrl.StartConvert() 
 
      ' 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 
 
   ' check the validity of the output file 
   Dim mediaInfo As MediaInfo = New MediaInfo() 
   Try 
      mediaInfo.SourceFile = outFile 
      If (mediaInfo.SourceFormat = SourceFormatType.WMV) Then _result = True 
   Catch e2 As Exception 
      _result = False 
   End Try 
End Sub 
 
Private Function CreateCustomProfile(ByVal manager As WMProfileManager) As WMProfile 
   Dim profile As WMProfile = manager.CreateEmptyProfile(WMT_Version.V9) 
   profile.Name = "Custom Profile" 
   profile.Description = "Custom Profile Description" 
 
   Dim added As Boolean = AddAudioStream(manager, profile, 1, CODEC_AUDIO_MSAUDIO, 8000, 8000, 1, True) 
 
   ' add 5 video streams with bitrates starting from 32KB/s (256Kbps). Increase the bitrate if you increase the video size 
   Dim i As Integer = 0 
   Do While (i <= 4) 
      AddVideoStream(manager, profile, (2 + i), CODEC_VIDEO_WMV1, (1024 * 32) + i * 1024, 400, 300, 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 = False 
   Dim candidatevih As VideoInfoHeader = New VideoInfoHeader() 
   Dim candidatemt As MediaType = Nothing 
   Dim candidatestream As WMStreamConfig = Nothing 
   Dim added As Boolean = False 
   Dim viharr As Byte() = New Byte(87) {} 
   Dim codecs As Integer = manager.GetCodecInfoCount(Leadtools.Multimedia.Constants.MEDIATYPE_Video) 
   Dim sinfo As String = String.Empty 
 
   ' width and height must be even 
   If ((width And 1) <> 0) Then width += 1 
   If ((height And 1) <> 0) Then height += 1 
 
   '  search for matching codec until I find a candidate 
   Dim codecindex As Integer = 0 
   Do While (codecindex < codecs) And Not candidate 
      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 
               ' stop searching if I found a candidate 
               Exit Do 
            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 
      ' since fps is integer, 10000000/fps always fits in a 32-bit value, so lowpart=10000000/fps and high part is always 0 
      candidatevih.AvgTimePerFrame.lowpart = CInt(10000000 / fps) 
      candidatevih.AvgTimePerFrame.highpart = 0 
 
      StructToByteArray(candidatevih, viharr) 
 
      ' candidatevih is a copy of the media type, so updating candidatevih is not enough to update the media type. 
      ' Call SetVideoFormatData to copy the updated information from candidatevih to the video format data inside candidatemt 
      ' If you just change candidatevih without calling candidatemt.SetVideoFormatData,  
      ' candidatemt is an empty media type with no width and height 
      candidatemt.SetVideoFormatData(candidatevih, Nothing, 0) 
 
      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 = False 
   Dim candidatewfex As WaveFormatEx = New WaveFormatEx() 
   Dim candidatemt As MediaType = Nothing 
   Dim mt As MediaType 
   Dim stream As WMStreamConfig 
   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("{0:X8}", 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 19\Media" 
End Class