Platforms to show: All Mac Windows Linux Cross-Platform
/Win/DirectShow/PlayCap with format settings
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/PlayCap with format settings
This example is the version from Thu, 31th Jul 2019.
Project "PlayCap with format settings.xojo_binary_project"
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
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
CaptureVideo
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
'dim f as FolderItem = SpecialFolder.Desktop.Child("test.avi")
Capture.SetOutputFileName type, f.NativePath, multiplexer, sink
Capture.RenderStream(DirectShowPinMBS.PIN_CATEGORY_CAPTURE, Capture.MEDIATYPE_Video, srcfilter, nil, multiplexer)
mc.Run
Return True
End Function
Sub CaptureVideo()
// Get DirectShow interfaces
GetInterfaces
// Attach the filter graph to the capture graph
Capture.SetFiltergraph(graph)
// Use the system device enumerator and class enumerator to find
// a video capture/preview device, such as a desktop USB video camera.
srcfilter = FindCaptureDevice
// Add Capture filter to our graph.
Graph.AddFilter srcfilter, "Video Capture"
dim c as DirectShowAMStreamConfigMBS = capture.GetStreamConfig(false, srcfilter)
// query current format
dim t as DirectShowMediaTypeMBS = c.Format
log "Current Format:"
dim v as DirectShowVideoInfoHeaderMBS = t.VideoInfoHeader
if v<>Nil then
log "Width: "+str(v.Width)
log "Height: "+str(v.Height)
end if
// List all the formats
dim n as integer = c.NumberOfCapabilities
log str(n)+" formats supported."
dim videoFormats() as DirectShowVideoStreamConfigCapsMBS = c.VideoCaps
dim MediaTypes() as DirectShowMediaTypeMBS = c.MediaTypes
dim MaxVideoWidth as integer
dim MaxVideoHeight as integer
for i as integer = 0 to n-1
log "Format "+str(i+1)
dim m as DirectShowMediaTypeMBS = MediaTypes(i)
v = m.VideoInfoHeader
if v<>Nil then
log "VideoInfoHeader"
log "Width: "+str(v.Width)
log "Height: "+str(v.Height)
if v.Width > MaxVideoWidth then
MaxVideoWidth = v.Width
MaxVideoHeight = v.Height
end if
end if
dim v2 as DirectShowVideoInfoHeader2MBS = m.VideoInfoHeader2
if v2<>Nil then
log "VideoInfoHeader2"
log "Width: "+str(v2.Width)
log "Height: "+str(v2.Height)
end if
dim w as DirectShowWaveFormatMBS = m.WaveFormat
if w<>Nil then
log "WaveFormat"
log "Channels: "+str(w.Channels)
log "BitsPerSample: "+str(w.BitsPerSample)
end if
dim dv as DirectShowDVInfoMBS = m.DVINFO
if dv<>Nil then
log "DVInfo"
end if
dim f as DirectShowVideoStreamConfigCapsMBS = videoFormats(i)
log "MaxOutputSizeWidth: "+str(f.MaxOutputSizeWidth)
log "MaxOutputSizeHeight: "+str(f.MaxOutputSizeHeight)
next
// we found a maximum resolution
log "MaxVideoWidth: "+str(MaxVideoWidth)
log "MaxVideoHeight: "+str(MaxVideoHeight)
// and query & set
dim m as DirectShowMediaTypeMBS = c.Format
if m<>nil then
log "Setting to "
dim v1 as DirectShowVideoInfoHeaderMBS = m.VideoInfoHeader
if v1<>nil then
v1.Width = MaxVideoWidth
v1.Height = MaxVideoHeight
end if
dim v2 as DirectShowVideoInfoHeader2MBS = m.VideoInfoHeader2
if v2<>nil then
v2.Width = MaxVideoWidth
v2.Height = MaxVideoHeight
end if
c.Format = m
if c.Lasterror <> 0 then
log str(c.Lasterror)+": "+c.LasterrorMessage
end if
end if
// Render the preview pin on the video capture filter
Capture.RenderStream(DirectShowPinMBS.PIN_CATEGORY_PREVIEW, Capture.MEDIATYPE_Video, srcfilter)
// 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 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
Function FindCaptureDevice() As DirectShowBaseFilterMBS
// Create an enumerator for the video capture devices
dim devenum as new DirectShowEnumMonikerMBS(DirectShowEnumMonikerMBS.CLSID_VideoInputDeviceCategory)
if devenum.Handle = 0 then
MsgBox "No video capture device found."
end if
dim dev as DirectShowMonikerMBS = devenum.NextObject
dim f as DirectShowBaseFilterMBS
while dev<>nil
// Bind Moniker to a filter object
f = dev.BindBaseFilter
if f<>Nil then
System.DebugLog dev.DisplayName
'Title = "Connected to "+dev.DisplayName
Return f
end if
dev = devenum.NextObject
wend
End Function
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 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
Sub log(s as string)
LogWindow.List.AddRow s
End Sub
Property Capture As DirectShowCaptureGraphBuilderMBS
Property Graph As DirectShowGraphBuilderMBS
Property MC As DirectShowMediaControlMBS
Property MEE As DirectShowMediaEventExMBS
Property VW As DirectShowVideoWindowMBS
Property srcfilter 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
Class LogWindow Inherits Window
Control List Inherits Listbox
ControlInstance List Inherits Listbox
End Control
End Class
End Project
See also:
The items on this page are in the following plugins: MBS Win Plugin.