ltmmConvertCtrl.WMProfile Example for Visual Basic
'**********************************************************************
'* The demo converts any video file to ASF file with custom profile *
'* The demo adds 1 audio stream and 5 video streams that differ in *
'* bitrate, this example will show how to use mutual exclusion object *
'**********************************************************************
Private m_bEnableButtons As Boolean
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Const CODEC_AUDIO_MSAUDIO = 353 ' Microsoft WMAudio
Const CODEC_VIDEO_WMV1 = 827739479 ' FOURCC( 'W', 'M', 'V', '1' )
Const MEDIATYPE_Audio = "{73647561-0000-0010-8000-00AA00389B71}"
Const MEDIATYPE_Video = "{73646976-0000-0010-8000-00AA00389B71}"
Const FORMAT_WaveFormatEx = "{05589f81-c356-11ce-bf01-00aa0055595a}"
Const FORMAT_VideoInfo = "{05589f80-c356-11ce-bf01-00aa0055595a}"
Private Type waveformatex ' 18 bytes
wFormatTag As Integer
nChannels As Integer
nSamplesPerSec As Long
nAvgBytesPerSec As Long
nBlockAlign As Integer
wBitsPerSample As Integer
cbSize As Integer
End Type
Private Type BITMAPINFOHEADER '40 bytes
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private Type RECT ' 16 bytes
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type REFERENCE_TIME ' 8 bytes
lowpart As Long
highpart As Long
End Type
Private Type VIDEOINFOHEADER ' 88 bytes
rcSource As RECT
rcTarget As RECT
dwBitRate As Long
dwBitErrorRate As Long
AvgTimePerFrame As REFERENCE_TIME
bmiHeader As BITMAPINFOHEADER
End Type
Private Sub CopyWaveFormatEx(wfex As waveformatex, wfexarr() As Byte)
CopyMemory wfex, wfexarr(0), 18
End Sub
Private Sub CopyVideoInfoHeader(vih As VIDEOINFOHEADER, viharr() As Byte)
CopyMemory vih, viharr(0), 88
End Sub
Private Sub EnableButtons()
Dim f As Boolean
Dim fname As String
Dim b As Boolean
' avoid reentrancy.
If (Not m_bEnableButtons) Then
m_bEnableButtons = True
f = ltmmConvertCtrl1.HasDialog (ltmmConvert_Dlg_Source)
cmdSourceProps.Enabled = f
b = False
fname = txtSource.Text
If (Len(fname) > 0) Then
fname = txtTarget.Text
If (Len(fname) > 0) Then
b = True
End If
End If
cmdConvert.Enabled = b
m_bEnableButtons = False
End If
End Sub
Private Sub cmbTargetFormat_Change()
ltmmConvertCtrl1.TargetFormat = cmbTargetFormat.ItemData(cmbTargetFormat.ListIndex)
#If WMSupport <> 1 Then
If ltmmConvertCtrl1.TargetFormat = ltmmConvert_TargetFormat_Asf Then
MsgBox "ASF format unavailable. Please see the documentation for instructions on enabling Windows Media formats"
End If
#End If
End Sub
Private Sub cmdAudioProcessors_Click()
ltmmConvertCtrl1.ShowDialog ltmmConvert_Dlg_AudioProcessors, frmMain.hWnd
End Sub
Private Sub cmdBrowseSource_Click()
comdlg.CancelError = True
comdlg.Filter = "Video Files (*.avi; *.qt; *.mov; *.mpg; *.mpeg; *.m1v)|*.avi; *.qt; *.mov; *.mpg; *.mpeg; *.m1v|Audio files (*.wav; *.mpa; *.mp2; *.mp3; *.au; *.aif; *.aiff; *.snd)|*.wav; *.mpa; *.mp2; *.mp3; *.au; *.aif; *.aiff; *.snd|WMT Files (*.asf; *.wma; *.wmv)|*.asf; *.wma; *.wmv|All Files (*.*)|*.*;"
comdlg.DefaultExt = "avi"
comdlg.Flags = cdlOFNFileMustExist + cdlOFNReadOnly + cdlOFNPathMustExist
On Error GoTo CancelErr
comdlg.ShowOpen
txtSource.Text = comdlg.FileName
Exit Sub
CancelErr:
Err.Clear
End Sub
Private Sub cmdBrowseTarget_Click()
comdlg.CancelError = True
comdlg.Filter = "WMT Files (*.asf; *.wma; *.wmv)|*.asf; *.wma; *.wmv|All Files (*.*)|*.*;"
comdlg.DefaultExt = "avi"
comdlg.Flags = cdlOFNOverwritePrompt + cdlOFNPathMustExist + cdlOFNCreatePrompt
On Error GoTo CancelErr
comdlg.ShowSave
txtTarget.Text = comdlg.FileName
Exit Sub
CancelErr:
Err.Clear
End Sub
Private Sub cmdConvert_Click()
Set frmConvert.ltmmConvertCtrl1 = ltmmConvertCtrl1
On Error Resume Next
SetSourceFile
SetTargetFile
frmConvert.Show 1, Me
SetEmptyTargetFile
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdSourceProps_Click()
ltmmConvertCtrl1.ShowDialog ltmmConvert_Dlg_Source, frmMain.hWnd
End Sub
Private Sub cmdVideoProcessors_Click()
ltmmConvertCtrl1.ShowDialog ltmmConvert_Dlg_VideoProcessors, frmMain.hWnd
End Sub
Private Sub Form_Load()
' Add Windows Media support?
'#If WMSupport = 1 Then
ltmmConvertCtrl1.WMCertificate = LTMM_WMCreateCertificate(WMKey$)
'#End If
ltmmConvertCtrl1.WMProfile = CreateCustomProfile
cmbTargetFormat.AddItem ("ASF (Windows Media Codecs)")
cmbTargetFormat.ItemData(cmbTargetFormat.ListCount - 1) = ltmmConvert_TargetFormat_Asf
cmbTargetFormat.AddItem ("ASF (Windows Media Codecs - LEAD Mux)")
cmbTargetFormat.ItemData(cmbTargetFormat.ListCount - 1) = ltmmConvert_TargetFormat_Asf_Compressor_Mux
cmbTargetFormat.ListIndex = 1
ltmmConvertCtrl1.TargetFormat = ltmmConvert_TargetFormat_Asf_Compressor_Mux
cmdSourceProps.Enabled = ltmmConvertCtrl1.HasDialog (ltmmConvert_Dlg_Source)
SetEmptyTargetFile
End Sub
Private Sub SetTargetFile()
ltmmConvertCtrl1.TargetFile = txtTarget.Text
EnableButtons
End Sub
Private Sub SetSourceFile()
ltmmConvertCtrl1.SourceFile = txtSource.Text
EnableButtons
End Sub
Private Sub txtSource_Change()
EnableButtons
End Sub
Private Sub txtTarget_Change()
EnableButtons
End Sub
Private Sub SetEmptyTargetFile()
ltmmConvertCtrl1.TargetFile = ""
EnableButtons
End Sub
Function CreateCustomProfile() As ltmmWMProfile
Dim manager As ltmmWMProfileManager
Dim profile As ltmmWMProfile
' create an empty profile
Set manager = New ltmmWMProfileManager
Set profile = manager.CreateEmptyProfile (ltmmWMT_VER_7_0)
profile.Name = "Custom Profile"
profile.Description = "Custom Profile Description"
' add a single audio stream
AddAudioStream manager, profile, 1, CODEC_AUDIO_MSAUDIO, 8000, 8000, 1, True
' add 5 video streams with different bit rates
For i = 0 To 4
AddVideoStream manager, profile, 2 + i, CODEC_VIDEO_WMV1, (1024 * 20) + i * 1024, 320, 240, 5 * (i + 1), 0, 8
Next
' mark all the video streams for mutual exclusion
AddMutexObject profile, 2, 5
Set CreateCustomProfile = profile
End Function
Function AddVideoStream(manager As ltmmWMProfileManager, profile As ltmmWMProfile, streamnum As Integer, fourcc As Long, bitrate As Long, width As Long, height As Long, fps As Long, quality As Long, secperkey As Long) As Boolean
Dim codecformat As ltmmWMStreamConfig
Dim mediatype As ltmmMediaType
Dim vih As VIDEOINFOHEADER
Dim candidate As Boolean
Dim candidatevih As VIDEOINFOHEADER
Dim candidatemt As ltmmMediaType
Dim mt As ltmmMediaType
Dim candidatestream As ltmmWMStreamConfig
Dim viharr(87) As Byte
candidate = False
' get the number of video codecs
codecs = manager.GetCodecInfoCount (MEDIATYPE_Video)
' search for matching codec
For codecindex = 0 To (codecs - 1)
txtInfo.Text = txtInfo.Text + manager.GetCodecName (MEDIATYPE_Video, codecindex)
formats = manager.GetCodecFormatCount (MEDIATYPE_Video, codecindex)
For formatindex = 0 To (formats - 1)
txtInfo.Text = txtInfo.Text + manager.GetCodecFormatDesc (MEDIATYPE_Video, codecindex, formatindex)
Set codecformat = manager.GetCodecFormat (MEDIATYPE_Video, codecindex, formatindex)
Set mediatype = codecformat.GetMediaType ()
If (UCase(mediatype.formattype) = UCase(FORMAT_VideoInfo)) Then
CopyVideoInfoHeader vih, mediatype.Format
If (vih.bmiHeader.biCompression = fourcc) Then
candidate = True
candidatevih = vih
Set candidatemt = mediatype
Set candidatestream = codecformat
End If
End If
Next
Next
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 = CLng((10000000# / fps) Mod &H10000)
candidatevih.AvgTimePerFrame.highpart = CLng((10000000# / fps) / &H10000)
CopyMemory viharr(0), candidatevih, 88
candidatemt.SetFormatData -1, 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
AddVideoStream = True
Else
AddVideoStream = False
End If
End Function
Function AddAudioStream(manager As ltmmWMProfileManager, profile As ltmmWMProfile, streamnum As Integer, formattag As Integer, prefbitrate As Long, samplespersec As Long, channels As Integer, withvideo As Boolean) As Boolean
Dim codecformat As ltmmWMStreamConfig
Dim mediatype As ltmmMediaType
Dim wfex As waveformatex
Dim candidate As Boolean
Dim candidatewfex As waveformatex
Dim candidatemt As ltmmMediaType
Dim mt As ltmmMediaType
Dim stream As ltmmWMStreamConfig
candidate = False
' get the number of audio codecs
codecs = manager.GetCodecInfoCount (MEDIATYPE_Audio)
' search for matching codec
For codecindex = 0 To (codecs - 1)
formats = manager.GetCodecFormatCount (MEDIATYPE_Audio, codecindex)
For formatindex = 0 To (formats - 1)
Set codecformat = manager.GetCodecFormat (MEDIATYPE_Audio, codecindex, formatindex)
Set mediatype = codecformat.GetMediaType ()
If (UCase(mediatype.formattype) = UCase(FORMAT_WaveFormatEx)) Then
CopyWaveFormatEx wfex, mediatype.Format
diff = (wfex.nAvgBytesPerSec * 8 - prefbitrate)
If (diff < 250 And diff > -250 And wfex.nSamplesPerSec = samplespersec And wfex.nChannels = channels And 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
Set candidatemt = mediatype
End If
Else
If (wfex.nBlockAlign >= candidatewfex.nBlockAlign) Then
candidatewfex = wfex
Set candidatemt = mediatype
End If
End If
Else
candidate = True
candidatewfex = wfex
Set candidatemt = mediatype
End If
End If
End If
Next
Next
If candidate Then
' modify the selected codec to support this bitrate and format
Set mt = New ltmmMediaType
mt.Type = MEDIATYPE_Audio
mt.subtype = "{" & String(8 - Len(Hex(formattag)), "0") & Hex(formattag) & "-0000-0010-8000-00AA00389B71}"
mt.FixedSizeSamples = True
mt.TemporalCompression = False
mt.SampleSize = candidatewfex.nBlockAlign
mt.formattype = FORMAT_WaveFormatEx
mt.SetFormatData -1, candidatemt.Format
Set stream = profile.CreateNewStream (MEDIATYPE_Audio)
stream.StreamNumber = streamnum
stream.StreamName = "Audio Stream"
stream.ConnectionName = "Audio"
stream.Bitrate = candidatewfex.nAvgBytesPerSec * 8
stream.SetMediaType mt
profile.AddStream stream
AddAudioStream = True
Else
AddAudioStream = False
End If
profile.ReconfigStream stream
End Function
Function AddMutexObject(profile As ltmmWMProfile, basestream As Integer, streamcount As Integer) As Boolean
Dim excl As ltmmWMMutualExclusion
' create an exclusion object
Set excl = profile.CreateNewMutualExclusion ()
' indicate that the streams differ by bit rate
' see CLSID_WMMUTEX_Bitrate in the WMSDK
excl.Type = "{D6E22A01-35DA-11D1-9034-00A0C90349BE}"
' mark all the streams for mutual exclusion
For i = 0 To (streamcount - 1)
excl.AddStream basestream + i
Next
' assign the exclusion object to the profile
profile.AddMutualExclusion excl
AddMutexObject = True
End Function