Xojo Conferences
XDCMay2019MiamiUSA

Platforms to show: All Mac Windows Linux Cross-Platform

/Win/DirectShow/Select and Capture with Audio
Function:
Required plugins for this example: MBS Win Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Win/DirectShow/Select and Capture with Audio
This example is the version from Sat, 16th Aug 2013.
Project "Select and Capture with Audio.rbp"
Class App Inherits Application
Const kEditClear = "&Löschen"
Const kFileQuit = "Beenden"
Const kFileQuitShortcut = ""
EventHandler Sub Open() if TargetWin32 then // ok else MsgBox "This example requires Windows." quit end if End EventHandler
End Class
Class Window1 Inherits Window
Control Canvas1 Inherits Canvas
ControlInstance Canvas1 Inherits Canvas
End Control
Control VList Inherits Listbox
ControlInstance VList Inherits Listbox
EventHandler Sub Change() CheckButton End EventHandler
End Control
Control ConnectButton Inherits BevelButton
ControlInstance ConnectButton Inherits BevelButton
EventHandler Sub Action() dim VideoDevice as DirectShowMonikerMBS = VList.RowTag(vList.ListIndex) dim AudioDevice as DirectShowMonikerMBS = AList.RowTag(vList.ListIndex) // Bind Moniker to a filter object videoInput = VideoDevice.BindBaseFilter if VideoDevice.Lasterror<>0 then MsgBox "VideoDevice.BindBaseFilter: "+VideoDevice.LasterrorMessage end if audioInput = AudioDevice.BindBaseFilter if AudioDevice.Lasterror<>0 then MsgBox "AudioDevice.BindBaseFilter: "+AudioDevice.LasterrorMessage end if if videoInput<>Nil and audioInput<>nil then Capture else MsgBox "Failed to open devices." end if End EventHandler
End Control
Control AList Inherits Listbox
ControlInstance AList Inherits Listbox
EventHandler Sub Change() checkButton End EventHandler
End Control
EventHandler Sub Close() CloseInterfaces End EventHandler
EventHandler Sub Maximize() if mc<>Nil then mc.run end if End EventHandler
EventHandler Sub Minimize() if mc<>Nil then mc.StopWhenReady end if End EventHandler
EventHandler Sub Open() if TargetWin32 then list alist, DirectShowEnumMonikerMBS.CLSID_AudioInputDeviceCategory, "Audio Input" list vlist, DirectShowEnumMonikerMBS.CLSID_VideoInputDeviceCategory, "Video Input" end if End EventHandler
EventHandler Sub Resized() ResizeVideoWindow End EventHandler
EventHandler Sub Resizing() ResizeVideoWindow End EventHandler
Function AblageRecord() As Boolean dim f as FolderItem = GetSaveFolderItem(FileTypes1.All, "test.avi") if f = nil then Return true mc.stop // record video dim type as DirectShowGUIDMBS = DirectShowFileSinkFilterMBS.MEDIASUBTYPE_Avi dim multiplexer as DirectShowBaseFilterMBS dim sink as DirectShowFileSinkFilterMBS // destination Capture.SetOutputFileName type, f.AbsolutePath, multiplexer, sink Capture.RenderStream(DirectShowPinMBS.PIN_CATEGORY_CAPTURE, Capture.MEDIATYPE_Video, VideoInput, nil, multiplexer) Capture.RenderStream(DirectShowPinMBS.PIN_CATEGORY_CAPTURE, Capture.MEDIATYPE_Audio, AudioInput, nil, multiplexer) dim m as DirectShowConfigAviMuxMBS = multiplexer.ConfigAviMux m.MasterStream = 1 dim i as DirectShowConfigInterleavingMBS = multiplexer.ConfigInterleaving i.mode = i.kInterleaveFull mc.Run Return True End Function
Sub Add(dest as listbox, dev As DirectShowMonikerMBS, type as string) // Microsoft calls it Displayname, but it looks more like some UniqueID dim DisplayName as string = dev.DisplayName dim p as DirectShowPropertyBagMBS = dev.Properties if p<>nil then // we show some properties DisplayName = p.FriendlyName end if dest.AddRow DisplayName dest.RowTag(dest.LastIndex) = dev End Sub
Sub Capture() const VFW_S_NOPREVIEWPIN = &h0004027E const VFW_E_NOT_IN_GRAPH = &h8004025F // Get DirectShow interfaces GetInterfaces // Attach the filter graph to the capture graph Capture.SetFiltergraph(graph) // Add Capture filter to our graph. Graph.AddFilter VideoInput, "Video Capture" if Graph.Lasterror<>0 then MsgBox "Graph.AddFilter VideoInput: "+Graph.LasterrorMessage end if Graph.AddFilter AudioInput, "Audio Capture" if Graph.Lasterror<>0 then MsgBox "Graph.AddFilter AudioInput: "+Graph.LasterrorMessage end if // Render the preview pin on the video capture filter Capture.RenderStream(DirectShowPinMBS.PIN_CATEGORY_PREVIEW, Capture.MEDIATYPE_Video, VideoInput) if Capture.Lasterror<>0 and Capture.Lasterror<>VFW_S_NOPREVIEWPIN then MsgBox "Graph.RenderStream VideoInput "+str(Capture.Lasterror)+": "+Capture.LasterrorMessage end if Capture.RenderStream(DirectShowPinMBS.PIN_CATEGORY_PREVIEW, Capture.MEDIATYPE_Audio, AudioInput) if Capture.Lasterror<>0 and Capture.Lasterror<>VFW_S_NOPREVIEWPIN then MsgBox "Graph.RenderStream AudioInput: "+str(Capture.Lasterror)+": "+Capture.LasterrorMessage end if // Set video window style and position SetupVideoWindow // Start previewing video data mc.Run if mc.Lasterror = 1 then // not yet ready, try again mc.Run end if End Sub
Sub CheckButton() ConnectButton.Enabled = alist.ListIndex >= 0 and VList.ListIndex >= 0 End Sub
Sub CloseInterfaces() // Stop previewing data if mc<>Nil then mc.StopWhenReady end if // Stop receiving events if mee<>nil then 'mee.SetNotifyWindow( end if // Relinquish ownership (IMPORTANT!) of the video window. // Failing to call Owner setter can lead to assert failures within // the video renderer, as it still assumes that it has a valid // parent window. if vw<>nil then vw.Visible = false vw.Owner = nil end if // Release DirectShow interfaces mc = nil mee = nil vw = nil Graph = nil Capture = nil End Sub
Sub GetInterfaces() // Create the filter graph graph = new DirectShowGraphBuilderMBS // Create the capture graph builder capture = new DirectShowCaptureGraphBuilderMBS // Obtain interfaces for media control and Video Window MC = Graph.MediaControl VW = Graph.VideoWindow MEE = Graph.MediaEventEx End Sub
Sub List(dest as listbox, type as DirectShowGUIDMBS, types as string) // Create an enumerator for the video capture devices dim devenum as new DirectShowEnumMonikerMBS(type) if devenum.Handle = 0 then Return end if dim dev as DirectShowMonikerMBS = devenum.NextObject while dev<>nil Add dest, dev, types dev = devenum.NextObject wend End Sub
Sub ResizeVideoWindow() if vw<>Nil then // Resize the video preview window to match owner window size vw.SetWindowPosition canvas1.Left, canvas1.top, canvas1.Width, canvas1.Height end if End Sub
Sub SetupVideoWindow() // Set the video window to be a child of the main window vw.Owner = self // Set video window style vw.WindowStyle = BitwiseOr(vw.WS_CHILD, vw.WS_CLIPCHILDREN) // Use helper function to position video window in client rect // of main application window ResizeVideoWindow // Make the video window visible, now that it is properly positioned vw.Visible = true End Sub
Property AudioInput As DirectShowBaseFilterMBS
Property Capture As DirectShowCaptureGraphBuilderMBS
Property Graph As DirectShowGraphBuilderMBS
Property MC As DirectShowMediaControlMBS
Property MEE As DirectShowMediaEventExMBS
Property VW As DirectShowVideoWindowMBS
Property VideoInput As DirectShowBaseFilterMBS
End Class
MenuBar MenuBar1
MenuItem FileMenu = "File"
MenuItem AblageRecord = "Record..."
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "Edit"
MenuItem EditUndo = "&Rückgängig"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "&Ausschneiden"
MenuItem EditCopy = "&Kopieren"
MenuItem EditPaste = "&Einfügen"
MenuItem EditClear = "#App.kEditClear"
MenuItem UntitledMenu0 = "-"
MenuItem EditSelectAll = "&Alles auswählen"
End MenuBar
FileTypes1
Filetype video/avi
End FileTypes1
End Project

See also:

Feedback, Comments & Corrections

The items on this page are in the following plugins: MBS Win Plugin.




Links
MBS Xojo blog