Nicola Pievani
563 lines
17 KiB
VB.net
563 lines
17 KiB
VB.net
Imports System.IO.Path
|
|
|
|
Public Class clsCamera
|
|
Implements Observer
|
|
|
|
#Region "FIELDS & PROPERTIES"
|
|
|
|
Private m_ImgCtrl As ImageControl
|
|
Private m_isSDKLoaded As Boolean = False
|
|
Public m_idList As List(Of String) = Nothing
|
|
Public nCount As Integer = 0
|
|
Event DownloadedCompleted()
|
|
Event StatusChanged()
|
|
|
|
Private m_ConnectedCameras As Integer = 0
|
|
Public ReadOnly Property ConnectedCameras As Integer
|
|
Get
|
|
Return m_ConnectedCameras
|
|
End Get
|
|
End Property
|
|
|
|
Private m_PhotoFileName As String
|
|
ReadOnly Property PhotoFileName() As String
|
|
Get
|
|
Return m_PhotoFileName
|
|
End Get
|
|
End Property
|
|
|
|
Private m_Image As System.Drawing.Bitmap
|
|
ReadOnly Property CameraImage As Bitmap
|
|
Get
|
|
Return m_Image
|
|
End Get
|
|
End Property
|
|
|
|
Private m_DownloadDir As String = "C:\CameraMng\"
|
|
WriteOnly Property DownloadDir As String
|
|
Set(ByVal value As String)
|
|
m_DownloadDir = value
|
|
End Set
|
|
End Property
|
|
|
|
Private m_bDownloaded As Boolean
|
|
ReadOnly Property Downloaded() As Boolean
|
|
Get
|
|
Return m_bDownloaded
|
|
End Get
|
|
End Property
|
|
|
|
Private _lastError As Integer = EDS_ERR_OK
|
|
ReadOnly Property LastError() As Integer
|
|
Get
|
|
Return _lastError
|
|
End Get
|
|
End Property
|
|
|
|
Private _bodyID As String = ""
|
|
ReadOnly Property CameraID As String
|
|
Get
|
|
Return _bodyID
|
|
End Get
|
|
End Property
|
|
|
|
Private m_LbImageStatus As Label
|
|
WriteOnly Property LbImageStatus() As Label
|
|
Set(ByVal LbToSet As Label)
|
|
m_LbImageStatus = LbToSet
|
|
End Set
|
|
End Property
|
|
|
|
Private _connected As Boolean = False
|
|
ReadOnly Property Connected As Boolean
|
|
Get
|
|
Return _connected
|
|
End Get
|
|
End Property
|
|
|
|
#Region "User defined attributes"
|
|
|
|
' Save as class variable, new delegates of event handlers.
|
|
Public inPropertyEventHandler As New EdsPropertyEventHandler(AddressOf handlePropertyEvent)
|
|
Public inObjectEventHandler As New EdsObjectEventHandler(AddressOf handleObjectEvent)
|
|
Public inStateEventHandler As New EdsStateEventHandler(AddressOf handleStateEvent)
|
|
Public inProgressCallback As New EdsProgressCallback(AddressOf ProgressFunc)
|
|
|
|
'
|
|
Public Shared controller As CameraController
|
|
Public Shared model As CameraModel
|
|
Public Shared m_cmbTbl As Hashtable = New Hashtable
|
|
|
|
#End Region ' User defined attributes
|
|
|
|
Delegate Sub UpdateDelegate(ByVal from As Observable, ByVal msg As Integer, ByVal data As Integer)
|
|
|
|
#End Region ' Fields & Properties
|
|
|
|
#Region "CONSTRUCTOR"
|
|
|
|
Public Sub New()
|
|
End Sub
|
|
|
|
#End Region ' Constructor
|
|
|
|
#Region "METHODS"
|
|
|
|
Public Sub Dispose(ByVal disposing As Boolean)
|
|
End Sub
|
|
|
|
Public Function cameraModelFactory(ByVal camera As IntPtr, ByVal deviceInfo As EdsDeviceInfo) As CameraModel
|
|
' if Legacy protocol.
|
|
If deviceInfo.DeviceSubType = 0 Then
|
|
Return New CameraModelLegacy(camera)
|
|
End If
|
|
|
|
' PTP protocol.
|
|
Return New CameraModel(camera)
|
|
End Function
|
|
|
|
Public Sub TakeFoto()
|
|
Dim err As Integer = EDS_ERR_OK
|
|
|
|
'// Take a picture.
|
|
err = EdsSendCommand(model.getCameraObject(), EdsCameraCommand.kEdsCameraCommand_PressShutterButton, EdsShutterButton.kEdsCameraCommand_ShutterButton_Completely)
|
|
EdsSendCommand(model.getCameraObject(), EdsCameraCommand.kEdsCameraCommand_PressShutterButton, EdsShutterButton.kEdsCameraCommand_ShutterButton_OFF)
|
|
|
|
'// Notify Error.
|
|
If err <> EDS_ERR_OK Then
|
|
End If
|
|
|
|
controller.actionPerformed("takepicture")
|
|
|
|
Console.WriteLine("SCATTO FOTO AVVENUTO: " & MainModule.IndexProc)
|
|
End Sub
|
|
|
|
' Creo la connessione con la camera
|
|
Public Sub Connect(Optional bodyID As String = "")
|
|
If _connected Then Disconnect()
|
|
|
|
If bodyID = "" Then
|
|
' Connect(0)
|
|
Return
|
|
End If
|
|
|
|
For i As Integer = 0 To 3
|
|
Connect(i)
|
|
If CameraID = bodyID Then
|
|
Exit For
|
|
End If
|
|
If _connected Then Disconnect()
|
|
Next
|
|
End Sub
|
|
|
|
Public Sub CameraList()
|
|
If _connected Then Disconnect()
|
|
|
|
If m_idList IsNot Nothing Then
|
|
m_idList.Clear()
|
|
Else
|
|
m_idList = New List(Of String)
|
|
End If
|
|
|
|
For i As Integer = 0 To 3
|
|
Connect(i)
|
|
If Not _connected Then Exit For
|
|
m_idList.Add(CameraID)
|
|
If _connected Then Disconnect()
|
|
Next
|
|
End Sub
|
|
|
|
' Setta il valore di CameraID
|
|
Private Sub Connect(ncam As Integer)
|
|
_lastError = EDS_ERR_OK
|
|
Console.WriteLine("RICHIESTA CONNESSIONE CAMERA (" & ncam.ToString() & "): " & MainModule.IndexProc)
|
|
|
|
Dim cameraList As IntPtr = Nothing
|
|
Dim camera As IntPtr = Nothing
|
|
Dim propObj As New CameraProperty
|
|
|
|
m_ConnectedCameras = 0
|
|
_connected = False
|
|
_bodyID = ""
|
|
|
|
' Inizializzao l'ambiente software
|
|
If Not m_isSDKLoaded Then
|
|
_lastError = EdsInitializeSDK()
|
|
End If
|
|
|
|
If _lastError <> EDS_ERR_OK Then
|
|
Return
|
|
End If
|
|
|
|
m_isSDKLoaded = True
|
|
_lastError = EdsGetCameraList(cameraList)
|
|
|
|
If _lastError <> EDS_ERR_OK Then Return
|
|
|
|
_lastError = EdsGetChildCount(cameraList, m_ConnectedCameras)
|
|
If _lastError <> EDS_ERR_OK Then Return
|
|
|
|
If m_ConnectedCameras = 0 Then
|
|
_lastError = EDS_ERR_DEVICE_NOT_FOUND
|
|
Return
|
|
End If
|
|
|
|
Dim deviceInfo As EdsDeviceInfo = Nothing
|
|
|
|
If ncam > m_ConnectedCameras - 1 Then Return
|
|
|
|
'// Get the camera.
|
|
_lastError = EdsGetChildAtIndex(cameraList, ncam, camera)
|
|
|
|
If _lastError <> EDS_ERR_OK Then Return
|
|
|
|
deviceInfo = Nothing
|
|
_lastError = EdsGetDeviceInfo(camera, deviceInfo)
|
|
|
|
If _lastError <> EDS_ERR_OK Then Return
|
|
|
|
If IsNothing(camera) = True Then
|
|
_lastError = EDS_ERR_DEVICE_NOT_FOUND
|
|
Return
|
|
End If
|
|
|
|
' Lebbo il nome della Fotocamera
|
|
'Dim dt As EdsDataType
|
|
'Dim outSize As Integer
|
|
|
|
'EdsGetPropertySize(camera, kEdsPropID_ProductName, 0, dt, outSize)
|
|
|
|
'Dim outData As IntPtr = Marshal.AllocHGlobal(20)
|
|
'Dim data As String
|
|
'EdsGetPropertyData(camera, kEdsPropID_OwnerName, 0, 100, outData)
|
|
'data = Marshal.PtrToStringAnsi(outData)
|
|
|
|
' la lista delle fotocamere non mi serve più
|
|
If IsNothing(cameraList) = False Then
|
|
EdsRelease(cameraList)
|
|
End If
|
|
|
|
'// Create the camera model
|
|
If _lastError = EDS_ERR_OK Then
|
|
model = cameraModelFactory(camera, deviceInfo)
|
|
If IsNothing(model) = True Then
|
|
_lastError = EDS_ERR_DEVICE_NOT_FOUND
|
|
End If
|
|
End If
|
|
|
|
If _lastError <> EDS_ERR_OK Then Return
|
|
|
|
'// Create a controller
|
|
controller = New CameraController
|
|
|
|
'// Set the model to this controller.
|
|
controller.setCameraModel(model)
|
|
|
|
'// Make notify the model updating to the view.
|
|
'model.addObserver(Me)
|
|
|
|
' ------------------------------------------------------------------------
|
|
' ------------------------------------------------------------------------
|
|
' You should create class instance of delegates of event handlers
|
|
' with 'new' expressly if its attribute is Shared,
|
|
' because System sometimes do garbage-collect these delegates.
|
|
'
|
|
'
|
|
' This error occurs.
|
|
'
|
|
' CallbackOnCollectedDelegate is detected.
|
|
' Message: Callback was called with
|
|
' garbage-collected delegate of
|
|
' Type() 'VBSample3!VBSample3.EDSDKTypes+EdsPropertyEventHandler::Invoke'
|
|
'
|
|
' It will be able to make data loss or application clash.
|
|
' You should stock delegates when you want to send delegate to unmanaged code.
|
|
'
|
|
' ------------------------------------------------------------------------
|
|
If _lastError <> EDS_ERR_OK Then Return
|
|
|
|
_lastError = EdsSetPropertyEventHandler(camera, kEdsPropertyEvent_All, inPropertyEventHandler, IntPtr.Zero)
|
|
|
|
If _lastError <> EDS_ERR_OK Then Return
|
|
|
|
'// Set ObjectEventHandler
|
|
_lastError = EdsSetObjectEventHandler(camera, kEdsObjectEvent_All, inObjectEventHandler, IntPtr.Zero)
|
|
|
|
If _lastError <> EDS_ERR_OK Then Return
|
|
|
|
'// Set StateEventHandler
|
|
_lastError = EdsSetCameraStateEventHandler(camera, kEdsStateEvent_All, inStateEventHandler, IntPtr.Zero)
|
|
|
|
If _lastError <> EDS_ERR_OK Then
|
|
If Not IsNothing(camera) Then
|
|
EdsRelease(camera)
|
|
camera = Nothing
|
|
End If
|
|
|
|
If (m_isSDKLoaded) Then
|
|
EdsTerminateSDK()
|
|
End If
|
|
|
|
If Not IsNothing(model) Then
|
|
model = Nothing
|
|
End If
|
|
|
|
If Not IsNothing(controller) Then
|
|
controller = Nothing
|
|
End If
|
|
|
|
Return
|
|
End If
|
|
|
|
' -- Execute the controller.
|
|
controller.run()
|
|
|
|
'controller.actionPerformed("set", kEdsPropID_ISOSpeed, &H58)
|
|
'Dim prova As Integer
|
|
'Dim provaID As Integer
|
|
'controller.actionPerformed("get", kEdsPropID_OwnerName, prova)
|
|
'controller.actionPerformed("get", kEdsPropID_BodyIDEx, provaID)
|
|
controller.actionPerformed("get", kEdsPropID_Unknown)
|
|
|
|
_bodyID = ""
|
|
For i As Integer = 0 To 30
|
|
model.getPropertyString(kEdsPropID_BodyIDEx, _bodyID)
|
|
Threading.Thread.Sleep(100)
|
|
If _bodyID <> "" Then Exit For
|
|
Next
|
|
|
|
Console.WriteLine("CONNESIONE AVVENUTA (" & ncam.ToString() & "): " & MainModule.IndexProc)
|
|
|
|
_connected = True
|
|
RaiseEvent StatusChanged()
|
|
End Sub
|
|
|
|
Public Sub Disconnect()
|
|
controller.actionPerformed("close")
|
|
_bodyID = ""
|
|
|
|
If model IsNot Nothing Then
|
|
If IsNothing(model.getCameraObject()) = False Then
|
|
EdsRelease(model.getCameraObject())
|
|
End If
|
|
End If
|
|
|
|
EdsTerminateSDK()
|
|
m_isSDKLoaded = False
|
|
_connected = False
|
|
End Sub
|
|
|
|
Private Function ProgressFunc(ByVal inPercent As Integer, ByVal inContext As IntPtr, ByRef outCancel As Boolean) As Long
|
|
Dim rtn As Long = CLng(EDS_ERR_OK)
|
|
'VBSample.model.notifyObservers(prog, inPercent)
|
|
Return rtn
|
|
End Function
|
|
|
|
Sub UpdateProperty(ByVal from As Observable, ByVal msg As Integer, ByVal data As Integer) Implements Observer.update
|
|
Debug.Print("msg=" & msg & "data=H" & Hex(data))
|
|
|
|
Select Case msg
|
|
Case prog '//Progress of image downloading .
|
|
'ProgressBar.Value = data
|
|
Case strt '// Start downloading.
|
|
'//_progress.SetPos(0);
|
|
Case cplt '// Complete downloading.
|
|
'ProgressBar.Value = 0
|
|
Case updt '// Update properties.
|
|
Dim propertyID As Integer = data
|
|
Dim propData As Integer = model.getPropertyUInt32(propertyID)
|
|
UpdateProperty(propertyID, propData)
|
|
Case upls '// Update an available property list.
|
|
Dim propertyID As Integer = data
|
|
Dim desc As EdsPropertyDesc = model.getPropertyDesc(propertyID)
|
|
UpdatePropertyDesc(propertyID, desc)
|
|
Case warn '// Warning
|
|
'InfoTextBox.Text = "Device Busy"
|
|
Case errr '// Error
|
|
'// Nothing to do because the first getting property from model 30D is sure to fail.
|
|
Dim ss As String
|
|
ss = String.Format("%x", data)
|
|
'InfoTextBox.Text = ss
|
|
Case clse '// Close
|
|
'TakeBtn.Enabled = False
|
|
'ProgressBar.Enabled = False
|
|
'InfoTextBox.Enabled = False
|
|
'AEModeCmb.Enabled = False
|
|
'TvCmb.Enabled = False
|
|
'AvCmb.Enabled = False
|
|
'ISOSpeedCmb.Enabled = False
|
|
End Select
|
|
|
|
If msg <> errr And msg <> warn Then
|
|
'InfoTextBox.Text = ""
|
|
End If
|
|
End Sub
|
|
|
|
Sub UpdateProperty(ByVal propertyID As Integer, ByVal data As Integer)
|
|
Dim propList As Hashtable = CameraProperty.g_PropList.Item(propertyID)
|
|
Dim valoreprop As String
|
|
|
|
Select Case propertyID
|
|
Case kEdsPropID_AEModeSelect
|
|
valoreprop = propList.Item(data)
|
|
Case kEdsPropID_ISOSpeed
|
|
valoreprop = propList.Item(data)
|
|
Case kEdsPropID_MeteringMode
|
|
valoreprop = propList.Item(data)
|
|
Case kEdsPropID_Av
|
|
valoreprop = propList.Item(data)
|
|
Case kEdsPropID_Tv
|
|
valoreprop = propList.Item(data)
|
|
Case kEdsPropID_ExposureCompensation
|
|
valoreprop = propList.Item(data)
|
|
Case kEdsPropID_ImageQuality
|
|
valoreprop = propList.Item(data)
|
|
End Select
|
|
End Sub
|
|
|
|
Sub UpdatePropertyDesc(ByVal propertyID As Integer, ByVal desc As EdsPropertyDesc)
|
|
Dim err As Integer
|
|
Dim iCnt As Integer
|
|
Dim cmb As ComboBox = m_cmbTbl.Item(propertyID)
|
|
Dim propList As Hashtable = CameraProperty.g_PropList.Item(propertyID)
|
|
Dim propStr As String
|
|
Dim propValueList As ArrayList = New ArrayList
|
|
|
|
Debug.Print("propDesc=H" & Hex(propertyID))
|
|
|
|
If cmb Is Nothing Then
|
|
Return
|
|
End If
|
|
|
|
cmb.BeginUpdate()
|
|
cmb.Items.Clear()
|
|
|
|
For iCnt = 0 To desc.numElements - 1
|
|
propStr = propList(desc.propDesc(iCnt))
|
|
If propStr <> Nothing Then
|
|
err = cmb.Items.Add(propStr)
|
|
propValueList.Add(desc.propDesc(iCnt))
|
|
End If
|
|
Next
|
|
|
|
cmb.Tag = propValueList ' Set the property value list
|
|
cmb.EndUpdate()
|
|
|
|
If cmb.Items.Count = 0 Then
|
|
cmb.Enabled = False '// No available item.
|
|
Else
|
|
cmb.Enabled = True
|
|
End If
|
|
End Sub
|
|
|
|
#End Region ' Methods
|
|
|
|
#Region "EVENTS"
|
|
|
|
Private Function handleObjectEvent(ByVal inEvent As Integer, ByVal inRef As IntPtr, ByVal inContext As IntPtr) As Long
|
|
Dim rtn As Long
|
|
Dim err As Integer = EDS_ERR_OK
|
|
Dim stream As IntPtr = Nothing
|
|
Dim directoryItem As IntPtr
|
|
|
|
'// Get informations of the downloadling directory item.
|
|
Dim dirItemInfo As EdsDirectoryItemInfo = Nothing
|
|
|
|
Select Case inEvent
|
|
Case kEdsObjectEvent_DirItemRequestTransfer
|
|
'VBSample.controller.actionPerformed("download", inRef)
|
|
err = EdsGetDirectoryItemInfo(inRef, dirItemInfo)
|
|
|
|
If err = EDS_ERR_OK Then
|
|
err = EdsCreateFileStream(m_DownloadDir & dirItemInfo.szFileName, EdsFileCreateDisposition.kEdsFileCreateDisposition_CreateAlways, EdsAccess.kEdsAccess_ReadWrite, stream)
|
|
End If
|
|
|
|
err = EdsDownload(inRef, dirItemInfo.size, stream)
|
|
|
|
Console.WriteLine("INIZIO DONWLOAD: " & MainModule.IndexProc)
|
|
|
|
If err = EDS_ERR_OK Then
|
|
err = EdsDownloadComplete(inRef)
|
|
End If
|
|
|
|
If IsNothing(inRef) = False Then
|
|
err = EdsRelease(inRef)
|
|
directoryItem = Nothing
|
|
End If
|
|
|
|
If IsNothing(stream) = False Then
|
|
err = EdsRelease(stream)
|
|
stream = Nothing
|
|
m_PhotoFileName = m_DownloadDir & dirItemInfo.szFileName
|
|
If (LCase$(GetExtension(m_PhotoFileName)) = ".jpg") Then
|
|
m_Image = Nothing
|
|
GC.Collect()
|
|
m_Image = New System.Drawing.Bitmap(PhotoFileName)
|
|
'm_ImgCtrl.Image = m_Image
|
|
m_bDownloaded = True
|
|
RaiseEvent DownloadedCompleted()
|
|
End If
|
|
End If
|
|
|
|
Console.WriteLine("FINE DONWLOAD: " & MainModule.IndexProc)
|
|
|
|
Case Else
|
|
'//Release unnecessary objects.
|
|
If IsNothing(inRef) = False Then
|
|
EdsRelease(inRef)
|
|
End If
|
|
End Select
|
|
|
|
rtn = CLng(EDS_ERR_OK)
|
|
Return rtn
|
|
End Function
|
|
|
|
' Public Shared Function handlePropertyEvent( _
|
|
Private Function handlePropertyEvent(ByVal inEvent As Integer, ByVal inPropertyID As Integer, ByVal inParam As Integer, ByVal inContext As IntPtr) As Long
|
|
Dim rtn As Long
|
|
|
|
Debug.Print("propId =H" & Hex(inPropertyID))
|
|
|
|
nCount = nCount + 1
|
|
If nCount = 1 Then
|
|
Console.WriteLine("BINGO")
|
|
nCount = 0
|
|
End If
|
|
|
|
Select Case inEvent
|
|
Case kEdsPropertyEvent_PropertyChanged
|
|
controller.actionPerformed("get", inPropertyID)
|
|
Case kEdsPropertyEvent_PropertyDescChanged
|
|
controller.actionPerformed("getlist", inPropertyID)
|
|
End Select
|
|
|
|
If inPropertyID = kEdsPropID_OwnerName Then
|
|
Debug.Print("bingo")
|
|
End If
|
|
If inPropertyID = kEdsPropID_ISOSpeed Then
|
|
Debug.Print("iso")
|
|
End If
|
|
|
|
rtn = CLng(EDS_ERR_OK)
|
|
Return rtn
|
|
End Function
|
|
|
|
Private Function handleStateEvent(ByVal inEvent As Integer, ByVal inParam As Integer, ByVal inContext As IntPtr) As Long
|
|
Dim rtn As Long
|
|
|
|
Select Case inEvent
|
|
Case kEdsStateEvent_Shutdown
|
|
_connected = False
|
|
'VBSample.controller.actionPerformed("close")
|
|
RaiseEvent StatusChanged()
|
|
End Select
|
|
|
|
rtn = CLng(EDS_ERR_OK)
|
|
Return rtn
|
|
End Function
|
|
|
|
#End Region ' Events
|
|
|
|
End Class
|
|
|