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

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, encoder, 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" 'srcfilter.ShowPropertyDialog 'MsgBox "Result: "+Str(srcfilter.Lasterror)+": "+srcfilter.LasterrorMessage // let's pick a video encoder encoder = FindEncoder If encoder <> Nil Then Graph.AddFilter encoder, "Video Encoder" 'encoder.ShowPropertyDialog 'MsgBox "Result: "+Str(encoder.Lasterror)+": "+encoder.LasterrorMessage 'Dim AMVideoCompression As DirectShowAMVideoCompressionMBS = encoder.AMVideoCompression 'If AMVideoCompression <> Nil Then 'AMVideoCompression.ShowPropertyDialog ' 'MsgBox "Result: "+Str(AMVideoCompression.Lasterror)+": "+AMVideoCompression.LasterrorMessage 'Else 'MsgBox "No AMVideoCompression." 'End If End If 'Dim AMVideoCompression As DirectShowAMVideoCompressionMBS = srcfilter.AMVideoCompression 'If AMVideoCompression <> Nil Then 'AMVideoCompression.ShowPropertyDialog ' 'MsgBox "Result: "+Str(AMVideoCompression.Lasterror)+": "+AMVideoCompression.LasterrorMessage 'Else 'MsgBox "No AMVideoCompression." 'end if ' 'Dim AMCameraControl As DirectShowAMCameraControlMBS = srcfilter.AMCameraControl 'If AMCameraControl <> Nil Then 'AMCameraControl.ShowPropertyDialog ' 'MsgBox "Result: "+Str(AMCameraControl.Lasterror)+": "+AMCameraControl.LasterrorMessage 'Else 'MsgBox "No AMCameraControl." 'End If ' 'Dim AMCrossbar As DirectShowAMCrossbarMBS = srcfilter.AMCrossbar 'If AMCrossbar <> Nil Then 'AMCrossbar.ShowPropertyDialog ' 'MsgBox "Result: "+Str(AMCrossbar.Lasterror)+": "+AMCrossbar.LasterrorMessage 'Else 'MsgBox "No AMCrossbar." 'End If ' 'Dim AMStreamConfig2 As DirectShowAMStreamConfigMBS = capture.GetStreamConfig(False, srcfilter) 'If AMStreamConfig2 <> Nil Then 'AMStreamConfig2.ShowPropertyDialog ' 'MsgBox "Result: "+Str(AMStreamConfig2.Lasterror)+": "+AMStreamConfig2.LasterrorMessage 'Else 'MsgBox "No AMStreamConfig with srcfilter." '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

Function FindEncoder() As DirectShowBaseFilterMBS // Create an enumerator for the video capture devices Dim devenum As New DirectShowEnumMonikerMBS(DirectShowEnumMonikerMBS.CLSID_VideoCompressorCategory) 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 Dim FriendlyName As String = dev.Properties.FriendlyName System.DebugLog "FriendlyName: "+FriendlyName 'Title = "Connected to "+dev.DisplayName If InStr(FriendlyName, "Microsoft Video") > 0 Then Return f end if 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

Property Capture As DirectShowCaptureGraphBuilderMBS

Property Graph As DirectShowGraphBuilderMBS

Property MC As DirectShowMediaControlMBS

Property MEE As DirectShowMediaEventExMBS

Property VW As DirectShowVideoWindowMBS

Property encoder As DirectShowBaseFilterMBS

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