CreateEmptyProfile Method

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)

      ' 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("{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 18\Media"
End Class