【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
Leave a Comment