Imports System
Imports System.IO
Public Class clsCamera
Private _SelectedDevice As WIA.Device
Private _SavePath As String
Private _DeviceName As String
Private _DeviceDesc As String
Private _DeviceMfg As String
Private _DeviceWIAVersion As String
Private _DeviceDriver As String
Private _CameraMemoryStream As MemoryStream
Public Property SelectedDevice() As WIA.Device
Get
Return _SelectedDevice
End Get
Set(ByVal value As WIA.Device)
_SelectedDevice = value
End Set
End Property
Public Property SavePath() As String
Get
Return _SavePath
End Get
Set(ByVal value As String)
_SavePath = value
End Set
End Property
Public Property DeviceName() As String
Get
Return _DeviceName
End Get
Set(ByVal value As String)
_DeviceName = value
End Set
End Property
Public Property DeviceMfg() As String
Get
Return _DeviceMfg
End Get
Set(ByVal value As String)
_DeviceMfg = value
End Set
End Property
Public Property DeviceDesc() As String
Get
Return _DeviceDesc
End Get
Set(ByVal value As String)
_DeviceDesc = value
End Set
End Property
Public Property DeviceWIAVersion() As String
Get
Return _DeviceWIAVersion
End Get
Set(ByVal value As String)
_DeviceWIAVersion = value
End Set
End Property
Public Property DeviceDriver() As String
Get
Return _DeviceDriver
End Get
Set(ByVal value As String)
_DeviceDriver = value
End Set
End Property
Public Property CameraMemoryStream() As MemoryStream
Get
Return _CameraMemoryStream
End Get
Set(ByVal value As MemoryStream)
_CameraMemoryStream = value
End Set
End Property
Public Function GetDevice() As Boolean
Dim MyDevice As WIA.Device
Dim MyDialog As New WIA.CommonDialogClass
Try
'shows selectdevice dialog, if only one device, It automatically selects the device
'(not tested with two or more devices)
'**Note - Device Type checks for VideoDeviceType, for webcams, in this sample
MyDevice = MyDialog.ShowSelectDevice(WIA.WiaDeviceType.VideoDeviceType, False, True)
If Not MyDevice Is Nothing Then
'loops through device properties, only gets the ones we want to display
For Each prop As WIA.Property In MyDevice.Properties
Select Case prop.Name
Case "Manufacturer"
DeviceMfg = prop.Value.ToString
Case "Description"
DeviceDesc = prop.Value.ToString
Case "Name"
DeviceName = prop.Value.ToString
Case "WIA Version"
DeviceWIAVersion = prop.Value.ToString
Case "Driver Version"
DeviceDriver = prop.Value.ToString
End Select
Next
'sets MyDevice public selected device
SelectedDevice = MyDevice
Else
DeviceName = "No WIA Devices Found!"
End If
GetDevice = True
Catch ex As System.Exception
If ex.Message <> "Exception from HRESULT: 0x80210015" Then
MessageBox.Show("Problem! " & ex.Message, "Problem Loading Device", MessageBoxButtons.OK, MessageBoxIcon.Warning, MessageBoxDefaultButton.Button1, MessageBoxOptions.DefaultDesktopOnly)
End If
DeviceName = "No WIA Devices Found!"
End Try
End Function
Public Function GrabPic() As Boolean
Dim item As WIA.Item
Try
'executes the device's TakePicture command
item = SelectedDevice.ExecuteCommand(WIA.CommandID.wiaCommandTakePicture)
Catch ex As System.Exception
MessageBox.Show("Problem Taking Picture. Please make sure that the camera is plugged in and is not in use by another application. " & vbCrLf & "Extra Info:" & ex.Message, "Problem Grabbing Picture", MessageBoxButtons.OK, MessageBoxIcon.Warning, MessageBoxDefaultButton.Button1, MessageBoxOptions.DefaultDesktopOnly)
Exit Function
End Try
Dim jpegGuid As String
'retrieves jpegKey from registry, used in saving JPEG
Dim jpegKey As Microsoft.Win32.RegistryKey = Microsoft.Win32.Registry.ClassesRoot.OpenSubKey("CLSID\{D2923B86-15F1-46FF-A19A-DE825F919576}\SupportedExtension\.jpg")
jpegGuid = CType(jpegKey.GetValue("FormatGUID"), String)
'loops through available formats for the captured item, looking for the JPG format
For Each format As String In item.Formats
If (format = jpegGuid) Then
'transfers image to an imagefile object
Dim imagefile As WIA.ImageFile = CType(item.Transfer(format), WIA.ImageFile)
Dim Counter As Integer = 1 'counter in loop appended to filename
Dim LoopAgain As Boolean = True
'searches directory, gets next available picture name
Do Until LoopAgain = False
Dim Filename As String = SavePath & Counter.ToString & ".jpg"
'if file doesnt exist, save the file
If Not System.IO.File.Exists(Filename) Then
imagefile.SaveFile(Filename) 'saves file to disk
LoopAgain = False
End If
CameraMemoryStream = New MemoryStream(CType(imagefile.FileData.BinaryData, Byte()))
Counter = Counter + 1
GrabPic = True
Loop
End If
Next
End Function
Public Sub New()
SavePath = Application.LocalUserAppDataPath & "\Card Picture Files\"
End Sub
End Class
