【VB.net】カメラ撮影 VB.net

カメラ撮影 VB.net



dll:

https://drive.google.com/file/d/1l27FGTFdOH4EOhqv78FqlGYsRJlB6RG-/view?usp=sharing

source code:

Public Class Form1

    Public Camera As DirectX.Capture.Filter

    Public CaptureInfo As DirectX.Capture.Capture

    Public CamContainer As DirectX.Capture.Filters

    Private captureImage As Image

    '初期

    Public Sub OpenPreviewWindow(ByRef objPictureBox As PictureBox)

      Try

            CamContainer = New DirectX.Capture.Filters()

            Dim no_of_cam As Integer = CamContainer.VideoInputDevices.Count

            If no_of_cam <> 0 Then

                Camera = CamContainer.VideoInputDevices(0)

                CaptureInfo = New DirectX.Capture.Capture(Camera, Nothing)

                CaptureInfo.PreviewWindow = objPictureBox

                'サイズ

                CaptureInfo.FrameSize = New Size(1920, 1080)

                CaptureInfo.Start()

            Else

                objPictureBox.Image = Nothing

                objPictureBox.SizeMode = PictureBoxSizeMode.StretchImage

                objPictureBox.BackColor = Color.Black

                objPictureBox.BackgroundImage = Nothing

                objPictureBox.BackgroundImageLayout = ImageLayout.None

                objPictureBox.Refresh()

            End If

        Catch

            objPictureBox.Image = Nothing

            objPictureBox.SizeMode = PictureBoxSizeMode.StretchImage

            objPictureBox.BackColor = Color.Black

            objPictureBox.BackgroundImage = Nothing

            objPictureBox.BackgroundImageLayout = ImageLayout.None

            objPictureBox.Refresh()

        End Try

    End Sub

    Public Sub ClosePreviewWindow(ByRef objPictureBox As PictureBox)

        On Error Resume Next

        CaptureInfo.Stop()

        CaptureInfo.Close()

        CaptureInfo.Dispose()

        objPictureBox.Image = Nothing

        objPictureBox.SizeMode = PictureBoxSizeMode.StretchImage

        objPictureBox.BackColor = Color.Gray

        objPictureBox.BackgroundImage = Nothing

        objPictureBox.BackgroundImageLayout = ImageLayout.None

        objPictureBox.Refresh()

    End Sub

    '画像撮影

    Public Sub SetGaZou(ByRef objPictureBox As PictureBox)

        On Error Resume Next

        Dim PATH_LOCAL As String

        Dim data As IDataObject

        Dim bmap As Image

        Dim wk_gazou_name As String = String.Empty

        AddHandler CaptureInfo.FrameCaptureComplete, AddressOf RefreshImage

        CaptureInfo.CaptureFrame()

        data = Nothing

    End Sub

    '画像ロードと保存

    Public Sub RefreshImage(frame As PictureBox)

        Dim PATH_LOCAL As String

        Dim bmap As Image

        Dim wk_gazou_name As String = String.Empty

        captureImage = frame.Image

        bmap = captureImage

        Try

            wk_gazou_name = "GAZOU1"

            PATH_LOCAL = TextBox1.Text

                If Not System.IO.Directory.Exists(RTrim(PATH_LOCAL)) Then

                    System.IO.Directory.CreateDirectory(RTrim(PATH_LOCAL))

                End If

                 bmap.Save(PATH_LOCAL & "\" & wk_gazou_name, Imaging.ImageFormat.Jpeg)

            ''

            Dim fs As New System.IO.FileStream(PATH_LOCAL, IO.FileMode.Open, IO.FileAccess.Read, IO.FileShare.ReadWrite)

            Dim img As Image = Image.FromStream(fs)

            fs.Close()

            PictureBox1.Image = img

        Catch

            CaptureInfo.Stop()

            CaptureInfo.Close()

            CaptureInfo.Dispose()

        End Try

    End Sub

    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load

        OpenPreviewWindow(PictureBox1)

    End Sub

    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click

        SetGaZou(PictureBox1)

    End Sub

End Class

 

Không có nhận xét nào

Được tạo bởi Blogger.