Vb.net 直接显示摄像机旋转90度

Vb.net 直接显示摄像机旋转90度,vb.net,rotation,Vb.net,Rotation,我已成功使用directshow预览和录制网络摄像头中的图像,但问题是当我在平板电脑中使用该应用程序时,方向与我在PC中看到的方向不同。是否可以旋转此预览图像?我可以在保存之前旋转从预览中获取的位图“图像”,但是如果我可以在预览中显示正确的方向,这将对我非常有帮助 我已经阅读了一些建议,比如使用igraphbuilder、渲染文件等等。。。。但由于我不是一个经验丰富的VB.net开发人员,我很难理解所有这些概念。我花了很多天的时间只是为了找出不同的代码,使相机捕捉工作。但是现在遇到了定位问题 这

我已成功使用directshow预览和录制网络摄像头中的图像,但问题是当我在平板电脑中使用该应用程序时,方向与我在PC中看到的方向不同。是否可以旋转此预览图像?我可以在保存之前旋转从预览中获取的位图“图像”,但是如果我可以在预览中显示正确的方向,这将对我非常有帮助

我已经阅读了一些建议,比如使用igraphbuilder、渲染文件等等。。。。但由于我不是一个经验丰富的VB.net开发人员,我很难理解所有这些概念。我花了很多天的时间只是为了找出不同的代码,使相机捕捉工作。但是现在遇到了定位问题

这个应用程序是去第三世界国家帮助医院工作,但我现在卡住了。。。。如果有人能帮我想办法的话。我将非常感激

这就是代码的样子,如果有人可以帮助添加一些过滤器,以便我可以在90度视图中预览图像

非常感谢

Imports DirectShowLib
 Imports System
 Imports System.Diagnostics
 Imports System.Drawing
 Imports System.Drawing.Imaging
 Imports System.Runtime.InteropServices
 Imports System.Windows.Forms
 Imports System.Runtime.InteropServices.ComTypes

Public Class Form2

Dim MyPicturesFolder As String = Environment.GetFolderPath(Environment.SpecialFolder.MyPictures)

Dim D As Integer = &H8000
'Dim D As Integer = Convert.ToInt32("0X8000", 16)
Public WM_GRAPHNOTIFY As Integer = D + 1

Dim VideoWindow As IVideoWindow = Nothing
Dim MediaControl As IMediaControl = Nothing
Dim MediaEventEx As IMediaEventEx = Nothing
Dim GraphBuilder As IGraphBuilder = Nothing
Dim CaptureGraphBuilder As ICaptureGraphBuilder2 = Nothing

Enum PlayState
    Stopped
    Paused
    Running
    Init
End Enum
Dim CurrentState As PlayState = PlayState.Stopped

Dim rot As DsROTEntry = Nothing

Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs)
    closeinterfaces()
End Sub

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    CaptureVideo()
    PictureBox1.Visible = True
End Sub

Private Sub CaptureVideo()
    Dim hr As Integer = 0
    Dim sourceFilter As IBaseFilter = Nothing
    Try
        GetInterfaces()

        hr = CaptureGraphBuilder.SetFiltergraph(GraphBuilder) 'Specifies filter graph "graphbuilder" for the capture graph builder "captureGraphBuilder" to use.

        sourceFilter = FindCaptureDevice()

        hr = GraphBuilder.AddFilter(sourceFilter, "Video Capture")

        hr = CaptureGraphBuilder.RenderStream(PinCategory.Preview, MediaType.Video, sourceFilter, Nothing, Nothing)

        Marshal.ReleaseComObject(sourceFilter)

        SetupVideoWindow()

        rot = New DsROTEntry(GraphBuilder)

        hr = MediaControl.Run()

        CurrentState = PlayState.Running

    Catch ex As Exception
        MessageBox.Show("An unrecoverable error has occurred.With error : " & ex.ToString)
    End Try
End Sub

Private Sub GetInterfaces()
    Dim hr As Integer = 0
    GraphBuilder = CType(New FilterGraph, IGraphBuilder)
    CaptureGraphBuilder = CType(New CaptureGraphBuilder2, ICaptureGraphBuilder2)
    MediaControl = CType(GraphBuilder, IMediaControl)
    VideoWindow = CType(GraphBuilder, IVideoWindow)
    MediaEventEx = CType(GraphBuilder, IMediaEventEx)
    hr = MediaEventEx.SetNotifyWindow(Me.Handle, WM_GRAPHNOTIFY, IntPtr.Zero) 'This method designates a window as the recipient of messages generated by or sent to the current DirectShow object
End Sub

Public Function FindCaptureDevice() As IBaseFilter

    Dim hr As Integer = 0
    Dim classEnum As IEnumMoniker = Nothing
    Dim moniker As IMoniker() = New IMoniker(0) {}
    Dim source As Object = Nothing
    Dim devEnum As ICreateDevEnum = CType(New CreateDevEnum, ICreateDevEnum)
    hr = devEnum.CreateClassEnumerator(FilterCategory.VideoInputDevice, classEnum, 0)

    Marshal.ReleaseComObject(devEnum)
    If classEnum Is Nothing Then
        Throw New ApplicationException("No video capture device was detected.\r\n\r\n" & _
                       "This sample requires a video capture device, such as a USB WebCam,\r\n" & _
                       "to be installed and working properly.  The sample will now close.")
    End If
    If classEnum.Next(moniker.Length, moniker, IntPtr.Zero) = 0 Then
        Dim iid As Guid = GetType(IBaseFilter).GUID
        moniker(0).BindToObject(Nothing, Nothing, iid, source)
    Else
        Throw New ApplicationException("Unable to access video capture device!")
    End If
    Marshal.ReleaseComObject(moniker(0))
    Marshal.ReleaseComObject(classEnum)
    Return CType(source, IBaseFilter)
End Function

Public Sub SetupVideoWindow()
    Dim hr As Integer = 0
    'set the video window to be a child of the main window
    'putowner : Sets the owning parent window for the video playback window. 
    hr = VideoWindow.put_Owner(PictureBox1.Handle) 'Me.Handle)
    PictureBox1.Visible = False

    hr = VideoWindow.put_WindowStyle(WindowStyle.Child Or WindowStyle.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
    'put_visible : This method changes the visibility of the video window. 
    hr = VideoWindow.put_Visible(OABool.True)

End Sub

Public Sub ResizeVideoWindow()
    'Resize the video preview window to match owner window size
    'left , top , width , height
    If Not (VideoWindow Is Nothing) Then 'if the videopreview is not nothing
        VideoWindow.SetWindowPosition(0, 0, Me.Width, Me.ClientSize.Height)
    End If
End Sub

Public Sub closeinterfaces()
    '//stop previewing data
    If Not (Me.MediaControl Is Nothing) Then
        Me.MediaControl.StopWhenReady()
    End If

    Me.CurrentState = PlayState.Stopped

    '//stop recieving events
    If Not (Me.MediaEventEx Is Nothing) Then
        Me.MediaEventEx.SetNotifyWindow(IntPtr.Zero, WM_GRAPHNOTIFY, IntPtr.Zero)
    End If

    '// Relinquish ownership (IMPORTANT!) of the video window.
    '// Failing to call put_Owner can lead to assert failures within
    '// the video renderer, as it still assumes that it has a valid
    '// parent window.
    If Not (Me.VideoWindow Is Nothing) Then
        Me.VideoWindow.put_Visible(OABool.False)
        Me.VideoWindow.put_Owner(IntPtr.Zero)
    End If

    ' // Remove filter graph from the running object table
    If Not (rot Is Nothing) Then
        rot.Dispose()
        rot = Nothing
    End If

    '// Release DirectShow interfaces
    Marshal.ReleaseComObject(Me.MediaControl) : Me.MediaControl = Nothing
    Marshal.ReleaseComObject(Me.MediaEventEx) : Me.MediaEventEx = Nothing
    Marshal.ReleaseComObject(Me.VideoWindow) : Me.VideoWindow = Nothing
    Marshal.ReleaseComObject(Me.GraphBuilder) : Me.GraphBuilder = Nothing
    Marshal.ReleaseComObject(Me.CaptureGraphBuilder) : Me.CaptureGraphBuilder = Nothing

End Sub

Private Sub btnGrab_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnGrab.Click

    GrabImage()
End Sub

Public Sub GrabImage()
    '
    '' Get image from clipboard and convert it to a bitmap
    'Try
    '    MediaControl.Pause()

    '    Clipboard.SetImage(PictureBox1.Image)
    '    '
    '    If Clipboard.ContainsImage Then
    '        PictureBox2.Image = Clipboard.GetImage()
    '    End If
    'Catch
    'End Try
    Try
        MediaControl.Pause()

        Dim bmp As New Bitmap(PictureBox1.Width, PictureBox1.Height)

        Using g As Graphics = Graphics.FromImage(bmp)
            Dim pt As Point = PictureBox1.PointToScreen(New Point(0, 0))
            g.CopyFromScreen(pt.X, pt.Y, 0, 0, bmp.Size)
        End Using
        PictureBox2.Image = bmp
        PictureBox2.Visible = True

        'PictureBox1.Visible = False
    Catch
        MsgBox("error")
    End Try

End Sub

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click, btnGrab.Click
    MediaControl.Run()
End Sub

Private Sub btnSave_Click(sender As System.Object, e As System.EventArgs) Handles BtnSave.Click

    Dim newimage As Image = PictureBox2.Image

    Dim gr As Graphics = Graphics.FromImage(newimage)
    Dim myFontLabels As New Font("Arial", 40)
    Dim myBrushLabels As New SolidBrush(Color.Black)

    Dim FolderBrowser As New FolderBrowserDialog
    If FolderBrowser.ShowDialog = Windows.Forms.DialogResult.OK Then
        Me.lblPath.Text = FolderBrowser.SelectedPath & "\Amytest.bmp"
        MsgBox("msg" & Me.lblPath.Text)

    End If

    'newimage.Save(Me.lblPath.Text, ImageFormat.Jpeg)
    'MsgBox("The picture has been successfully copied and saved")

End Sub

Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click

    Dim newimage As Image = PictureBox2.Image

    Dim gr As Graphics = Graphics.FromImage(newimage)
    Dim myFontLabels As New Font("Arial", 40)
    Dim myBrushLabels As New SolidBrush(Color.Black)

    Dim _sourcefilename$ = Me.lblPath.Text
    Dim _destinationfilename$ = "C:\test.jpg"
    JpegSaveClass.SaveImage(_sourcefilename, _destinationfilename)

End Sub

DirectShow API没有用于旋转视频的内置功能。假设如果需要旋转,则将外部(第三方)变换过滤器插入管道并执行变换

经过多次讨论,请参见: