From a753e2082cee55f879740a876752becc251db4ec Mon Sep 17 00:00:00 2001 From: Demetrio Cassarino Date: Wed, 25 Jun 2025 14:20:24 +0200 Subject: [PATCH] -pulizia codice --- .gitignore | 2 + CameraMng/ApplicationEvents.vb | 18 +- CameraMng/Camera/CameraController.vb | 129 +- CameraMng/Camera/CameraModel.vb | 453 ++-- CameraMng/Camera/CameraModelLegacy.vb | 20 +- CameraMng/CameraMng.vbproj | 8 - CameraMng/CfgForm.vb | 14 +- CameraMng/Command/CloseSessionCommand.vb | 38 +- CameraMng/Command/Command.vb | 49 +- CameraMng/Command/GetPropertyCommand.vb | 209 +- CameraMng/Command/GetPropertyDescCommand.vb | 132 +- CameraMng/Command/OpenSessionCommand.vb | 70 +- CameraMng/Command/SaveSettingCommand.vb | 65 +- CameraMng/Command/SetPropertyCommand.vb | 59 +- CameraMng/Command/TakePictureCommand.vb | 53 +- CameraMng/ExifWorks.vb | 2407 +++++++++---------- CameraMng/FormSce.vb | 13 +- CameraMng/FrmMain.designer.vb | 9 + CameraMng/FrmMain.resx | 723 +++--- CameraMng/FrmMain.vb | 1574 ++++++------ CameraMng/FrmStart.vb | 5 - CameraMng/ImageCtrl/DrawingBoard.vb | 597 +++-- CameraMng/ImageCtrl/ImageControl.vb | 385 +-- CameraMng/MainModule.vb | 13 +- CameraMng/Observer.vb | 131 +- CameraMng/clsCamera/clsCamera.vb | 472 ++-- CameraMng/clsImageMng/BitmapBytesRGB24.vb | 140 +- CameraMng/clsImageMng/FrmImgShow.vb | 37 +- CameraMng/clsImageMng/clsImageMng.vb | 350 +-- CameraMng/clsImageMng/clsRicerca.vb | 157 +- CameraMng/clsImageMng/clsVisione.vb | 407 +--- CameraMng/property/Property.vb | 672 +++--- 32 files changed, 4348 insertions(+), 5063 deletions(-) diff --git a/.gitignore b/.gitignore index 2ecc309..cf299db 100644 --- a/.gitignore +++ b/.gitignore @@ -69,6 +69,8 @@ artifacts/ *.pidb *.svclog *.scc +CamerMng/CameraMng/bin/x64/Debug/ +CamerMng/CSharpLibrary/bin/x64/ # Chutzpah Test files _Chutzpah* diff --git a/CameraMng/ApplicationEvents.vb b/CameraMng/ApplicationEvents.vb index 68f0ccb..6f6ae52 100644 --- a/CameraMng/ApplicationEvents.vb +++ b/CameraMng/ApplicationEvents.vb @@ -1,5 +1,4 @@ - -Namespace My +Namespace My ' The following events are available for MyApplication: ' @@ -10,32 +9,30 @@ Namespace My ' NetworkAvailabilityChanged: Raised when the network connection is connected or disconnected. Partial Friend Class MyApplication +#Region "METHODS" Private Sub MyApplication_Startup(sender As Object, e As Microsoft.VisualBasic.ApplicationServices.StartupEventArgs) Handles Me.Startup If e.CommandLine.Count > 0 Then If e.CommandLine(0) = "0" Then ModalitaNascosta = True - Else - ' End If - If e.CommandLine.Count > 1 Then MainModule.IndexProc = e.CommandLine(1) + ElseIf e.CommandLine.Count = 0 AndAlso ModalitaNascosta = False Then + MainModule.IndexProc = "" End If + If e.CommandLine.Count > 1 Then MainModule.IndexProc = e.CommandLine(1) End Sub ' METODO NON IN USO: DA RIMUOVERE (il processo è avviato una volta sola) Private Sub MyApplication_StartupNextInstance(sender As Object, e As Microsoft.VisualBasic.ApplicationServices.StartupNextInstanceEventArgs) Handles Me.StartupNextInstance - If e.CommandLine.Count > 1 Then MainModule.SpessLastra = Val(e.CommandLine(1)) End If If e.CommandLine.Count > 2 Then MainModule.SogliaPercentuale = Val(e.CommandLine(2)) End If - If e.CommandLine.Count > 3 Then FrmMain.SetSearchMode(CInt(Val(e.CommandLine(3)))) Else - End If If e.CommandLine.Count > 0 Then @@ -60,10 +57,11 @@ Namespace My FrmMain.RipetiThreshold() End If End If - End Sub - End Class +#End Region ' Methods + + End Class End Namespace diff --git a/CameraMng/Camera/CameraController.vb b/CameraMng/Camera/CameraController.vb index 4ffb6da..5a04b8b 100644 --- a/CameraMng/Camera/CameraController.vb +++ b/CameraMng/Camera/CameraController.vb @@ -20,95 +20,80 @@ '******************************************************************************/ Option Explicit On -Imports System.Runtime.InteropServices - - Public Class CameraController - '// Camera model - Protected model As CameraModel +#Region "FIELDS & PROPERTIES" - '// Command processing - Protected processor As New Processor + '// Camera model + Protected model As CameraModel + '// Command processing + Protected processor As New Processor +#End Region ' Fields & Properties - '// Constractor - Public Sub New() - model = Nothing - End Sub +#Region "CONSTRUCTOR" - '// Destructor - Protected Overrides Sub Finalize() - End Sub + Public Sub New() + model = Nothing + End Sub +#End Region ' Constructor - Public Sub setCameraModel(ByVal model As CameraModel) - Me.model = model - End Sub +#Region "METHODS" + '// Destructor + Protected Overrides Sub Finalize() + End Sub - '// Start processor thread - Public Sub run() + Public Sub setCameraModel(ByVal model As CameraModel) + Me.model = model + End Sub - processor.start() + '// Start processor thread + Public Sub run() + processor.start() - 'The communication with the camera begins - StoreAsync(New OpenSessionCommand(model)) + 'The communication with the camera begins + StoreAsync(New OpenSessionCommand(model)) + End Sub - End Sub + Public Sub actionPerformed(ByVal strEvent As String, ByVal inObject As IntPtr) + If strEvent = "download" Then + End If + End Sub + Public Sub actionPerformed(ByVal strEvent As String) + If strEvent = "opensession" Then + '// Start communication with remote camera. + StoreAsync(New OpenSessionCommand(model)) + ElseIf strEvent = "takepicture" Then + StoreAsync(New TakePictureCommand(model)) + ElseIf strEvent = "close" Then + model.notifyObservers(clse) + processor.setCloseCommand(New CloseSessionCommand(model)) + processor.stopTh() + processor.join() + End If + End Sub - Public Sub actionPerformed(ByVal strEvent As String, ByVal inObject As IntPtr) - If strEvent = "download" Then - 'StoreAsync(New DownloadCommand(model, inObject)) ' - End If - End Sub + Public Sub actionPerformed(ByVal strEvent As String, ByVal id As Integer, Optional ByVal data As Integer = 0) + If strEvent = "get" Then + StoreAsync(New GetPropertyCommand(model, id)) + ElseIf strEvent = "set" Then + StoreAsync(New SetPropertyCommand(model, id, data)) + ElseIf strEvent = "getlist" Then + StoreAsync(New GetPropertyDescCommand(model, id)) + End If + End Sub + '// Receive a command + Protected Sub StoreAsync(ByVal command As Command) + If IsNothing(command) = False Then + processor.enqueue(command) + End If + End Sub - Public Sub actionPerformed(ByVal strEvent As String) - - If strEvent = "opensession" Then - - '// Start communication with remote camera. - StoreAsync(New OpenSessionCommand(model)) - - ElseIf strEvent = "takepicture" Then - StoreAsync(New TakePictureCommand(model)) - - ElseIf strEvent = "close" Then - model.notifyObservers(clse) - processor.setCloseCommand(New CloseSessionCommand(model)) - processor.stopTh() - processor.join() - End If - - End Sub - - - Public Sub actionPerformed(ByVal strEvent As String, ByVal id As Integer, Optional ByVal data As Integer = 0) - If strEvent = "get" Then - StoreAsync(New GetPropertyCommand(model, id)) - - ElseIf strEvent = "set" Then - StoreAsync(New SetPropertyCommand(model, id, data)) - - ElseIf strEvent = "getlist" Then - StoreAsync(New GetPropertyDescCommand(model, id)) - - End If - - End Sub - - - '// Receive a command - Protected Sub StoreAsync(ByVal command As Command) - If IsNothing(command) = False Then - processor.enqueue(command) - - End If - - End Sub - +#End Region ' Methods End Class diff --git a/CameraMng/Camera/CameraModel.vb b/CameraMng/Camera/CameraModel.vb index 774e770..f0f1aaa 100644 --- a/CameraMng/Camera/CameraModel.vb +++ b/CameraMng/Camera/CameraModel.vb @@ -20,310 +20,305 @@ '******************************************************************************/ Option Explicit On -Imports System.Runtime.InteropServices Public Class CameraModel - Inherits Observable + Inherits Observable +#Region "METHODS" - Protected camera As IntPtr - - '// UIlock counter - Protected lockCount As Integer - - '// Model name - Protected modelName As String + Protected camera As IntPtr + '// UIlock counter + Protected lockCount As Integer + '// Model name + Protected modelName As String Protected ownerName As String - - '// Parameters - Protected AEMode As Integer - Protected Av As Integer - Protected Tv As Integer - Protected Iso As Integer - Protected MeteringMode As Integer - Protected ExposureCompensation As Integer - Protected ImageQuality As Integer - Protected availableShot As Integer - - '// Available parameter lists - Protected AEModeDesc As EdsPropertyDesc - Protected AvDesc As EdsPropertyDesc - Protected TvDesc As EdsPropertyDesc - Protected IsoDesc As EdsPropertyDesc - Protected MeteringModeDesc As EdsPropertyDesc - Protected ExposureCompensationDesc As EdsPropertyDesc + '// Parameters + Protected AEMode As Integer + Protected Av As Integer + Protected Tv As Integer + Protected Iso As Integer + Protected MeteringMode As Integer + Protected ExposureCompensation As Integer + Protected ImageQuality As Integer + Protected availableShot As Integer + '// Available parameter lists + Protected AEModeDesc As EdsPropertyDesc + Protected AvDesc As EdsPropertyDesc + Protected TvDesc As EdsPropertyDesc + Protected IsoDesc As EdsPropertyDesc + Protected MeteringModeDesc As EdsPropertyDesc + Protected ExposureCompensationDesc As EdsPropertyDesc Protected ImageQualityDesc As EdsPropertyDesc Protected IDBodyCAmera As String = "" +#End Region ' Methods - '// Constructor - Public Sub New(ByVal camera As IntPtr) - Me.lockCount = 0 - Me.camera = camera - End Sub +#Region "CONSTRUCTOR" - '// Get a camera object - Public Function getCameraObject() As IntPtr - Return Me.camera - End Function + Public Sub New(ByVal camera As IntPtr) + Me.lockCount = 0 + Me.camera = camera + End Sub +#End Region ' Constructor - '// ----------------------------------------------------------------- - '// Stock parameters --------------------------------------------- +#Region "METHODS" - Private Sub setAEMode(ByVal value As Integer) - AEMode = value - End Sub + '// Get a camera object + Public Function getCameraObject() As IntPtr + Return Me.camera + End Function - Private Sub setTv(ByVal value As Integer) - Tv = value - End Sub + '// ----------------------------------------------------------------- + '// Stock parameters --------------------------------------------- - Private Sub setAv(ByVal value As Integer) - Av = value - End Sub + Private Sub setAEMode(ByVal value As Integer) + AEMode = value + End Sub - Private Sub setIso(ByVal value As Integer) - Iso = value - End Sub + Private Sub setTv(ByVal value As Integer) + Tv = value + End Sub - Private Sub setMeteringMode(ByVal value As Integer) - MeteringMode = value - End Sub + Private Sub setAv(ByVal value As Integer) + Av = value + End Sub - Private Sub setExposureCompensation(ByVal value As Integer) - ExposureCompensation = value - End Sub + Private Sub setIso(ByVal value As Integer) + Iso = value + End Sub + + Private Sub setMeteringMode(ByVal value As Integer) + MeteringMode = value + End Sub + + Private Sub setExposureCompensation(ByVal value As Integer) + ExposureCompensation = value + End Sub Private Sub setBodyIDEx(ByVal value As String) IDBodyCAmera = value End Sub - Private Sub setModelName(ByVal modelName As String) - modelName = modelName - End Sub + Private Sub setModelName(ByVal modelName As String) + modelName = modelName + End Sub + Private Sub setImageQuality(ByVal value As Integer) ImageQuality = value End Sub - '// ----------------------------------------------------------------- - '// Give parameters --------------------------------------------- + '// ----------------------------------------------------------------- + '// Give parameters --------------------------------------------- - Private Function getAEMode() As Integer - Return AEMode - End Function + Private Function getAEMode() As Integer + Return AEMode + End Function - Private Function getTv() As Integer - Return Tv - End Function + Private Function getTv() As Integer + Return Tv + End Function - Private Function getAv() As Integer - Return Av - End Function + Private Function getAv() As Integer + Return Av + End Function - Private Function getIso() As Integer - Return Iso - End Function + Private Function getIso() As Integer + Return Iso + End Function - Private Function getMeteringMode() As Integer - Return MeteringMode - End Function + Private Function getMeteringMode() As Integer + Return MeteringMode + End Function - Private Function getExposureCompensation() As Integer - Return ExposureCompensation - End Function + Private Function getExposureCompensation() As Integer + Return ExposureCompensation + End Function + + Private Function getImageQuality() As Integer + Return ImageQuality + End Function - Private Function getImageQuality() As Integer - Return ImageQuality - End Function Private Function getIDCamera() As String Return IDBodyCAmera End Function - '// ----------------------------------------------------------------- - '// Give available parameter lists ---------------------------------- + '// ----------------------------------------------------------------- + '// Give available parameter lists ---------------------------------- - Private Function getAEModeDesc() As EdsPropertyDesc - Return AEModeDesc - End Function + Private Function getAEModeDesc() As EdsPropertyDesc + Return AEModeDesc + End Function - Private Function getAvDesc() As EdsPropertyDesc - Return AvDesc - End Function + Private Function getAvDesc() As EdsPropertyDesc + Return AvDesc + End Function - Private Function getTvDesc() As EdsPropertyDesc - Return TvDesc - End Function + Private Function getTvDesc() As EdsPropertyDesc + Return TvDesc + End Function - Private Function getIsoDesc() As EdsPropertyDesc - Return IsoDesc - End Function + Private Function getIsoDesc() As EdsPropertyDesc + Return IsoDesc + End Function - Private Function getMeteringModeDesc() As EdsPropertyDesc - Return MeteringModeDesc - End Function + Private Function getMeteringModeDesc() As EdsPropertyDesc + Return MeteringModeDesc + End Function - Private Function getExposureCompensationDesc() As EdsPropertyDesc - Return ExposureCompensationDesc - End Function + Private Function getExposureCompensationDesc() As EdsPropertyDesc + Return ExposureCompensationDesc + End Function - Private Function getImageQualityDesc() As EdsPropertyDesc - Return ImageQualityDesc - End Function + Private Function getImageQualityDesc() As EdsPropertyDesc + Return ImageQualityDesc + End Function + '// ----------------------------------------------------------------- + '// Stock available parameter lists --------------------------------- - '// ----------------------------------------------------------------- - '// Stock available parameter lists --------------------------------- + Private Sub setAEModeDesc(ByVal desc As EdsPropertyDesc) + AEModeDesc = desc + End Sub - Private Sub setAEModeDesc(ByVal desc As EdsPropertyDesc) - AEModeDesc = desc - End Sub + Private Sub setAvDesc(ByVal desc As EdsPropertyDesc) + AvDesc = desc + End Sub - Private Sub setAvDesc(ByVal desc As EdsPropertyDesc) - AvDesc = desc - End Sub + Private Sub setTvDesc(ByVal desc As EdsPropertyDesc) + TvDesc = desc + End Sub - Private Sub setTvDesc(ByVal desc As EdsPropertyDesc) - TvDesc = desc - End Sub + Private Sub setIsoDesc(ByVal desc As EdsPropertyDesc) + IsoDesc = desc + End Sub - Private Sub setIsoDesc(ByVal desc As EdsPropertyDesc) - IsoDesc = desc - End Sub + Private Sub setMeteringModeDesc(ByVal desc As EdsPropertyDesc) + MeteringModeDesc = desc + End Sub - Private Sub setMeteringModeDesc(ByVal desc As EdsPropertyDesc) - MeteringModeDesc = desc - End Sub + Private Sub setExposureCompensationDesc(ByVal desc As EdsPropertyDesc) + ExposureCompensationDesc = desc + End Sub - Private Sub setExposureCompensationDesc(ByVal desc As EdsPropertyDesc) - ExposureCompensationDesc = desc - End Sub + Private Sub setImageQualityDesc(ByVal desc As EdsPropertyDesc) + ImageQualityDesc = desc + End Sub - Private Sub setImageQualityDesc(ByVal desc As EdsPropertyDesc) - ImageQualityDesc = desc - End Sub - - - '// Set a property - Public Sub setPropertyUInt32(ByVal propertyID As Integer, ByVal value As Integer) - Select Case propertyID - Case kEdsPropID_AEModeSelect - setAEMode(value) - Case kEdsPropID_Tv - setTv(value) - Case kEdsPropID_Av - setAv(value) - Case kEdsPropID_ISOSpeed - setIso(value) - Case kEdsPropID_MeteringMode - setMeteringMode(value) - Case kEdsPropID_ExposureCompensation - setExposureCompensation(value) - Case kEdsPropID_ImageQuality + '// Set a property + Public Sub setPropertyUInt32(ByVal propertyID As Integer, ByVal value As Integer) + Select Case propertyID + Case kEdsPropID_AEModeSelect + setAEMode(value) + Case kEdsPropID_Tv + setTv(value) + Case kEdsPropID_Av + setAv(value) + Case kEdsPropID_ISOSpeed + setIso(value) + Case kEdsPropID_MeteringMode + setMeteringMode(value) + Case kEdsPropID_ExposureCompensation + setExposureCompensation(value) + Case kEdsPropID_ImageQuality setImageQuality(value) - End Select - End Sub + End Sub + '// Get a property + Public Function getPropertyUInt32(ByVal propertyID As Integer) As Integer + Dim value As Integer = &HFFFFFFFF + Select Case propertyID + Case kEdsPropID_AEModeSelect + value = getAEMode() + Case kEdsPropID_Tv + value = getTv() + Case kEdsPropID_Av + value = getAv() + Case kEdsPropID_ISOSpeed + value = getIso() + Case kEdsPropID_MeteringMode + value = getMeteringMode() + Case kEdsPropID_ExposureCompensation + value = getExposureCompensation() + Case kEdsPropID_ImageQuality + value = getImageQuality() + End Select + Return value + End Function - '// Get a property - Public Function getPropertyUInt32(ByVal propertyID As Integer) As Integer - Dim value As Integer = &HFFFFFFFF - Select Case propertyID - Case kEdsPropID_AEModeSelect - value = getAEMode() - Case kEdsPropID_Tv - value = getTv() - Case kEdsPropID_Av - value = getAv() - Case kEdsPropID_ISOSpeed - value = getIso() - Case kEdsPropID_MeteringMode - value = getMeteringMode() - Case kEdsPropID_ExposureCompensation - value = getExposureCompensation() - Case kEdsPropID_ImageQuality - value = getImageQuality() - End Select - Return value - - End Function - - - '// Get a property - Public Sub getPropertyString(ByVal propertyID As Integer, ByRef str As String) - Select Case propertyID - Case kEdsPropID_ProductName + '// Get a property + Public Sub getPropertyString(ByVal propertyID As Integer, ByRef str As String) + Select Case propertyID + Case kEdsPropID_ProductName str = modelName Case kEdsPropID_OwnerName str = ownerName Case kEdsPropID_BodyIDEx str = IDBodyCAmera End Select - End Sub + End Sub - - '// Set a property - Public Sub setPropertyString(ByVal propertyID As Integer, ByVal str As String) - Select Case propertyID + '// Set a property + Public Sub setPropertyString(ByVal propertyID As Integer, ByVal str As String) + Select Case propertyID Case kEdsPropID_ProductName modelName = str Case kEdsPropID_OwnerName ownerName = str Case kEdsPropID_BodyIDEx setBodyIDEx(str) - - End Select - End Sub + End Sub + '// Set an available parameter list. + Public Sub setPropertyDesc(ByVal propertyID As Integer, ByVal desc As EdsPropertyDesc) + Select Case propertyID + Case kEdsPropID_AEModeSelect + setAEModeDesc(desc) + Case kEdsPropID_Tv + setTvDesc(desc) + Case kEdsPropID_Av + setAvDesc(desc) + Case kEdsPropID_ISOSpeed + setIsoDesc(desc) + Case kEdsPropID_MeteringMode + setMeteringModeDesc(desc) + Case kEdsPropID_ExposureCompensation + setExposureCompensationDesc(desc) + Case kEdsPropID_ImageQuality + setImageQualityDesc(desc) + End Select + End Sub - '// Set an available parameter list. - Public Sub setPropertyDesc(ByVal propertyID As Integer, ByVal desc As EdsPropertyDesc) - Select Case propertyID - Case kEdsPropID_AEModeSelect - setAEModeDesc(desc) - Case kEdsPropID_Tv - setTvDesc(desc) - Case kEdsPropID_Av - setAvDesc(desc) - Case kEdsPropID_ISOSpeed - setIsoDesc(desc) - Case kEdsPropID_MeteringMode - setMeteringModeDesc(desc) - Case kEdsPropID_ExposureCompensation - setExposureCompensationDesc(desc) - Case kEdsPropID_ImageQuality - setImageQualityDesc(desc) - End Select - End Sub + '// Get an available parameter list. + Public Function getPropertyDesc(ByVal propertyID As Integer) As EdsPropertyDesc + Dim desc As EdsPropertyDesc = Nothing + Select Case propertyID + Case kEdsPropID_AEModeSelect + desc = getAEModeDesc() + Case kEdsPropID_Tv + desc = getTvDesc() + Case kEdsPropID_Av + desc = getAvDesc() + Case kEdsPropID_ISOSpeed + desc = getIsoDesc() + Case kEdsPropID_MeteringMode + desc = getMeteringModeDesc() + Case kEdsPropID_ExposureCompensation + desc = getExposureCompensationDesc() + Case kEdsPropID_ImageQuality + desc = getImageQualityDesc() + End Select + Return desc + End Function - '// Get an available parameter list. - Public Function getPropertyDesc(ByVal propertyID As Integer) As EdsPropertyDesc - Dim desc As EdsPropertyDesc = Nothing - Select Case propertyID - Case kEdsPropID_AEModeSelect - desc = getAEModeDesc() - Case kEdsPropID_Tv - desc = getTvDesc() - Case kEdsPropID_Av - desc = getAvDesc() - Case kEdsPropID_ISOSpeed - desc = getIsoDesc() - Case kEdsPropID_MeteringMode - desc = getMeteringModeDesc() - Case kEdsPropID_ExposureCompensation - desc = getExposureCompensationDesc() - Case kEdsPropID_ImageQuality - desc = getImageQualityDesc() - End Select - Return desc - End Function + '// Check camera accessing flag. + '// Connected camera is not a legacy one, this method will be called. + Public Overridable Function isLegacy() As Boolean + Return False + End Function - '// Check camera accessing flag. - '// Connected camera is not a legacy one, this method will be called. - Public Overridable Function isLegacy() As Boolean - Return False - End Function +#End Region ' Methods End Class diff --git a/CameraMng/Camera/CameraModelLegacy.vb b/CameraMng/Camera/CameraModelLegacy.vb index 40910b9..3eb947d 100644 --- a/CameraMng/Camera/CameraModelLegacy.vb +++ b/CameraMng/Camera/CameraModelLegacy.vb @@ -20,18 +20,22 @@ '******************************************************************************/ Public Class CameraModelLegacy - Inherits CameraModel + Inherits CameraModel - '//Constructor - Public Sub New(ByVal camera As IntPtr) - MyBase.new(camera) - End Sub +#Region "CONSTRUCTOR" + Public Sub New(ByVal camera As IntPtr) + MyBase.New(camera) + End Sub - Public Overrides Function isLegacy() As Boolean +#End Region ' Constructor - Return True +#Region "METHODS" - End Function + Public Overrides Function isLegacy() As Boolean + Return True + End Function + +#End Region ' Methods End Class diff --git a/CameraMng/CameraMng.vbproj b/CameraMng/CameraMng.vbproj index 2cb8b1f..6c8a1d2 100644 --- a/CameraMng/CameraMng.vbproj +++ b/CameraMng/CameraMng.vbproj @@ -229,18 +229,10 @@ False DepEmgu\Emgu.CV.UI.dll - - False - DepEmguXP\Emgu.CV.dll - False DepEmguXP\Emgu.CV.UI.dll - - False - DepEmguXP\Emgu.Util.dll - diff --git a/CameraMng/CfgForm.vb b/CameraMng/CfgForm.vb index 23f361b..28e62c5 100644 --- a/CameraMng/CfgForm.vb +++ b/CameraMng/CfgForm.vb @@ -1,24 +1,26 @@ Public Class CfgForm - Private Sub BtnOk_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnOk.Click +#Region "EVENTS" + + Private Sub BtnOk_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnOk.Click Me.Hide() End Sub - Private Sub BtnDisConnect_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnDisConnect.Click - 'Camera.Disconnect() - 'SetFormStatus() - End Sub + Private Sub BtnDisConnect_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnDisConnect.Click + End Sub Private Sub BtnSetID_Click(sender As System.Object, e As System.EventArgs) Handles BtnSetID.Click FrmMain.SetDefaultCamera() End Sub Private Sub CfgForm_Activated(sender As Object, e As System.EventArgs) Handles Me.Activated - End Sub Private Sub BtnResetID_Click(sender As System.Object, e As System.EventArgs) Handles BtnResetID.Click FrmMain.SetDefaultCamera(True) FrmMain.Camera.Connect() End Sub + +#End Region ' Events + End Class \ No newline at end of file diff --git a/CameraMng/Command/CloseSessionCommand.vb b/CameraMng/Command/CloseSessionCommand.vb index e77f610..35f3b66 100644 --- a/CameraMng/Command/CloseSessionCommand.vb +++ b/CameraMng/Command/CloseSessionCommand.vb @@ -20,33 +20,35 @@ '******************************************************************************/ Option Explicit On -Imports System.Runtime.InteropServices - - Public Class CloseSessionCommand - Inherits Command + Inherits Command - Public Sub New(ByVal inModel As CameraModel) - MyBase.new(inModel) - End Sub +#Region "CONSTRUCTOR" + Public Sub New(ByVal inModel As CameraModel) + MyBase.New(inModel) + End Sub - '// Execute a command. - Overrides Function execute() As Boolean - Dim err As Integer = EDS_ERR_OK +#End Region ' Constructor - '// Open session with remote camera. - err = EdsCloseSession(MyBase.model.getCameraObject()) +#Region "METHODS" + '// Execute a command. + Overrides Function execute() As Boolean + Dim err As Integer = EDS_ERR_OK - '// Notify Error. - If err <> EDS_ERR_OK Then - MyBase.model.notifyObservers(errr, err) - End If - Return True + '// Open session with remote camera. + err = EdsCloseSession(MyBase.model.getCameraObject()) - End Function + '// Notify Error. + If err <> EDS_ERR_OK Then + MyBase.model.notifyObservers(errr, err) + End If + Return True + End Function + +#End Region ' Methods End Class diff --git a/CameraMng/Command/Command.vb b/CameraMng/Command/Command.vb index 80f5b22..638044b 100644 --- a/CameraMng/Command/Command.vb +++ b/CameraMng/Command/Command.vb @@ -20,35 +20,50 @@ '******************************************************************************/ Option Explicit On -Imports System.Runtime.InteropServices Public Module commandName - ' Command IDs - Public Const errr As Integer = 1 'errr - Public Const prog As Integer = 2 'prog - Public Const strt As Integer = 3 'strt - Public Const cplt As Integer = 4 'cplt - Public Const warn As Integer = 5 'warn - Public Const updt As Integer = 6 'updt - Public Const upls As Integer = 7 'upls - Public Const clse As Integer = 1 'close + +#Region "FIELDS & PROPERTIES" + + ' Command IDs + Public Const errr As Integer = 1 'errr + Public Const prog As Integer = 2 'prog + Public Const strt As Integer = 3 'strt + Public Const cplt As Integer = 4 'cplt + Public Const warn As Integer = 5 'warn + Public Const updt As Integer = 6 'updt + Public Const upls As Integer = 7 'upls + Public Const clse As Integer = 1 'close + +#End Region ' Fields & Properties + End Module - - ' Abstract command class. ' All command classes extends this one. Public Class Command - Protected model As CameraModel +#Region "FIELDS & PROPERTIES" - Public Sub New(ByVal model As CameraModel) - Me.model = model - End Sub + Protected model As CameraModel - '// Execute a command. +#End Region ' Fields & Properties + +#Region "CONSTRUCTOR" + + Public Sub New(ByVal model As CameraModel) + Me.model = model + End Sub + +#End Region ' Constructor + +#Region "METHODS" + + '// Execute a command. Public Overridable Function execute() As Boolean Return True End Function +#End Region ' Methods + End Class diff --git a/CameraMng/Command/GetPropertyCommand.vb b/CameraMng/Command/GetPropertyCommand.vb index 267c013..ba2ac6c 100644 --- a/CameraMng/Command/GetPropertyCommand.vb +++ b/CameraMng/Command/GetPropertyCommand.vb @@ -24,154 +24,123 @@ Imports System.Runtime.InteropServices Public Class GetPropertyCommand - Inherits Command + Inherits Command - Private propertyID As Integer +#Region "FIELDS & PROPERTIES" + Private propertyID As Integer - Public Sub New(ByVal model As CameraModel, ByVal propertyID As Integer) - MyBase.new(model) - Me.propertyID = propertyID - End Sub +#End Region ' Fields & Properties - '// Execute a command. - Public Overrides Function execute() As Boolean +#Region "CONSTRUCTOR" - Dim err As Integer = EDS_ERR_OK + Public Sub New(ByVal model As CameraModel, ByVal propertyID As Integer) + MyBase.New(model) + Me.propertyID = propertyID + End Sub - '//Get a property. +#End Region ' Constructor - err = getProperty(Me.propertyID) +#Region "METHODS" - '// Notify Error. - If err <> EDS_ERR_OK Then + '// Execute a command. + Public Overrides Function execute() As Boolean + Dim err As Integer = EDS_ERR_OK - '// Retry when the camera replys deviceBusy. - If (err & EDS_ERRORID_MASK) = EDS_ERR_DEVICE_BUSY Then + '//Get a property. + err = getProperty(Me.propertyID) - MyBase.model.notifyObservers(warn, err) - - Return False - - End If - - MyBase.model.notifyObservers(errr, err) - - End If - - Return True - - End Function - - - Private Function getProperty(ByVal id As Integer) As Integer - Dim err As Integer = EDS_ERR_OK - Dim dataType As EdsDataType = EdsDataType.kEdsDataType_Unknown - Dim dataSize As Integer = 0 - - - If id = kEdsPropID_Unknown Then - '// If the propertyID is invalidID, - '// you should retry to get properties. - '// InvalidID is able to be published for the models elder than EOS30D. - - If err = EDS_ERR_OK Then - err = getProperty(kEdsPropID_AEMode) - End If - If err = EDS_ERR_OK Then - err = getProperty(kEdsPropID_Tv) - End If - If err = EDS_ERR_OK Then - err = getProperty(kEdsPropID_Av) - End If - If err = EDS_ERR_OK Then - err = getProperty(kEdsPropID_ISOSpeed) - End If - If err = EDS_ERR_OK Then - err = getProperty(kEdsPropID_ImageQuality) + '// Notify Error. + If err <> EDS_ERR_OK Then + '// Retry when the camera replys deviceBusy. + If (err & EDS_ERRORID_MASK) = EDS_ERR_DEVICE_BUSY Then + MyBase.model.notifyObservers(warn, err) + Return False End If + MyBase.model.notifyObservers(errr, err) + End If + + Return True + End Function + + Private Function getProperty(ByVal id As Integer) As Integer + Dim err As Integer = EDS_ERR_OK + Dim dataType As EdsDataType = EdsDataType.kEdsDataType_Unknown + Dim dataSize As Integer = 0 + + If id = kEdsPropID_Unknown Then + '// If the propertyID is invalidID, + '// you should retry to get properties. + '// InvalidID is able to be published for the models elder than EOS30D. + + If err = EDS_ERR_OK Then + err = getProperty(kEdsPropID_AEMode) + End If + If err = EDS_ERR_OK Then + err = getProperty(kEdsPropID_Tv) + End If + If err = EDS_ERR_OK Then + err = getProperty(kEdsPropID_Av) + End If + If err = EDS_ERR_OK Then + err = getProperty(kEdsPropID_ISOSpeed) + End If + If err = EDS_ERR_OK Then + err = getProperty(kEdsPropID_ImageQuality) + End If If err = EDS_ERR_OK Then err = getProperty(kEdsPropID_BodyIDEx) End If - If err = EDS_ERR_OK Then err = getProperty(kEdsPropID_OwnerName) End If + Return err + End If - Return err - End If + '// Get propertysize. + If err = EDS_ERR_OK Then + err = EdsGetPropertySize(MyBase.model.getCameraObject(), id, 0, dataType, dataSize) + End If - '// Get propertysize. - If err = EDS_ERR_OK Then + If err = EDS_ERR_OK Then + Dim data As Integer - err = EdsGetPropertySize( _ - MyBase.model.getCameraObject(), _ - id, _ - 0, _ - dataType, _ - dataSize) + If dataType = EdsDataType.kEdsDataType_UInt32 Then + '// Get a property. + Dim ptr As IntPtr = Marshal.AllocHGlobal(dataSize) - End If - - If err = EDS_ERR_OK Then - - Dim data As Integer - If dataType = EdsDataType.kEdsDataType_UInt32 Then - '// Get a property. - Dim ptr As IntPtr = Marshal.AllocHGlobal(dataSize) - - err = EdsGetPropertyData(MyBase.model.getCameraObject(), _ - id, _ - 0, _ - dataSize, _ - ptr) - - data = Marshal.PtrToStructure(ptr, GetType(Integer)) - Marshal.FreeHGlobal(ptr) - - If err = EDS_ERR_OK Then - - MyBase.model.setPropertyUInt32(id, data) - - End If + err = EdsGetPropertyData(MyBase.model.getCameraObject(), id, 0, dataSize, ptr) + data = Marshal.PtrToStructure(ptr, GetType(Integer)) + Marshal.FreeHGlobal(ptr) + If err = EDS_ERR_OK Then + MyBase.model.setPropertyUInt32(id, data) End If + End If + If dataType = EdsDataType.kEdsDataType_String Then + Dim str As String 'char[EDS_MAX_NAME] + Dim ptr As IntPtr = Marshal.AllocHGlobal(EDS_MAX_NAME) - If dataType = EdsDataType.kEdsDataType_String Then + '// Get a property. + err = EdsGetPropertyData(MyBase.model.getCameraObject(), id, 0, dataSize, ptr) + str = Marshal.PtrToStringAnsi(ptr) + Marshal.FreeHGlobal(ptr) - Dim str As String 'char[EDS_MAX_NAME] - Dim ptr As IntPtr = Marshal.AllocHGlobal(EDS_MAX_NAME) - - '// Get a property. - err = EdsGetPropertyData(MyBase.model.getCameraObject(), _ - id, _ - 0, _ - dataSize, _ - ptr) - - str = Marshal.PtrToStringAnsi(ptr) - Marshal.FreeHGlobal(ptr) - - '// Stock the property . - If err = EDS_ERR_OK Then - - MyBase.model.setPropertyString(id, str) - - End If + '// Stock the property . + If err = EDS_ERR_OK Then + MyBase.model.setPropertyString(id, str) End If + End If + End If - End If + '// Notify updating. + If err = EDS_ERR_OK Then + MyBase.model.notifyObservers(updt, id) + End If + Return err + End Function - '// Notify updating. - If err = EDS_ERR_OK Then - - MyBase.model.notifyObservers(updt, id) - - End If - - Return err - - End Function +#End Region ' Methods End Class diff --git a/CameraMng/Command/GetPropertyDescCommand.vb b/CameraMng/Command/GetPropertyDescCommand.vb index b80e04a..a66e37b 100644 --- a/CameraMng/Command/GetPropertyDescCommand.vb +++ b/CameraMng/Command/GetPropertyDescCommand.vb @@ -20,100 +20,90 @@ '******************************************************************************/ Option Explicit On -Imports System.Runtime.InteropServices Public Class GetPropertyDescCommand Inherits Command - Private propertyID As Integer +#Region "FIELDS & PROPERTIES" + Private propertyID As Integer - Public Sub New(ByVal model As CameraModel, ByVal propertyID As Integer) +#End Region ' Fields & Properties + +#Region "CONSTRUCTOR" + + Public Sub New(ByVal model As CameraModel, ByVal propertyID As Integer) MyBase.new(model) Me.propertyID = propertyID End Sub +#End Region ' Constructor - '// Execute a command. - Overrides Function execute() As Boolean +#Region "METHODS" - Dim err As Integer = EDS_ERR_OK + '// Execute a command. + Overrides Function execute() As Boolean + Dim err As Integer = EDS_ERR_OK - '//Get an available property list. - err = getPropertyDesc(Me.propertyID) + '//Get an available property list. + err = getPropertyDesc(Me.propertyID) + '// Notify Error. + If err <> EDS_ERR_OK Then + '// Retry when the camera replys deviceBusy. + If (err & EDS_ERRORID_MASK) = EDS_ERR_DEVICE_BUSY Then + MyBase.model.notifyObservers(warn, err) + Return False + End If - '// Notify Error. - If err <> EDS_ERR_OK Then + MyBase.model.notifyObservers(errr, err) + End If - '// Retry when the camera replys deviceBusy. - If (err & EDS_ERRORID_MASK) = EDS_ERR_DEVICE_BUSY Then + Return True + End Function - MyBase.model.notifyObservers(warn, err) + Private Function getPropertyDesc(ByVal id As Integer) As Integer + Dim err As Integer = EDS_ERR_OK + Dim propertyDesc As New EdsPropertyDesc - Return False + If id = kEdsPropID_Unknown Then + '// If the propertyID is invalidID, + '// you should retry to get available property lists. + '// InvalidID is able to be published for the models elder than EOS30D. - End If + If err = EDS_ERR_OK Then + err = getPropertyDesc(kEdsPropID_AEMode) + End If + If err = EDS_ERR_OK Then + err = getPropertyDesc(kEdsPropID_Tv) + End If + If err = EDS_ERR_OK Then + err = getPropertyDesc(kEdsPropID_Av) + End If + If err = EDS_ERR_OK Then + err = getPropertyDesc(kEdsPropID_ISOSpeed) + End If + Return err + End If - MyBase.model.notifyObservers(errr, err) + '// Get available property lists. + If err = EDS_ERR_OK Then + err = EdsGetPropertyDesc(MyBase.model.getCameraObject(), id, propertyDesc) + End If - End If - Return True + '// Stock the available property list. + If err = EDS_ERR_OK Then + MyBase.model.setPropertyDesc(id, propertyDesc) + End If - End Function + '// Notify updating. + If err = EDS_ERR_OK Then + MyBase.model.notifyObservers(upls, id) + End If + Return err + End Function - Private Function getPropertyDesc(ByVal id As Integer) As Integer - - Dim err As Integer = EDS_ERR_OK - Dim propertyDesc As New EdsPropertyDesc - - If id = kEdsPropID_Unknown Then - - '// If the propertyID is invalidID, - '// you should retry to get available property lists. - '// InvalidID is able to be published for the models elder than EOS30D. - - If err = EDS_ERR_OK Then - err = getPropertyDesc(kEdsPropID_AEMode) - End If - If err = EDS_ERR_OK Then - err = getPropertyDesc(kEdsPropID_Tv) - End If - If err = EDS_ERR_OK Then - err = getPropertyDesc(kEdsPropID_Av) - End If - If err = EDS_ERR_OK Then - err = getPropertyDesc(kEdsPropID_ISOSpeed) - End If - - Return err - End If - - '// Get available property lists. - If err = EDS_ERR_OK Then - - err = EdsGetPropertyDesc(MyBase.model.getCameraObject(), _ - id, _ - propertyDesc) - End If - - '// Stock the available property list. - If err = EDS_ERR_OK Then - - MyBase.model.setPropertyDesc(id, propertyDesc) - - End If - - '// Notify updating. - If err = EDS_ERR_OK Then - - MyBase.model.notifyObservers(upls, id) - - End If - - Return err - - End Function +#End Region ' Methods End Class diff --git a/CameraMng/Command/OpenSessionCommand.vb b/CameraMng/Command/OpenSessionCommand.vb index d2e881f..61e3dca 100644 --- a/CameraMng/Command/OpenSessionCommand.vb +++ b/CameraMng/Command/OpenSessionCommand.vb @@ -23,56 +23,50 @@ Option Explicit On Imports System.Runtime.InteropServices Public Class OpenSessionCommand - Inherits Command + Inherits Command - Public Sub New(ByVal model As CameraModel) - MyBase.new(model) - End Sub +#Region "CONSTRUCTOR" - '// Execute a command. - Public Overrides Function execute() As Boolean + Public Sub New(ByVal model As CameraModel) + MyBase.New(model) + End Sub - Dim err As Integer = EDS_ERR_OK - Dim locked As Boolean = False +#End Region ' Constructor - '// Open session with remote camera. - err = EdsOpenSession(MyBase.model.getCameraObject()) +#Region "METHODS" + '// Execute a command. + Public Overrides Function execute() As Boolean + Dim err As Integer = EDS_ERR_OK + Dim locked As Boolean = False - 'Preservation ahead is set to PC - If err = EDS_ERR_OK Then + '// Open session with remote camera. + err = EdsOpenSession(MyBase.model.getCameraObject()) - Dim saveTo As Integer = EdsSaveTo.kEdsSaveTo_Host - err = EdsSetPropertyData(MyBase.model.getCameraObject(), kEdsPropID_SaveTo, 0, Marshal.SizeOf(saveTo), saveTo) + 'Preservation ahead is set to PC + If err = EDS_ERR_OK Then + Dim saveTo As Integer = EdsSaveTo.kEdsSaveTo_Host - End If + err = EdsSetPropertyData(MyBase.model.getCameraObject(), kEdsPropID_SaveTo, 0, Marshal.SizeOf(saveTo), saveTo) + End If + If err = EDS_ERR_OK Then + Dim capacity As EdsCapacity + capacity.numberOfFreeClusters = &H7FFFFFFF + capacity.bytesPerSector = &H1000 + capacity.reset = 1 + err = EdsSetCapacity(MyBase.model.getCameraObject(), capacity) + End If - If err = EDS_ERR_OK Then + 'Notification of error + If err < EDS_ERR_OK Then + MyBase.model.notifyObservers(errr, err) + End If - Dim capacity As EdsCapacity - capacity.numberOfFreeClusters = &H7FFFFFFF - capacity.bytesPerSector = &H1000 - capacity.reset = 1 + Return True + End Function - err = EdsSetCapacity(MyBase.model.getCameraObject(), capacity) - - End If - - - - - 'Notification of error - If err < EDS_ERR_OK Then - - 'CameraEvent e("error", &err); - MyBase.model.notifyObservers(errr, err) - - End If - - - Return True - End Function +#End Region ' Methods End Class diff --git a/CameraMng/Command/SaveSettingCommand.vb b/CameraMng/Command/SaveSettingCommand.vb index ba1eb44..be6e0c4 100644 --- a/CameraMng/Command/SaveSettingCommand.vb +++ b/CameraMng/Command/SaveSettingCommand.vb @@ -23,52 +23,51 @@ Option Explicit On Imports System.Runtime.InteropServices Public Class SaveSettingCommand - Inherits Command + Inherits Command - Private saveTo As EdsSaveTo +#Region "FIELDS & PROPERTIES" - Public Sub New(ByVal model As CameraModel, ByVal saveTo As EdsSaveTo) - MyBase.new(model) - saveTo = saveTo - End Sub + Private saveTo As EdsSaveTo +#End Region ' Fields & Properties - '// Execute a command. - Public Overrides Function execute() As Boolean +#Region "CONSTRUCTOR" - Dim err As Integer = EDS_ERR_OK + Public Sub New(ByVal model As CameraModel, ByVal saveTo As EdsSaveTo) + MyBase.New(model) + saveTo = saveTo + End Sub +#End Region ' Constructor - '//Set destination of file save. +#Region "METHODS" - Dim ptr As IntPtr = Marshal.AllocHGlobal(Marshal.SizeOf(Me.saveTo)) - Marshal.StructureToPtr(Me.saveTo, ptr, False) + '// Execute a command. + Public Overrides Function execute() As Boolean + Dim err As Integer = EDS_ERR_OK - err = EdsSetPropertyData(MyBase.model.getCameraObject(), _ - kEdsPropID_SaveTo, 0, Marshal.SizeOf(Me.saveTo), Me.saveTo) + '//Set destination of file save. + Dim ptr As IntPtr = Marshal.AllocHGlobal(Marshal.SizeOf(Me.saveTo)) - Marshal.FreeHGlobal(ptr) + Marshal.StructureToPtr(Me.saveTo, ptr, False) + err = EdsSetPropertyData(MyBase.model.getCameraObject(), kEdsPropID_SaveTo, 0, Marshal.SizeOf(Me.saveTo), Me.saveTo) + Marshal.FreeHGlobal(ptr) + '// Notify Error. + If err <> EDS_ERR_OK Then + '// Retry when the camera replys deviceBusy. + If err = EDS_ERR_DEVICE_BUSY Then + MyBase.model.notifyObservers(warn, err) + Threading.Thread.Sleep(500) + Return False + End If + MyBase.model.notifyObservers(errr, err) + End If + Return True + End Function - '// Notify Error. - If err <> EDS_ERR_OK Then - - '// Retry when the camera replys deviceBusy. - If err = EDS_ERR_DEVICE_BUSY Then - MyBase.model.notifyObservers(warn, err) - Threading.Thread.Sleep(500) - Return False - - End If - - MyBase.model.notifyObservers(errr, err) - - End If - - Return True - - End Function +#End Region ' Methods End Class diff --git a/CameraMng/Command/SetPropertyCommand.vb b/CameraMng/Command/SetPropertyCommand.vb index 61070fe..be60556 100644 --- a/CameraMng/Command/SetPropertyCommand.vb +++ b/CameraMng/Command/SetPropertyCommand.vb @@ -20,50 +20,53 @@ '******************************************************************************/ Option Strict Off -Option Explicit On +Option Explicit On Imports System.Runtime.InteropServices Public Class SetPropertyCommand - Inherits Command + Inherits Command - Private propertyID As Integer - Private data As Integer +#Region "FIELDS & PROPERTIES" + Private propertyID As Integer + Private data As Integer - Public Sub New(ByVal model As CameraModel, ByVal propertyID As Integer, ByVal data As Integer) - MyBase.new(model) - Me.propertyID = propertyID - Me.data = data - End Sub +#End Region ' Fields & Properties - '// Execute a command. - Public Overrides Function execute() As Boolean +#Region "CONSTRUCTOR" - Dim err As Integer = EDS_ERR_OK + Public Sub New(ByVal model As CameraModel, ByVal propertyID As Integer, ByVal data As Integer) + MyBase.New(model) + Me.propertyID = propertyID + Me.data = data + End Sub - '// Stock the property. +#End Region ' Constructor - err = EdsSetPropertyData(MyBase.model.getCameraObject(), Me.propertyID, 0, Marshal.SizeOf(Me.data), Me.data) +#Region "METHODS" + '// Execute a command. + Public Overrides Function execute() As Boolean + Dim err As Integer = EDS_ERR_OK - '// Notify Error. - If err <> EDS_ERR_OK Then - '// Retry when the camera replys deviceBusy. - If err = EDS_ERR_DEVICE_BUSY Then + '// Stock the property. + err = EdsSetPropertyData(MyBase.model.getCameraObject(), Me.propertyID, 0, Marshal.SizeOf(Me.data), Me.data) - MyBase.model.notifyObservers(warn, err) + '// Notify Error. + If err <> EDS_ERR_OK Then + '// Retry when the camera replys deviceBusy. + If err = EDS_ERR_DEVICE_BUSY Then + MyBase.model.notifyObservers(warn, err) + Return False + End If + MyBase.model.notifyObservers(errr, err) + End If - Return False - End If + Return True + End Function - MyBase.model.notifyObservers(errr, err) - - End If - - Return True - - End Function +#End Region ' Methods End Class diff --git a/CameraMng/Command/TakePictureCommand.vb b/CameraMng/Command/TakePictureCommand.vb index 6d76f20..13e8da8 100644 --- a/CameraMng/Command/TakePictureCommand.vb +++ b/CameraMng/Command/TakePictureCommand.vb @@ -20,43 +20,38 @@ '******************************************************************************/ Public Class TakePictureCommand - Inherits Command + Inherits Command - Public Sub New(ByVal model As CameraModel) - MyBase.new(model) - End Sub +#Region "CONSTRUCTOR" - '// Execute a command. - Public Overrides Function execute() As Boolean + Public Sub New(ByVal model As CameraModel) + MyBase.New(model) + End Sub - Dim err As Integer = EDS_ERR_OK +#End Region ' Constructor - '// Take a picture. - err = EdsSendCommand(MyBase.model.getCameraObject(), EdsCameraCommand.kEdsCameraCommand_PressShutterButton, EdsShutterButton.kEdsCameraCommand_ShutterButton_Completely) - EdsSendCommand(MyBase.model.getCameraObject(), EdsCameraCommand.kEdsCameraCommand_PressShutterButton, EdsShutterButton.kEdsCameraCommand_ShutterButton_OFF) +#Region "METHODS" + '// Execute a command. + Public Overrides Function execute() As Boolean + Dim err As Integer = EDS_ERR_OK + '// Take a picture. + err = EdsSendCommand(MyBase.model.getCameraObject(), EdsCameraCommand.kEdsCameraCommand_PressShutterButton, EdsShutterButton.kEdsCameraCommand_ShutterButton_Completely) + EdsSendCommand(MyBase.model.getCameraObject(), EdsCameraCommand.kEdsCameraCommand_PressShutterButton, EdsShutterButton.kEdsCameraCommand_ShutterButton_OFF) + '// Notify Error. + If err <> EDS_ERR_OK Then + '// Do not retry when the camera replys deviceBusy. + If err = EDS_ERR_DEVICE_BUSY Then + MyBase.model.notifyObservers(warn, err) + Return True + End If + End If + Return True + End Function - '// Notify Error. - If err <> EDS_ERR_OK Then - - '// Do not retry when the camera replys deviceBusy. - If err = EDS_ERR_DEVICE_BUSY Then - - MyBase.model.notifyObservers(warn, err) - - Return True - - End If - - 'MyBase.model.notifyObservers(errr, err) - - End If - - Return True - - End Function +#End Region ' Methods End Class diff --git a/CameraMng/ExifWorks.vb b/CameraMng/ExifWorks.vb index 453fbb2..c6bc9ea 100644 --- a/CameraMng/ExifWorks.vb +++ b/CameraMng/ExifWorks.vb @@ -16,1234 +16,1227 @@ ''' [altair] 05.09.2005 Code clean-up and minor changes ''' Public Class ExifWorks - Implements IDisposable + Implements IDisposable - Private _Image As System.Drawing.Bitmap - Private _Encoding As System.Text.Encoding = System.Text.Encoding.UTF8 +#Region "FIELDS & PROPERTIES" -#Region " Type declarations " + Private _Image As System.Drawing.Bitmap - ''' - ''' Contains possible values of EXIF tag names (ID) - ''' - ''' See GdiPlusImaging.h - ''' - ''' [altair] 10.09.2003 Created - ''' - - Public Enum TagNames As Integer - ExifIFD = &H8769 - GpsIFD = &H8825 - NewSubfileType = &HFE - SubfileType = &HFF - ImageWidth = &H100 - ImageHeight = &H101 - BitsPerSample = &H102 - Compression = &H103 - PhotometricInterp = &H106 - ThreshHolding = &H107 - CellWidth = &H108 - CellHeight = &H109 - FillOrder = &H10A - DocumentName = &H10D - ImageDescription = &H10E - EquipMake = &H10F - EquipModel = &H110 - StripOffsets = &H111 - Orientation = &H112 - SamplesPerPixel = &H115 - RowsPerStrip = &H116 - StripBytesCount = &H117 - MinSampleValue = &H118 - MaxSampleValue = &H119 - XResolution = &H11A - YResolution = &H11B - PlanarConfig = &H11C - PageName = &H11D - XPosition = &H11E - YPosition = &H11F - FreeOffset = &H120 - FreeByteCounts = &H121 - GrayResponseUnit = &H122 - GrayResponseCurve = &H123 - T4Option = &H124 - T6Option = &H125 - ResolutionUnit = &H128 - PageNumber = &H129 - TransferFuncition = &H12D - SoftwareUsed = &H131 - DateTime = &H132 - Artist = &H13B - HostComputer = &H13C - Predictor = &H13D - WhitePoint = &H13E - PrimaryChromaticities = &H13F - ColorMap = &H140 - HalftoneHints = &H141 - TileWidth = &H142 - TileLength = &H143 - TileOffset = &H144 - TileByteCounts = &H145 - InkSet = &H14C - InkNames = &H14D - NumberOfInks = &H14E - DotRange = &H150 - TargetPrinter = &H151 - ExtraSamples = &H152 - SampleFormat = &H153 - SMinSampleValue = &H154 - SMaxSampleValue = &H155 - TransferRange = &H156 - JPEGProc = &H200 - JPEGInterFormat = &H201 - JPEGInterLength = &H202 - JPEGRestartInterval = &H203 - JPEGLosslessPredictors = &H205 - JPEGPointTransforms = &H206 - JPEGQTables = &H207 - JPEGDCTables = &H208 - JPEGACTables = &H209 - YCbCrCoefficients = &H211 - YCbCrSubsampling = &H212 - YCbCrPositioning = &H213 - REFBlackWhite = &H214 - ICCProfile = &H8773 - Gamma = &H301 - ICCProfileDescriptor = &H302 - SRGBRenderingIntent = &H303 - ImageTitle = &H320 - Copyright = &H8298 - ResolutionXUnit = &H5001 - ResolutionYUnit = &H5002 - ResolutionXLengthUnit = &H5003 - ResolutionYLengthUnit = &H5004 - PrintFlags = &H5005 - PrintFlagsVersion = &H5006 - PrintFlagsCrop = &H5007 - PrintFlagsBleedWidth = &H5008 - PrintFlagsBleedWidthScale = &H5009 - HalftoneLPI = &H500A - HalftoneLPIUnit = &H500B - HalftoneDegree = &H500C - HalftoneShape = &H500D - HalftoneMisc = &H500E - HalftoneScreen = &H500F - JPEGQuality = &H5010 - GridSize = &H5011 - ThumbnailFormat = &H5012 - ThumbnailWidth = &H5013 - ThumbnailHeight = &H5014 - ThumbnailColorDepth = &H5015 - ThumbnailPlanes = &H5016 - ThumbnailRawBytes = &H5017 - ThumbnailSize = &H5018 - ThumbnailCompressedSize = &H5019 - ColorTransferFunction = &H501A - ThumbnailData = &H501B - ThumbnailImageWidth = &H5020 - ThumbnailImageHeight = &H502 - ThumbnailBitsPerSample = &H5022 - ThumbnailCompression = &H5023 - ThumbnailPhotometricInterp = &H5024 - ThumbnailImageDescription = &H5025 - ThumbnailEquipMake = &H5026 - ThumbnailEquipModel = &H5027 - ThumbnailStripOffsets = &H5028 - ThumbnailOrientation = &H5029 - ThumbnailSamplesPerPixel = &H502A - ThumbnailRowsPerStrip = &H502B - ThumbnailStripBytesCount = &H502C - ThumbnailResolutionX = &H502D - ThumbnailResolutionY = &H502E - ThumbnailPlanarConfig = &H502F - ThumbnailResolutionUnit = &H5030 - ThumbnailTransferFunction = &H5031 - ThumbnailSoftwareUsed = &H5032 - ThumbnailDateTime = &H5033 - ThumbnailArtist = &H5034 - ThumbnailWhitePoint = &H5035 - ThumbnailPrimaryChromaticities = &H5036 - ThumbnailYCbCrCoefficients = &H5037 - ThumbnailYCbCrSubsampling = &H5038 - ThumbnailYCbCrPositioning = &H5039 - ThumbnailRefBlackWhite = &H503A - ThumbnailCopyRight = &H503B - LuminanceTable = &H5090 - ChrominanceTable = &H5091 - FrameDelay = &H5100 - LoopCount = &H5101 - PixelUnit = &H5110 - PixelPerUnitX = &H5111 - PixelPerUnitY = &H5112 - PaletteHistogram = &H5113 - ExifExposureTime = &H829A - ExifFNumber = &H829D - ExifExposureProg = &H8822 - ExifSpectralSense = &H8824 - ExifISOSpeed = &H8827 - ExifOECF = &H8828 - ExifVer = &H9000 - ExifDTOrig = &H9003 - ExifDTDigitized = &H9004 - ExifCompConfig = &H9101 - ExifCompBPP = &H9102 - ExifShutterSpeed = &H9201 - ExifAperture = &H9202 - ExifBrightness = &H9203 - ExifExposureBias = &H9204 - ExifMaxAperture = &H9205 - ExifSubjectDist = &H9206 - ExifMeteringMode = &H9207 - ExifLightSource = &H9208 - ExifFlash = &H9209 - ExifFocalLength = &H920A - ExifMakerNote = &H927C - ExifUserComment = &H9286 - ExifDTSubsec = &H9290 - ExifDTOrigSS = &H9291 - ExifDTDigSS = &H9292 - ExifFPXVer = &HA000 - ExifColorSpace = &HA001 - ExifPixXDim = &HA002 - ExifPixYDim = &HA003 - ExifRelatedWav = &HA004 - ExifInterop = &HA005 - ExifFlashEnergy = &HA20B - ExifSpatialFR = &HA20C - ExifFocalXRes = &HA20E - ExifFocalYRes = &HA20F - ExifFocalResUnit = &HA210 - ExifSubjectLoc = &HA214 - ExifExposureIndex = &HA215 - ExifSensingMethod = &HA217 - ExifFileSource = &HA300 - ExifSceneType = &HA301 - ExifCfaPattern = &HA302 - GpsVer = &H0 - GpsLatitudeRef = &H1 - GpsLatitude = &H2 - GpsLongitudeRef = &H3 - GpsLongitude = &H4 - GpsAltitudeRef = &H5 - GpsAltitude = &H6 - GpsGpsTime = &H7 - GpsGpsSatellites = &H8 - GpsGpsStatus = &H9 - GpsGpsMeasureMode = &HA - GpsGpsDop = &HB - GpsSpeedRef = &HC - GpsSpeed = &HD - GpsTrackRef = &HE - GpsTrack = &HF - GpsImgDirRef = &H10 - GpsImgDir = &H11 - GpsMapDatum = &H12 - GpsDestLatRef = &H13 - GpsDestLat = &H14 - GpsDestLongRef = &H15 - GpsDestLong = &H16 - GpsDestBearRef = &H17 - GpsDestBear = &H18 - GpsDestDistRef = &H19 - GpsDestDist = &H1A - End Enum - - - ''' - ''' Real position of 0th row and column of picture - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - - Public Enum Orientations - TopLeft = 1 - TopRight = 2 - BottomRight = 3 - BottomLeft = 4 - LeftTop = 5 - RightTop = 6 - RightBottom = 7 - LftBottom = 8 - End Enum - - - ''' - ''' Exposure programs - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - - Public Enum ExposurePrograms - Manual = 1 - Normal = 2 - AperturePriority = 3 - ShutterPriority = 4 - Creative = 5 - Action = 6 - Portrait = 7 - Landscape = 8 - End Enum - - - ''' - ''' Exposure metering modes - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - - Public Enum ExposureMeteringModes - Unknown = 0 - Average = 1 - CenterWeightedAverage = 2 - Spot = 3 - MultiSpot = 4 - MultiSegment = 5 - [Partial] = 6 - Other = 255 - End Enum - - - ''' - ''' Flash activity modes - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - - Public Enum FlashModes - NotFired = 0 - Fired = 1 - FiredButNoStrobeReturned = 5 - FiredAndStrobeReturned = 7 - End Enum - - - ''' - ''' Possible light sources (white balance) - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - - Public Enum LightSources - Unknown = 0 - Daylight = 1 - Fluorescent = 2 - Tungsten = 3 - Flash = 10 - StandardLightA = 17 - StandardLightB = 18 - StandardLightC = 19 - D55 = 20 - D65 = 21 - D75 = 22 - Other = 255 - End Enum - - - ''' - ''' EXIF data types - ''' - ''' - ''' - ''' [altair] 12.6.2004 Created - ''' - - Public Enum ExifDataTypes As Short - UnsignedByte = 1 - AsciiString = 2 - UnsignedShort = 3 - UnsignedLong = 4 - UnsignedRational = 5 - SignedByte = 6 - Undefined = 7 - SignedShort = 8 - SignedLong = 9 - SignedRational = 10 - SingleFloat = 11 - DoubleFloat = 12 - End Enum - - - ''' - ''' Represents rational which is type of some Exif properties - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - - Public Structure Rational - Dim Numerator As Int32 - Dim Denominator As Int32 - - - ''' - ''' Converts rational to string representation - ''' - ''' Optional, default "/". String to be used as delimiter of components. - ''' String representation of the rational. - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - - Shadows Function ToString(Optional ByVal Delimiter As String = "/") As String - Return Numerator & Delimiter & Denominator - End Function - - - ''' - ''' Converts rational to double precision real number - ''' - ''' The rational as double precision real number. - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - - Function ToDouble() As Double - Return Numerator / Denominator - End Function - End Structure - -#End Region - - ''' - ''' Initializes new instance of this class. - ''' - ''' Bitmap to read exif information from - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - Public Sub New(ByRef Bitmap As System.Drawing.Bitmap) - If Bitmap Is Nothing Then Throw New ArgumentNullException("Bitmap") - Me._Image = Bitmap - End Sub - - ''' - ''' Initializes new instance of this class. - ''' - ''' Name of file to be loaded - ''' - ''' - ''' [altair] 13.06.2004 Created - ''' - Public Sub New(ByVal FileName As String) - Me._Image = DirectCast(System.Drawing.Bitmap.FromFile(FileName), System.Drawing.Bitmap) - End Sub - - ''' - ''' Get or set encoding used for string metadata - ''' - ''' Encoding used for string metadata - ''' Default encoding is UTF-8 - ''' - ''' [altair] 11.07.2004 Created - ''' [altair] 05.09.2005 Changed from shared to instance member - ''' - Public Property Encoding() As System.Text.Encoding - Get - Return Me._Encoding - End Get - Set(ByVal Value As System.Text.Encoding) - If Value Is Nothing Then Throw New ArgumentNullException - Me._Encoding = Encoding - End Set - End Property - - ''' - ''' Returns copy of bitmap this instance is working on - ''' - ''' - ''' - ''' - ''' [altair] 13.06.2004 Created - ''' - Public Function GetBitmap() As System.Drawing.Bitmap - Return DirectCast(Me._Image.Clone(), System.Drawing.Bitmap) - End Function - - ''' - ''' Returns all available data in formatted string form - ''' - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - Public Overrides Function ToString() As String - Dim SB As New System.Text.StringBuilder - - SB.Append("Image:") - SB.Append("\n\tDimensions: " & Me.Width & " x " & Me.Height & " px") - SB.Append("\n\tResolution: " & Me.ResolutionX & " x " & Me.ResolutionY & " dpi") - SB.Append("\n\tOrientation: " & [Enum].GetName(GetType(Orientations), Me.Orientation)) - SB.Append("\n\tTitle: " & Me.Title) - SB.Append("\n\tDescription: " & Me.Description) - SB.Append("\n\tCopyright: " & Me.Copyright) - SB.Append("\nEquipment:") - SB.Append("\n\tMaker: " & Me.EquipmentMaker) - SB.Append("\n\tModel: " & Me.EquipmentModel) - SB.Append("\n\tSoftware: " & Me.Software) - SB.Append("\nDate and time:") - SB.Append("\n\tGeneral: " & Me.DateTimeLastModified.ToString()) - SB.Append("\n\tOriginal: " & Me.DateTimeOriginal.ToString()) - SB.Append("\n\tDigitized: " & Me.DateTimeDigitized.ToString()) - SB.Append("\nShooting conditions:") - SB.Append("\n\tExposure time: " & Me.ExposureTime.ToString("N4") & " s") - SB.Append("\n\tExposure program: " & [Enum].GetName(GetType(ExposurePrograms), Me.ExposureProgram)) - SB.Append("\n\tExposure mode: " & [Enum].GetName(GetType(ExposureMeteringModes), Me.ExposureMeteringMode)) - SB.Append("\n\tAperture: F" & Me.Aperture.ToString("N2")) - SB.Append("\n\tISO sensitivity: " & Me.ISO) - SB.Append("\n\tSubject distance: " & Me.SubjectDistance.ToString("N2") & " m") - SB.Append("\n\tFocal length: " & Me.FocalLength) - SB.Append("\n\tFlash: " & [Enum].GetName(GetType(FlashModes), Me.FlashMode)) - SB.Append("\n\tLight source (WB): " & [Enum].GetName(GetType(LightSources), Me.LightSource)) - - SB.Replace("\n", vbCrLf) - SB.Replace("\t", vbTab) - Return SB.ToString() - End Function - -#Region " Nicely formatted well-known properties " - - ''' - ''' Brand of equipment (EXIF EquipMake) - ''' - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - Public ReadOnly Property EquipmentMaker() As String - Get - Return Me.GetPropertyString(TagNames.EquipMake) - End Get - End Property - - ''' - ''' Model of equipment (EXIF EquipModel) - ''' - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - Public ReadOnly Property EquipmentModel() As String - Get - Return Me.GetPropertyString(TagNames.EquipModel) - End Get - End Property - - ''' - ''' Software used for processing (EXIF Software) - ''' - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - Public ReadOnly Property Software() As String - Get - Return Me.GetPropertyString(TagNames.SoftwareUsed) - End Get - End Property - - ''' - ''' Orientation of image (position of row 0, column 0) (EXIF Orientation) - ''' - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - Public ReadOnly Property Orientation() As Orientations - Get - Dim X As Int32 = Me.GetPropertyInt16(TagNames.Orientation) - - If Not [Enum].IsDefined(GetType(Orientations), X) Then - Return Orientations.TopLeft - Else - Return CType([Enum].Parse(GetType(Orientations), [Enum].GetName(GetType(Orientations), X)), Orientations) - End If - End Get - End Property - - ''' - ''' Time when image was last modified (EXIF DateTime). - ''' - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - Public Property DateTimeLastModified() As DateTime - Get - Try - Return DateTime.ParseExact(Me.GetPropertyString(TagNames.DateTime), "yyyy\:MM\:dd HH\:mm\:ss", Nothing) - Catch ex As Exception - Return DateTime.MinValue - End Try - End Get - Set(ByVal Value As DateTime) - Try - Me.SetPropertyString(TagNames.DateTime, Value.ToString("yyyy\:MM\:dd HH\:mm\:ss")) - Catch ex As Exception - End Try - End Set - End Property - - ''' - ''' Time when image was taken (EXIF DateTimeOriginal). - ''' - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - Public Property DateTimeOriginal() As DateTime - Get - Try - Return DateTime.ParseExact(Me.GetPropertyString(TagNames.ExifDTOrig), "yyyy\:MM\:dd HH\:mm\:ss", Nothing) - Catch ex As Exception - Return DateTime.MinValue - End Try - End Get - Set(ByVal Value As DateTime) - Try - Me.SetPropertyString(TagNames.ExifDTOrig, Value.ToString("yyyy\:MM\:dd HH\:mm\:ss")) - Catch ex As Exception - End Try - End Set - End Property - - ''' - ''' Time when image was digitized (EXIF DateTimeDigitized). - ''' - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - Public Property DateTimeDigitized() As DateTime - Get - Try - Return DateTime.ParseExact(Me.GetPropertyString(TagNames.ExifDTDigitized), "yyyy\:MM\:dd HH\:mm\:ss", Nothing) - Catch ex As Exception - Return DateTime.MinValue - End Try - End Get - Set(ByVal Value As DateTime) - Try - Me.SetPropertyString(TagNames.ExifDTDigitized, Value.ToString("yyyy\:MM\:dd HH\:mm\:ss")) - Catch ex As Exception - End Try - End Set - End Property - - ''' - ''' Image width - ''' - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' [altair] 04.09.2005 Changed output to Int32, load from image instead of EXIF - ''' - Public ReadOnly Property Width() As Int32 - Get - Return Me._Image.Width - End Get - End Property - - ''' - ''' Image height - ''' - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' [altair] 04.09.2005 Changed output to Int32, load from image instead of EXIF - ''' - Public ReadOnly Property Height() As Int32 - Get - Return Me._Image.Height - End Get - End Property - - ''' - ''' X resolution in dpi (EXIF XResolution/ResolutionUnit) - ''' - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - Public ReadOnly Property ResolutionX() As Double - Get - Dim R As Double = Me.GetPropertyRational(TagNames.XResolution).ToDouble() - - If Me.GetPropertyInt16(TagNames.ResolutionUnit) = 3 Then - '-- resolution is in points/cm - Return R * 2.54 - Else - '-- resolution is in points/inch - Return R - End If - End Get - End Property - - ''' - ''' Y resolution in dpi (EXIF YResolution/ResolutionUnit) - ''' - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - Public ReadOnly Property ResolutionY() As Double - Get - Dim R As Double = Me.GetPropertyRational(TagNames.YResolution).ToDouble() - - If Me.GetPropertyInt16(TagNames.ResolutionUnit) = 3 Then - '-- resolution is in points/cm - Return R * 2.54 - Else - '-- resolution is in points/inch - Return R - End If - End Get - End Property - - ''' - ''' Image title (EXIF ImageTitle) - ''' - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - Public Property Title() As String - Get - Return Me.GetPropertyString(TagNames.ImageTitle) - End Get - Set(ByVal Value As String) - Try - Me.SetPropertyString(TagNames.ImageTitle, Value) - Catch ex As Exception - End Try - End Set - End Property - - ''' - ''' User comment (EXIF UserComment) - ''' - ''' - ''' - ''' - ''' [altair] 13.06.2004 Created - ''' - Public Property UserComment() As String - Get - Return Me.GetPropertyString(TagNames.ExifUserComment) - End Get - Set(ByVal Value As String) - Try - Me.SetPropertyString(TagNames.ExifUserComment, Value) - Catch ex As Exception - End Try - End Set - End Property - - ''' - ''' Artist name (EXIF Artist) - ''' - ''' - ''' - ''' - ''' [altair] 13.06.2004 Created - ''' - Public Property Artist() As String - Get - Return Me.GetPropertyString(TagNames.Artist) - End Get - Set(ByVal Value As String) - Try - Me.SetPropertyString(TagNames.Artist, Value) - Catch ex As Exception - End Try - End Set - End Property - - ''' - ''' Image description (EXIF ImageDescription) - ''' - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - Public Property Description() As String - Get - Return Me.GetPropertyString(TagNames.ImageDescription) - End Get - Set(ByVal Value As String) - Try - Me.SetPropertyString(TagNames.ImageDescription, Value) - Catch ex As Exception - End Try - End Set - End Property - - ''' - ''' Image copyright (EXIF Copyright) - ''' - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - Public Property Copyright() As String - Get - Return Me.GetPropertyString(TagNames.Copyright) - End Get - Set(ByVal Value As String) - Try - Me.SetPropertyString(TagNames.Copyright, Value.ToString) - Catch ex As Exception - End Try - End Set - End Property - - ''' - ''' Exposure time in seconds (EXIF ExifExposureTime/ExifShutterSpeed) - ''' - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - Public ReadOnly Property ExposureTime() As Double - Get - If Me.IsPropertyDefined(TagNames.ExifExposureTime) Then - '-- Exposure time is explicitly specified - Return Me.GetPropertyRational(TagNames.ExifExposureTime).ToDouble - ElseIf Me.IsPropertyDefined(TagNames.ExifShutterSpeed) Then - '-- Compute exposure time from shutter speed - Return 1 / (2 ^ Me.GetPropertyRational(TagNames.ExifShutterSpeed).ToDouble) - Else - '-- Can't figure out - Return 0 - End If - End Get - End Property - - ''' - ''' Aperture value as F number (EXIF ExifFNumber/ExifApertureValue) - ''' - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - Public ReadOnly Property Aperture() As Double - Get - If Me.IsPropertyDefined(TagNames.ExifFNumber) Then - Return Me.GetPropertyRational(TagNames.ExifFNumber).ToDouble() - ElseIf Me.IsPropertyDefined(TagNames.ExifAperture) Then - Return System.Math.Sqrt(2) ^ Me.GetPropertyRational(TagNames.ExifAperture).ToDouble() - Else - Return 0 - End If - End Get - End Property - - ''' - ''' Exposure program used (EXIF ExifExposureProg) - ''' - ''' - ''' If not specified, returns Normal (2) - ''' - ''' [altair] 10.09.2003 Created - ''' - Public ReadOnly Property ExposureProgram() As ExposurePrograms - Get - Dim X As Int32 = Me.GetPropertyInt16(TagNames.ExifExposureProg) - - If [Enum].IsDefined(GetType(ExposurePrograms), X) Then - Return CType([Enum].Parse(GetType(ExposurePrograms), [Enum].GetName(GetType(ExposurePrograms), X)), ExposurePrograms) - Else - Return ExposurePrograms.Normal - End If - End Get - End Property - - ''' - ''' ISO sensitivity - ''' - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - Public ReadOnly Property ISO() As Int16 - Get - Return Me.GetPropertyInt16(TagNames.ExifISOSpeed) - End Get - End Property - - ''' - ''' Subject distance in meters (EXIF SubjectDistance) - ''' - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - Public ReadOnly Property SubjectDistance() As Double - Get - Return Me.GetPropertyRational(TagNames.ExifSubjectDist).ToDouble() - End Get - End Property - - ''' - ''' Exposure method metering mode used (EXIF MeteringMode) - ''' - ''' - ''' If not specified, returns Unknown (0) - ''' - ''' [altair] 10.09.2003 Created - ''' - Public ReadOnly Property ExposureMeteringMode() As ExposureMeteringModes - Get - Dim X As Int32 = Me.GetPropertyInt16(TagNames.ExifMeteringMode) - - If [Enum].IsDefined(GetType(ExposureMeteringModes), X) Then - Return CType([Enum].Parse(GetType(ExposureMeteringModes), [Enum].GetName(GetType(ExposureMeteringModes), X)), ExposureMeteringModes) - Else - Return ExposureMeteringModes.Unknown - End If - End Get - End Property - - ''' - ''' Focal length of lenses in mm (EXIF FocalLength) - ''' - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - Public ReadOnly Property FocalLength() As Double - Get - Return Me.GetPropertyRational(TagNames.ExifFocalLength).ToDouble - End Get - End Property - - ''' - ''' Flash mode (EXIF Flash) - ''' - ''' - ''' If not present, value NotFired (0) is returned - ''' - ''' [altair] 10.09.2003 Created - ''' - Public ReadOnly Property FlashMode() As FlashModes - Get - Dim X As Int32 = Me.GetPropertyInt16(TagNames.ExifFlash) - - If [Enum].IsDefined(GetType(FlashModes), X) Then - Return CType([Enum].Parse(GetType(FlashModes), [Enum].GetName(GetType(FlashModes), X)), FlashModes) - Else - Return FlashModes.NotFired - End If - End Get - End Property - - ''' - ''' Light source / white balance (EXIF LightSource) - ''' - ''' - ''' If not specified, returns Unknown (0). - ''' - ''' [altair] 10.09.2003 Created - ''' - Public ReadOnly Property LightSource() As LightSources - Get - Dim X As Int32 = Me.GetPropertyInt16(TagNames.ExifLightSource) - - If [Enum].IsDefined(GetType(LightSources), X) Then - Return CType([Enum].Parse(GetType(LightSources), [Enum].GetName(GetType(LightSources), X)), LightSources) - Else - Return LightSources.Unknown - End If - End Get - End Property - -#End Region - -#Region " Support methods for working with EXIF properties " - - ''' - ''' Checks if current image has specified certain property - ''' - ''' - ''' True if image has specified property, False otherwise. - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - Public Function IsPropertyDefined(ByVal PID As Int32) As Boolean - Return CBool([Array].IndexOf(Me._Image.PropertyIdList, PID) > -1) - End Function - - ''' - ''' Gets specified Int32 property - ''' - ''' Property ID - ''' Optional, default 0. Default value returned if property is not present. - ''' Value of property or DefaultValue if property is not present. + Private _Encoding As System.Text.Encoding = System.Text.Encoding.UTF8 + ''' + ''' Get or set encoding used for string metadata + ''' + ''' Encoding used for string metadata + ''' Default encoding is UTF-8 ''' - ''' [altair] 10.09.2003 Created - ''' - Public Function GetPropertyInt32(ByVal PID As Int32, Optional ByVal DefaultValue As Int32 = 0) As Int32 - If Me.IsPropertyDefined(PID) Then - Return GetInt32(Me._Image.GetPropertyItem(PID).Value) - Else - Return DefaultValue - End If - End Function + ''' [altair] 11.07.2004 Created + ''' [altair] 05.09.2005 Changed from shared to instance member + ''' + Public Property Encoding() As System.Text.Encoding + Get + Return Me._Encoding + End Get + Set(ByVal Value As System.Text.Encoding) + If Value Is Nothing Then Throw New ArgumentNullException + Me._Encoding = Encoding + End Set + End Property - ''' - ''' Gets specified Int16 property - ''' - ''' Property ID - ''' Optional, default 0. Default value returned if property is not present. - ''' Value of property or DefaultValue if property is not present. +#Region "Type Declarations" + + ''' + ''' Contains possible values of EXIF tag names (ID) + ''' + ''' See GdiPlusImaging.h ''' - ''' [altair] 10.09.2003 Created - ''' - Public Function GetPropertyInt16(ByVal PID As Int32, Optional ByVal DefaultValue As Int16 = 0) As Int16 - If Me.IsPropertyDefined(PID) Then - Return GetInt16(Me._Image.GetPropertyItem(PID).Value) - Else - Return DefaultValue - End If - End Function + ''' [altair] 10.09.2003 Created + ''' + Public Enum TagNames As Integer + ExifIFD = &H8769 + GpsIFD = &H8825 + NewSubfileType = &HFE + SubfileType = &HFF + ImageWidth = &H100 + ImageHeight = &H101 + BitsPerSample = &H102 + Compression = &H103 + PhotometricInterp = &H106 + ThreshHolding = &H107 + CellWidth = &H108 + CellHeight = &H109 + FillOrder = &H10A + DocumentName = &H10D + ImageDescription = &H10E + EquipMake = &H10F + EquipModel = &H110 + StripOffsets = &H111 + Orientation = &H112 + SamplesPerPixel = &H115 + RowsPerStrip = &H116 + StripBytesCount = &H117 + MinSampleValue = &H118 + MaxSampleValue = &H119 + XResolution = &H11A + YResolution = &H11B + PlanarConfig = &H11C + PageName = &H11D + XPosition = &H11E + YPosition = &H11F + FreeOffset = &H120 + FreeByteCounts = &H121 + GrayResponseUnit = &H122 + GrayResponseCurve = &H123 + T4Option = &H124 + T6Option = &H125 + ResolutionUnit = &H128 + PageNumber = &H129 + TransferFuncition = &H12D + SoftwareUsed = &H131 + DateTime = &H132 + Artist = &H13B + HostComputer = &H13C + Predictor = &H13D + WhitePoint = &H13E + PrimaryChromaticities = &H13F + ColorMap = &H140 + HalftoneHints = &H141 + TileWidth = &H142 + TileLength = &H143 + TileOffset = &H144 + TileByteCounts = &H145 + InkSet = &H14C + InkNames = &H14D + NumberOfInks = &H14E + DotRange = &H150 + TargetPrinter = &H151 + ExtraSamples = &H152 + SampleFormat = &H153 + SMinSampleValue = &H154 + SMaxSampleValue = &H155 + TransferRange = &H156 + JPEGProc = &H200 + JPEGInterFormat = &H201 + JPEGInterLength = &H202 + JPEGRestartInterval = &H203 + JPEGLosslessPredictors = &H205 + JPEGPointTransforms = &H206 + JPEGQTables = &H207 + JPEGDCTables = &H208 + JPEGACTables = &H209 + YCbCrCoefficients = &H211 + YCbCrSubsampling = &H212 + YCbCrPositioning = &H213 + REFBlackWhite = &H214 + ICCProfile = &H8773 + Gamma = &H301 + ICCProfileDescriptor = &H302 + SRGBRenderingIntent = &H303 + ImageTitle = &H320 + Copyright = &H8298 + ResolutionXUnit = &H5001 + ResolutionYUnit = &H5002 + ResolutionXLengthUnit = &H5003 + ResolutionYLengthUnit = &H5004 + PrintFlags = &H5005 + PrintFlagsVersion = &H5006 + PrintFlagsCrop = &H5007 + PrintFlagsBleedWidth = &H5008 + PrintFlagsBleedWidthScale = &H5009 + HalftoneLPI = &H500A + HalftoneLPIUnit = &H500B + HalftoneDegree = &H500C + HalftoneShape = &H500D + HalftoneMisc = &H500E + HalftoneScreen = &H500F + JPEGQuality = &H5010 + GridSize = &H5011 + ThumbnailFormat = &H5012 + ThumbnailWidth = &H5013 + ThumbnailHeight = &H5014 + ThumbnailColorDepth = &H5015 + ThumbnailPlanes = &H5016 + ThumbnailRawBytes = &H5017 + ThumbnailSize = &H5018 + ThumbnailCompressedSize = &H5019 + ColorTransferFunction = &H501A + ThumbnailData = &H501B + ThumbnailImageWidth = &H5020 + ThumbnailImageHeight = &H502 + ThumbnailBitsPerSample = &H5022 + ThumbnailCompression = &H5023 + ThumbnailPhotometricInterp = &H5024 + ThumbnailImageDescription = &H5025 + ThumbnailEquipMake = &H5026 + ThumbnailEquipModel = &H5027 + ThumbnailStripOffsets = &H5028 + ThumbnailOrientation = &H5029 + ThumbnailSamplesPerPixel = &H502A + ThumbnailRowsPerStrip = &H502B + ThumbnailStripBytesCount = &H502C + ThumbnailResolutionX = &H502D + ThumbnailResolutionY = &H502E + ThumbnailPlanarConfig = &H502F + ThumbnailResolutionUnit = &H5030 + ThumbnailTransferFunction = &H5031 + ThumbnailSoftwareUsed = &H5032 + ThumbnailDateTime = &H5033 + ThumbnailArtist = &H5034 + ThumbnailWhitePoint = &H5035 + ThumbnailPrimaryChromaticities = &H5036 + ThumbnailYCbCrCoefficients = &H5037 + ThumbnailYCbCrSubsampling = &H5038 + ThumbnailYCbCrPositioning = &H5039 + ThumbnailRefBlackWhite = &H503A + ThumbnailCopyRight = &H503B + LuminanceTable = &H5090 + ChrominanceTable = &H5091 + FrameDelay = &H5100 + LoopCount = &H5101 + PixelUnit = &H5110 + PixelPerUnitX = &H5111 + PixelPerUnitY = &H5112 + PaletteHistogram = &H5113 + ExifExposureTime = &H829A + ExifFNumber = &H829D + ExifExposureProg = &H8822 + ExifSpectralSense = &H8824 + ExifISOSpeed = &H8827 + ExifOECF = &H8828 + ExifVer = &H9000 + ExifDTOrig = &H9003 + ExifDTDigitized = &H9004 + ExifCompConfig = &H9101 + ExifCompBPP = &H9102 + ExifShutterSpeed = &H9201 + ExifAperture = &H9202 + ExifBrightness = &H9203 + ExifExposureBias = &H9204 + ExifMaxAperture = &H9205 + ExifSubjectDist = &H9206 + ExifMeteringMode = &H9207 + ExifLightSource = &H9208 + ExifFlash = &H9209 + ExifFocalLength = &H920A + ExifMakerNote = &H927C + ExifUserComment = &H9286 + ExifDTSubsec = &H9290 + ExifDTOrigSS = &H9291 + ExifDTDigSS = &H9292 + ExifFPXVer = &HA000 + ExifColorSpace = &HA001 + ExifPixXDim = &HA002 + ExifPixYDim = &HA003 + ExifRelatedWav = &HA004 + ExifInterop = &HA005 + ExifFlashEnergy = &HA20B + ExifSpatialFR = &HA20C + ExifFocalXRes = &HA20E + ExifFocalYRes = &HA20F + ExifFocalResUnit = &HA210 + ExifSubjectLoc = &HA214 + ExifExposureIndex = &HA215 + ExifSensingMethod = &HA217 + ExifFileSource = &HA300 + ExifSceneType = &HA301 + ExifCfaPattern = &HA302 + GpsVer = &H0 + GpsLatitudeRef = &H1 + GpsLatitude = &H2 + GpsLongitudeRef = &H3 + GpsLongitude = &H4 + GpsAltitudeRef = &H5 + GpsAltitude = &H6 + GpsGpsTime = &H7 + GpsGpsSatellites = &H8 + GpsGpsStatus = &H9 + GpsGpsMeasureMode = &HA + GpsGpsDop = &HB + GpsSpeedRef = &HC + GpsSpeed = &HD + GpsTrackRef = &HE + GpsTrack = &HF + GpsImgDirRef = &H10 + GpsImgDir = &H11 + GpsMapDatum = &H12 + GpsDestLatRef = &H13 + GpsDestLat = &H14 + GpsDestLongRef = &H15 + GpsDestLong = &H16 + GpsDestBearRef = &H17 + GpsDestBear = &H18 + GpsDestDistRef = &H19 + GpsDestDist = &H1A + End Enum - ''' - ''' Gets specified string property - ''' - ''' Property ID - ''' Optional, default String.Empty. Default value returned if property is not present. - ''' - ''' Value of property or DefaultValue if property is not present. - ''' - ''' [altair] 10.09.2003 Created - ''' - Public Function GetPropertyString(ByVal PID As Int32, Optional ByVal DefaultValue As String = "") As String - If Me.IsPropertyDefined(PID) Then - Return GetString(Me._Image.GetPropertyItem(PID).Value) - Else - Return DefaultValue - End If - End Function + ''' + ''' Real position of 0th row and column of picture + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Public Enum Orientations + TopLeft = 1 + TopRight = 2 + BottomRight = 3 + BottomLeft = 4 + LeftTop = 5 + RightTop = 6 + RightBottom = 7 + LftBottom = 8 + End Enum - ''' - ''' Gets specified property in raw form - ''' - ''' Property ID - ''' Optional, default Nothing. Default value returned if property is not present. - ''' - ''' Is recommended to use typed methods (like etc.) instead, when possible. - ''' - ''' [altair] 05.09.2005 Created - ''' - Public Function GetProperty(ByVal PID As Int32, Optional ByVal DefaultValue As Byte() = Nothing) As Byte() - If Me.IsPropertyDefined(PID) Then - Return Me._Image.GetPropertyItem(PID).Value - Else - Return DefaultValue - End If - End Function + ''' + ''' Exposure programs + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Public Enum ExposurePrograms + Manual = 1 + Normal = 2 + AperturePriority = 3 + ShutterPriority = 4 + Creative = 5 + Action = 6 + Portrait = 7 + Landscape = 8 + End Enum - ''' - ''' Gets specified rational property - ''' - ''' Property ID - ''' - ''' Value of property or 0/1 if not present. - ''' - ''' [altair] 10.09.2003 Created - ''' - Public Function GetPropertyRational(ByVal PID As Int32) As Rational - If Me.IsPropertyDefined(PID) Then - Return GetRational(Me._Image.GetPropertyItem(PID).Value) - Else - Dim R As Rational - R.Numerator = 0 - R.Denominator = 1 + ''' + ''' Exposure metering modes + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Public Enum ExposureMeteringModes + Unknown = 0 + Average = 1 + CenterWeightedAverage = 2 + Spot = 3 + MultiSpot = 4 + MultiSegment = 5 + [Partial] = 6 + Other = 255 + End Enum + + ''' + ''' Flash activity modes + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Public Enum FlashModes + NotFired = 0 + Fired = 1 + FiredButNoStrobeReturned = 5 + FiredAndStrobeReturned = 7 + End Enum + + ''' + ''' Possible light sources (white balance) + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Public Enum LightSources + Unknown = 0 + Daylight = 1 + Fluorescent = 2 + Tungsten = 3 + Flash = 10 + StandardLightA = 17 + StandardLightB = 18 + StandardLightC = 19 + D55 = 20 + D65 = 21 + D75 = 22 + Other = 255 + End Enum + + ''' + ''' EXIF data types + ''' + ''' + ''' + ''' [altair] 12.6.2004 Created + ''' + Public Enum ExifDataTypes As Short + UnsignedByte = 1 + AsciiString = 2 + UnsignedShort = 3 + UnsignedLong = 4 + UnsignedRational = 5 + SignedByte = 6 + Undefined = 7 + SignedShort = 8 + SignedLong = 9 + SignedRational = 10 + SingleFloat = 11 + DoubleFloat = 12 + End Enum + + ''' + ''' Represents rational which is type of some Exif properties + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Public Structure Rational + Dim Numerator As Int32 + Dim Denominator As Int32 + + ''' + ''' Converts rational to string representation + ''' + ''' Optional, default "/". String to be used as delimiter of components. + ''' String representation of the rational. + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Shadows Function ToString(Optional ByVal Delimiter As String = "/") As String + Return Numerator & Delimiter & Denominator + End Function + + ''' + ''' Converts rational to double precision real number + ''' + ''' The rational as double precision real number. + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Function ToDouble() As Double + Return Numerator / Denominator + End Function + End Structure + +#End Region ' Type Declarations + +#Region "Nicely formatted well-known properties" + + ''' + ''' Brand of equipment (EXIF EquipMake) + ''' + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Public ReadOnly Property EquipmentMaker() As String + Get + Return Me.GetPropertyString(TagNames.EquipMake) + End Get + End Property + + ''' + ''' Model of equipment (EXIF EquipModel) + ''' + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Public ReadOnly Property EquipmentModel() As String + Get + Return Me.GetPropertyString(TagNames.EquipModel) + End Get + End Property + + ''' + ''' Software used for processing (EXIF Software) + ''' + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Public ReadOnly Property Software() As String + Get + Return Me.GetPropertyString(TagNames.SoftwareUsed) + End Get + End Property + + ''' + ''' Orientation of image (position of row 0, column 0) (EXIF Orientation) + ''' + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Public ReadOnly Property Orientation() As Orientations + Get + Dim X As Int32 = Me.GetPropertyInt16(TagNames.Orientation) + + If Not [Enum].IsDefined(GetType(Orientations), X) Then + Return Orientations.TopLeft + Else + Return CType([Enum].Parse(GetType(Orientations), [Enum].GetName(GetType(Orientations), X)), Orientations) + End If + End Get + End Property + + ''' + ''' Time when image was last modified (EXIF DateTime). + ''' + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Public Property DateTimeLastModified() As DateTime + Get + Try + Return DateTime.ParseExact(Me.GetPropertyString(TagNames.DateTime), "yyyy\:MM\:dd HH\:mm\:ss", Nothing) + Catch ex As Exception + Return DateTime.MinValue + End Try + End Get + Set(ByVal Value As DateTime) + Try + Me.SetPropertyString(TagNames.DateTime, Value.ToString("yyyy\:MM\:dd HH\:mm\:ss")) + Catch ex As Exception + End Try + End Set + End Property + + ''' + ''' Time when image was taken (EXIF DateTimeOriginal). + ''' + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Public Property DateTimeOriginal() As DateTime + Get + Try + Return DateTime.ParseExact(Me.GetPropertyString(TagNames.ExifDTOrig), "yyyy\:MM\:dd HH\:mm\:ss", Nothing) + Catch ex As Exception + Return DateTime.MinValue + End Try + End Get + Set(ByVal Value As DateTime) + Try + Me.SetPropertyString(TagNames.ExifDTOrig, Value.ToString("yyyy\:MM\:dd HH\:mm\:ss")) + Catch ex As Exception + End Try + End Set + End Property + + ''' + ''' Time when image was digitized (EXIF DateTimeDigitized). + ''' + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Public Property DateTimeDigitized() As DateTime + Get + Try + Return DateTime.ParseExact(Me.GetPropertyString(TagNames.ExifDTDigitized), "yyyy\:MM\:dd HH\:mm\:ss", Nothing) + Catch ex As Exception + Return DateTime.MinValue + End Try + End Get + Set(ByVal Value As DateTime) + Try + Me.SetPropertyString(TagNames.ExifDTDigitized, Value.ToString("yyyy\:MM\:dd HH\:mm\:ss")) + Catch ex As Exception + End Try + End Set + End Property + + ''' + ''' Image width + ''' + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' [altair] 04.09.2005 Changed output to Int32, load from image instead of EXIF + ''' + Public ReadOnly Property Width() As Int32 + Get + Return Me._Image.Width + End Get + End Property + + ''' + ''' Image height + ''' + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' [altair] 04.09.2005 Changed output to Int32, load from image instead of EXIF + ''' + Public ReadOnly Property Height() As Int32 + Get + Return Me._Image.Height + End Get + End Property + + ''' + ''' X resolution in dpi (EXIF XResolution/ResolutionUnit) + ''' + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Public ReadOnly Property ResolutionX() As Double + Get + Dim R As Double = Me.GetPropertyRational(TagNames.XResolution).ToDouble() + + If Me.GetPropertyInt16(TagNames.ResolutionUnit) = 3 Then + '-- resolution is in points/cm + Return R * 2.54 + Else + '-- resolution is in points/inch Return R - End If - End Function + End If + End Get + End Property - ''' - ''' Sets specified string property - ''' - ''' Property ID - ''' Value to be set - ''' - ''' - ''' [altair] 12.6.2004 Created - ''' - Public Sub SetPropertyString(ByVal PID As Int32, ByVal Value As String) - Dim Data() As Byte = Me._Encoding.GetBytes(Value & vbNullChar) - SetProperty(PID, Data, ExifDataTypes.AsciiString) - End Sub + ''' + ''' Y resolution in dpi (EXIF YResolution/ResolutionUnit) + ''' + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Public ReadOnly Property ResolutionY() As Double + Get + Dim R As Double = Me.GetPropertyRational(TagNames.YResolution).ToDouble() - ''' - ''' Sets specified Int16 property - ''' - ''' Property ID - ''' Value to be set - ''' - ''' - ''' [altair] 12.6.2004 Created - ''' - Public Sub SetPropertyInt16(ByVal PID As Int32, ByVal Value As Int16) - Dim Data(1) As Byte - Data(0) = CType(Value And &HFF, Byte) - Data(1) = CType((Value And &HFF00) >> 8, Byte) - SetProperty(PID, Data, ExifDataTypes.SignedShort) - End Sub + If Me.GetPropertyInt16(TagNames.ResolutionUnit) = 3 Then + '-- resolution is in points/cm + Return R * 2.54 + Else + '-- resolution is in points/inch + Return R + End If + End Get + End Property - ''' - ''' Sets specified Int32 property - ''' - ''' Property ID - ''' Value to be set - ''' - ''' - ''' [altair] 13.06.2004 Created - ''' - Public Sub SetPropertyInt32(ByVal PID As Int32, ByVal Value As Int32) - Dim Data(3) As Byte - For I As Int32 = 0 To 3 - Data(I) = CType(Value And &HFF, Byte) - Value >>= 8 - Next - SetProperty(PID, Data, ExifDataTypes.SignedLong) - End Sub + ''' + ''' Image title (EXIF ImageTitle) + ''' + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Public Property Title() As String + Get + Return Me.GetPropertyString(TagNames.ImageTitle) + End Get + Set(ByVal Value As String) + Try + Me.SetPropertyString(TagNames.ImageTitle, Value) + Catch ex As Exception + End Try + End Set + End Property - ''' - ''' Sets specified propery in raw form - ''' - ''' Property ID - ''' Raw data - ''' EXIF data type - ''' Is recommended to use typed methods (like etc.) instead, when possible. - ''' - ''' [altair] 12.6.2004 Created - ''' - Public Sub SetProperty(ByVal PID As Int32, ByVal Data() As Byte, ByVal Type As ExifDataTypes) - Dim P As System.Drawing.Imaging.PropertyItem = Me._Image.PropertyItems(0) - P.Id = PID - P.Value = Data - P.Type = Type - P.Len = Data.Length - Me._Image.SetPropertyItem(P) - End Sub + ''' + ''' User comment (EXIF UserComment) + ''' + ''' + ''' + ''' + ''' [altair] 13.06.2004 Created + ''' + Public Property UserComment() As String + Get + Return Me.GetPropertyString(TagNames.ExifUserComment) + End Get + Set(ByVal Value As String) + Try + Me.SetPropertyString(TagNames.ExifUserComment, Value) + Catch ex As Exception + End Try + End Set + End Property - ''' - ''' Reads Int32 from EXIF bytearray. - ''' - ''' EXIF bytearray to process - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' [altair] 05.09.2005 Changed from public shared to private instance method - ''' - Private Function GetInt32(ByVal B As Byte()) As Int32 - If B.Length < 4 Then Throw New ArgumentException("Data too short (4 bytes expected)", "B") - Return B(3) << 24 Or B(2) << 16 Or B(1) << 8 Or B(0) - End Function + ''' + ''' Artist name (EXIF Artist) + ''' + ''' + ''' + ''' + ''' [altair] 13.06.2004 Created + ''' + Public Property Artist() As String + Get + Return Me.GetPropertyString(TagNames.Artist) + End Get + Set(ByVal Value As String) + Try + Me.SetPropertyString(TagNames.Artist, Value) + Catch ex As Exception + End Try + End Set + End Property - ''' - ''' Reads Int16 from EXIF bytearray. - ''' - ''' EXIF bytearray to process - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' [altair] 05.09.2005 Changed from public shared to private instance method - ''' - Private Function GetInt16(ByVal B As Byte()) As Int16 - If B.Length < 2 Then Throw New ArgumentException("Data too short (2 bytes expected)", "B") - Return B(1) << 8 Or B(0) - End Function + ''' + ''' Image description (EXIF ImageDescription) + ''' + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Public Property Description() As String + Get + Return Me.GetPropertyString(TagNames.ImageDescription) + End Get + Set(ByVal Value As String) + Try + Me.SetPropertyString(TagNames.ImageDescription, Value) + Catch ex As Exception + End Try + End Set + End Property - ''' - ''' Reads string from EXIF bytearray. - ''' - ''' EXIF bytearray to process - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' [altair] 05.09.2005 Changed from public shared to private instance method - ''' - Private Function GetString(ByVal B As Byte()) As String - Dim R As String = Me._Encoding.GetString(B) - If R.EndsWith(vbNullChar) Then R = R.Substring(0, R.Length - 1) - Return R - End Function + ''' + ''' Image copyright (EXIF Copyright) + ''' + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Public Property Copyright() As String + Get + Return Me.GetPropertyString(TagNames.Copyright) + End Get + Set(ByVal Value As String) + Try + Me.SetPropertyString(TagNames.Copyright, Value.ToString) + Catch ex As Exception + End Try + End Set + End Property - ''' - ''' Reads rational from EXIF bytearray. - ''' - ''' EXIF bytearray to process - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' [altair] 05.09.2005 Changed from public shared to private instance method - ''' - Private Function GetRational(ByVal B As Byte()) As Rational - Dim R As New Rational, N(3), D(3) As Byte - Array.Copy(B, 0, N, 0, 4) - Array.Copy(B, 4, D, 0, 4) - R.Denominator = Me.GetInt32(D) - R.Numerator = Me.GetInt32(N) - Return R - End Function + ''' + ''' Exposure time in seconds (EXIF ExifExposureTime/ExifShutterSpeed) + ''' + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Public ReadOnly Property ExposureTime() As Double + Get + If Me.IsPropertyDefined(TagNames.ExifExposureTime) Then + '-- Exposure time is explicitly specified + Return Me.GetPropertyRational(TagNames.ExifExposureTime).ToDouble + ElseIf Me.IsPropertyDefined(TagNames.ExifShutterSpeed) Then + '-- Compute exposure time from shutter speed + Return 1 / (2 ^ Me.GetPropertyRational(TagNames.ExifShutterSpeed).ToDouble) + Else + '-- Can't figure out + Return 0 + End If + End Get + End Property -#End Region + ''' + ''' Aperture value as F number (EXIF ExifFNumber/ExifApertureValue) + ''' + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Public ReadOnly Property Aperture() As Double + Get + If Me.IsPropertyDefined(TagNames.ExifFNumber) Then + Return Me.GetPropertyRational(TagNames.ExifFNumber).ToDouble() + ElseIf Me.IsPropertyDefined(TagNames.ExifAperture) Then + Return System.Math.Sqrt(2) ^ Me.GetPropertyRational(TagNames.ExifAperture).ToDouble() + Else + Return 0 + End If + End Get + End Property -#Region " IDisposable implementation " + ''' + ''' Exposure program used (EXIF ExifExposureProg) + ''' + ''' + ''' If not specified, returns Normal (2) + ''' + ''' [altair] 10.09.2003 Created + ''' + Public ReadOnly Property ExposureProgram() As ExposurePrograms + Get + Dim X As Int32 = Me.GetPropertyInt16(TagNames.ExifExposureProg) - ''' - ''' Disposes unmanaged resources of this class - ''' - ''' - ''' - ''' [altair] 10.09.2003 Created - ''' - Public Sub Dispose() Implements System.IDisposable.Dispose - Me._Image.Dispose() - End Sub + If [Enum].IsDefined(GetType(ExposurePrograms), X) Then + Return CType([Enum].Parse(GetType(ExposurePrograms), [Enum].GetName(GetType(ExposurePrograms), X)), ExposurePrograms) + Else + Return ExposurePrograms.Normal + End If + End Get + End Property -#End Region + ''' + ''' ISO sensitivity + ''' + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Public ReadOnly Property ISO() As Int16 + Get + Return Me.GetPropertyInt16(TagNames.ExifISOSpeed) + End Get + End Property + + ''' + ''' Subject distance in meters (EXIF SubjectDistance) + ''' + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Public ReadOnly Property SubjectDistance() As Double + Get + Return Me.GetPropertyRational(TagNames.ExifSubjectDist).ToDouble() + End Get + End Property + + ''' + ''' Exposure method metering mode used (EXIF MeteringMode) + ''' + ''' + ''' If not specified, returns Unknown (0) + ''' + ''' [altair] 10.09.2003 Created + ''' + Public ReadOnly Property ExposureMeteringMode() As ExposureMeteringModes + Get + Dim X As Int32 = Me.GetPropertyInt16(TagNames.ExifMeteringMode) + + If [Enum].IsDefined(GetType(ExposureMeteringModes), X) Then + Return CType([Enum].Parse(GetType(ExposureMeteringModes), [Enum].GetName(GetType(ExposureMeteringModes), X)), ExposureMeteringModes) + Else + Return ExposureMeteringModes.Unknown + End If + End Get + End Property + + ''' + ''' Focal length of lenses in mm (EXIF FocalLength) + ''' + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Public ReadOnly Property FocalLength() As Double + Get + Return Me.GetPropertyRational(TagNames.ExifFocalLength).ToDouble + End Get + End Property + + ''' + ''' Flash mode (EXIF Flash) + ''' + ''' + ''' If not present, value NotFired (0) is returned + ''' + ''' [altair] 10.09.2003 Created + ''' + Public ReadOnly Property FlashMode() As FlashModes + Get + Dim X As Int32 = Me.GetPropertyInt16(TagNames.ExifFlash) + + If [Enum].IsDefined(GetType(FlashModes), X) Then + Return CType([Enum].Parse(GetType(FlashModes), [Enum].GetName(GetType(FlashModes), X)), FlashModes) + Else + Return FlashModes.NotFired + End If + End Get + End Property + + ''' + ''' Light source / white balance (EXIF LightSource) + ''' + ''' + ''' If not specified, returns Unknown (0). + ''' + ''' [altair] 10.09.2003 Created + ''' + Public ReadOnly Property LightSource() As LightSources + Get + Dim X As Int32 = Me.GetPropertyInt16(TagNames.ExifLightSource) + + If [Enum].IsDefined(GetType(LightSources), X) Then + Return CType([Enum].Parse(GetType(LightSources), [Enum].GetName(GetType(LightSources), X)), LightSources) + Else + Return LightSources.Unknown + End If + End Get + End Property + +#End Region ' Nicely formatted well-known properties + +#End Region ' Fields & Properties + +#Region "CONSTRUCTOR" + + ''' + ''' Initializes new instance of this class. + ''' + ''' Bitmap to read exif information from + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Public Sub New(ByRef Bitmap As System.Drawing.Bitmap) + If Bitmap Is Nothing Then Throw New ArgumentNullException("Bitmap") + Me._Image = Bitmap + End Sub + + ''' + ''' Initializes new instance of this class. + ''' + ''' Name of file to be loaded + ''' + ''' + ''' [altair] 13.06.2004 Created + ''' + Public Sub New(ByVal FileName As String) + Me._Image = DirectCast(System.Drawing.Bitmap.FromFile(FileName), System.Drawing.Bitmap) + End Sub + +#End Region ' Constructor + +#Region "METHODS" + + ''' + ''' Returns copy of bitmap this instance is working on + ''' + ''' + ''' + ''' + ''' [altair] 13.06.2004 Created + ''' + Public Function GetBitmap() As System.Drawing.Bitmap + Return DirectCast(Me._Image.Clone(), System.Drawing.Bitmap) + End Function + + ''' + ''' Returns all available data in formatted string form + ''' + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Public Overrides Function ToString() As String + Dim SB As New System.Text.StringBuilder + + SB.Append("Image:") + SB.Append("\n\tDimensions: " & Me.Width & " x " & Me.Height & " px") + SB.Append("\n\tResolution: " & Me.ResolutionX & " x " & Me.ResolutionY & " dpi") + SB.Append("\n\tOrientation: " & [Enum].GetName(GetType(Orientations), Me.Orientation)) + SB.Append("\n\tTitle: " & Me.Title) + SB.Append("\n\tDescription: " & Me.Description) + SB.Append("\n\tCopyright: " & Me.Copyright) + SB.Append("\nEquipment:") + SB.Append("\n\tMaker: " & Me.EquipmentMaker) + SB.Append("\n\tModel: " & Me.EquipmentModel) + SB.Append("\n\tSoftware: " & Me.Software) + SB.Append("\nDate and time:") + SB.Append("\n\tGeneral: " & Me.DateTimeLastModified.ToString()) + SB.Append("\n\tOriginal: " & Me.DateTimeOriginal.ToString()) + SB.Append("\n\tDigitized: " & Me.DateTimeDigitized.ToString()) + SB.Append("\nShooting conditions:") + SB.Append("\n\tExposure time: " & Me.ExposureTime.ToString("N4") & " s") + SB.Append("\n\tExposure program: " & [Enum].GetName(GetType(ExposurePrograms), Me.ExposureProgram)) + SB.Append("\n\tExposure mode: " & [Enum].GetName(GetType(ExposureMeteringModes), Me.ExposureMeteringMode)) + SB.Append("\n\tAperture: F" & Me.Aperture.ToString("N2")) + SB.Append("\n\tISO sensitivity: " & Me.ISO) + SB.Append("\n\tSubject distance: " & Me.SubjectDistance.ToString("N2") & " m") + SB.Append("\n\tFocal length: " & Me.FocalLength) + SB.Append("\n\tFlash: " & [Enum].GetName(GetType(FlashModes), Me.FlashMode)) + SB.Append("\n\tLight source (WB): " & [Enum].GetName(GetType(LightSources), Me.LightSource)) + SB.Replace("\n", vbCrLf) + SB.Replace("\t", vbTab) + + Return SB.ToString() + End Function + +#Region "Support methods for working with EXIF properties" + + ''' + ''' Checks if current image has specified certain property + ''' + ''' + ''' True if image has specified property, False otherwise. + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Public Function IsPropertyDefined(ByVal PID As Int32) As Boolean + Return CBool([Array].IndexOf(Me._Image.PropertyIdList, PID) > -1) + End Function + + ''' + ''' Gets specified Int32 property + ''' + ''' Property ID + ''' Optional, default 0. Default value returned if property is not present. + ''' Value of property or DefaultValue if property is not present. + ''' + ''' [altair] 10.09.2003 Created + ''' + Public Function GetPropertyInt32(ByVal PID As Int32, Optional ByVal DefaultValue As Int32 = 0) As Int32 + If Me.IsPropertyDefined(PID) Then + Return GetInt32(Me._Image.GetPropertyItem(PID).Value) + Else + Return DefaultValue + End If + End Function + + ''' + ''' Gets specified Int16 property + ''' + ''' Property ID + ''' Optional, default 0. Default value returned if property is not present. + ''' Value of property or DefaultValue if property is not present. + ''' + ''' [altair] 10.09.2003 Created + ''' + Public Function GetPropertyInt16(ByVal PID As Int32, Optional ByVal DefaultValue As Int16 = 0) As Int16 + If Me.IsPropertyDefined(PID) Then + Return GetInt16(Me._Image.GetPropertyItem(PID).Value) + Else + Return DefaultValue + End If + End Function + + ''' + ''' Gets specified string property + ''' + ''' Property ID + ''' Optional, default String.Empty. Default value returned if property is not present. + ''' + ''' Value of property or DefaultValue if property is not present. + ''' + ''' [altair] 10.09.2003 Created + ''' + Public Function GetPropertyString(ByVal PID As Int32, Optional ByVal DefaultValue As String = "") As String + If Me.IsPropertyDefined(PID) Then + Return GetString(Me._Image.GetPropertyItem(PID).Value) + Else + Return DefaultValue + End If + End Function + + ''' + ''' Gets specified property in raw form + ''' + ''' Property ID + ''' Optional, default Nothing. Default value returned if property is not present. + ''' + ''' Is recommended to use typed methods (like etc.) instead, when possible. + ''' + ''' [altair] 05.09.2005 Created + ''' + Public Function GetProperty(ByVal PID As Int32, Optional ByVal DefaultValue As Byte() = Nothing) As Byte() + If Me.IsPropertyDefined(PID) Then + Return Me._Image.GetPropertyItem(PID).Value + Else + Return DefaultValue + End If + End Function + + ''' + ''' Gets specified rational property + ''' + ''' Property ID + ''' + ''' Value of property or 0/1 if not present. + ''' + ''' [altair] 10.09.2003 Created + ''' + Public Function GetPropertyRational(ByVal PID As Int32) As Rational + If Me.IsPropertyDefined(PID) Then + Return GetRational(Me._Image.GetPropertyItem(PID).Value) + Else + Dim R As Rational + R.Numerator = 0 + R.Denominator = 1 + Return R + End If + End Function + + ''' + ''' Sets specified string property + ''' + ''' Property ID + ''' Value to be set + ''' + ''' + ''' [altair] 12.6.2004 Created + ''' + Public Sub SetPropertyString(ByVal PID As Int32, ByVal Value As String) + Dim Data() As Byte = Me._Encoding.GetBytes(Value & vbNullChar) + SetProperty(PID, Data, ExifDataTypes.AsciiString) + End Sub + + ''' + ''' Sets specified Int16 property + ''' + ''' Property ID + ''' Value to be set + ''' + ''' + ''' [altair] 12.6.2004 Created + ''' + Public Sub SetPropertyInt16(ByVal PID As Int32, ByVal Value As Int16) + Dim Data(1) As Byte + Data(0) = CType(Value And &HFF, Byte) + Data(1) = CType((Value And &HFF00) >> 8, Byte) + SetProperty(PID, Data, ExifDataTypes.SignedShort) + End Sub + + ''' + ''' Sets specified Int32 property + ''' + ''' Property ID + ''' Value to be set + ''' + ''' + ''' [altair] 13.06.2004 Created + ''' + Public Sub SetPropertyInt32(ByVal PID As Int32, ByVal Value As Int32) + Dim Data(3) As Byte + For I As Int32 = 0 To 3 + Data(I) = CType(Value And &HFF, Byte) + Value >>= 8 + Next + SetProperty(PID, Data, ExifDataTypes.SignedLong) + End Sub + + ''' + ''' Sets specified propery in raw form + ''' + ''' Property ID + ''' Raw data + ''' EXIF data type + ''' Is recommended to use typed methods (like etc.) instead, when possible. + ''' + ''' [altair] 12.6.2004 Created + ''' + Public Sub SetProperty(ByVal PID As Int32, ByVal Data() As Byte, ByVal Type As ExifDataTypes) + Dim P As System.Drawing.Imaging.PropertyItem = Me._Image.PropertyItems(0) + P.Id = PID + P.Value = Data + P.Type = Type + P.Len = Data.Length + Me._Image.SetPropertyItem(P) + End Sub + + ''' + ''' Reads Int32 from EXIF bytearray. + ''' + ''' EXIF bytearray to process + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' [altair] 05.09.2005 Changed from public shared to private instance method + ''' + Private Function GetInt32(ByVal B As Byte()) As Int32 + If B.Length < 4 Then Throw New ArgumentException("Data too short (4 bytes expected)", "B") + Return B(3) << 24 Or B(2) << 16 Or B(1) << 8 Or B(0) + End Function + + ''' + ''' Reads Int16 from EXIF bytearray. + ''' + ''' EXIF bytearray to process + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' [altair] 05.09.2005 Changed from public shared to private instance method + ''' + Private Function GetInt16(ByVal B As Byte()) As Int16 + If B.Length < 2 Then Throw New ArgumentException("Data too short (2 bytes expected)", "B") + Return B(1) << 8 Or B(0) + End Function + + ''' + ''' Reads string from EXIF bytearray. + ''' + ''' EXIF bytearray to process + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' [altair] 05.09.2005 Changed from public shared to private instance method + ''' + Private Function GetString(ByVal B As Byte()) As String + Dim R As String = Me._Encoding.GetString(B) + If R.EndsWith(vbNullChar) Then R = R.Substring(0, R.Length - 1) + Return R + End Function + + ''' + ''' Reads rational from EXIF bytearray. + ''' + ''' EXIF bytearray to process + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' [altair] 05.09.2005 Changed from public shared to private instance method + ''' + Private Function GetRational(ByVal B As Byte()) As Rational + Dim R As New Rational, N(3), D(3) As Byte + Array.Copy(B, 0, N, 0, 4) + Array.Copy(B, 4, D, 0, 4) + R.Denominator = Me.GetInt32(D) + R.Numerator = Me.GetInt32(N) + Return R + End Function + +#End Region ' Support methods for working with EXIF properties + +#Region "IDisposable implementation" + + ''' + ''' Disposes unmanaged resources of this class + ''' + ''' + ''' + ''' [altair] 10.09.2003 Created + ''' + Public Sub Dispose() Implements System.IDisposable.Dispose + Me._Image.Dispose() + End Sub + +#End Region ' IDisposable implementation + +#End Region ' Methods End Class diff --git a/CameraMng/FormSce.vb b/CameraMng/FormSce.vb index 649b75e..aa3e673 100644 --- a/CameraMng/FormSce.vb +++ b/CameraMng/FormSce.vb @@ -1,15 +1,22 @@ Public Class FrmScelta - + +#Region "EVENTS" + Private Sub BtnOk_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnOk.Click Me.Hide() End Sub + Private Sub FrmScelta_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load LbSpessLastra.Text = Format(SpessLastra, "0") & " mm" End Sub - Private Sub LbSpessLastra_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles LbSpessLastra.Click + + Private Sub LbSpessLastra_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles LbSpessLastra.Click NumPad.Text = Format(SpessLastra, "0") ' la stringa di uscita NumPad.ShowDialog() SpessLastra = Convert.ToDouble(NumPad.Text) LbSpessLastra.Text = Format(SpessLastra, "0.0") & " mm" - End Sub + End Sub + +#End Region ' Events + End Class \ No newline at end of file diff --git a/CameraMng/FrmMain.designer.vb b/CameraMng/FrmMain.designer.vb index 2263476..3eab900 100644 --- a/CameraMng/FrmMain.designer.vb +++ b/CameraMng/FrmMain.designer.vb @@ -74,6 +74,7 @@ Partial Class FrmMain Me.BtnAbortDefAree = New System.Windows.Forms.Button() Me.BtnSaveAree = New System.Windows.Forms.Button() Me.ImageControl1 = New ImageControl() + Me.ComboBoxCamera = New System.Windows.Forms.ComboBox() Me.GBImgFromCam.SuspendLayout() Me.GBCorrected.SuspendLayout() Me.GBCalibration.SuspendLayout() @@ -419,10 +420,17 @@ Partial Class FrmMain Me.ImageControl1.ZoomFactor = 1.0R Me.ImageControl1.ZoomOnMouseWheel = True ' + 'ComboBoxCamera + ' + Me.ComboBoxCamera.FormattingEnabled = True + resources.ApplyResources(Me.ComboBoxCamera, "ComboBoxCamera") + Me.ComboBoxCamera.Name = "ComboBoxCamera" + ' 'FrmMain ' resources.ApplyResources(Me, "$this") Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font + Me.Controls.Add(Me.ComboBoxCamera) Me.Controls.Add(Me.GBDefAree) Me.Controls.Add(Me.StatusStrip1) Me.Controls.Add(Me.ToolStrip1) @@ -500,4 +508,5 @@ Partial Class FrmMain Friend WithEvents BtnVentosa As System.Windows.Forms.Button Friend WithEvents BtnExpT As System.Windows.Forms.Button Friend WithEvents BtnStone As System.Windows.Forms.Button + Friend WithEvents ComboBoxCamera As ComboBox End Class diff --git a/CameraMng/FrmMain.resx b/CameraMng/FrmMain.resx index 0aa8b07..a393b8f 100644 --- a/CameraMng/FrmMain.resx +++ b/CameraMng/FrmMain.resx @@ -128,7 +128,7 @@ AAEAAAD/////AQAAAAAAAAAMAgAAAFdTeXN0ZW0uV2luZG93cy5Gb3JtcywgVmVyc2lvbj00LjAuMC4w LCBDdWx0dXJlPW5ldXRyYWwsIFB1YmxpY0tleVRva2VuPWI3N2E1YzU2MTkzNGUwODkFAQAAACZTeXN0 ZW0uV2luZG93cy5Gb3Jtcy5JbWFnZUxpc3RTdHJlYW1lcgEAAAAERGF0YQcCAgAAAAkDAAAADwMAAAAS - TwAAAk1TRnQBSQFMAgEBCQEAAbQBAQG0AQEBMgEAATIBAAT/AQkBAAj/AUIBTQE2AQQGAAE2AQQCAAEo + TwAAAk1TRnQBSQFMAgEBCQEAAbwBAQG8AQEBMgEAATIBAAT/AQkBAAj/AUIBTQE2AQQGAAE2AQQCAAEo AwAByAMAAZYDAAEBAQABCAUAATABdRgAAYACAAGAAwACgAEAAYADAAGAAQABgAEAAoACAAPAAQABwAHc AcABAAHwAcoBpgEAATMFAAEzAQABMwEAATMBAAIzAgADFgEAAxwBAAMiAQADKQEAA1UBAANNAQADQgEA AzkBAAGAAXwB/wEAAlAB/wEAAZMBAAHWAQAB/wHsAcwBAAHGAdYB7wEAAdYC5wEAAZABqQGtAgAB/wEz @@ -478,13 +478,10 @@ - 145, 639 - - - 4, 0, 4, 0 + 109, 519 - 0, 16 + 0, 13 25 @@ -499,7 +496,7 @@ $this - 9 + 10 True @@ -508,13 +505,10 @@ NoControl - 508, 16 - - - 4, 0, 4, 0 + 381, 13 - 0, 16 + 0, 13 31 @@ -529,22 +523,76 @@ $this - 8 + 9 257, 12 + + BtnDefAree + + + System.Windows.Forms.Button, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + GBImgFromCam + + + 0 + + + BtnCorrLens + + + System.Windows.Forms.Button, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + GBImgFromCam + + + 1 + + + BtnCorrCompleta + + + System.Windows.Forms.Button, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + GBImgFromCam + + + 2 + + + 500, 140 + + + 80, 302 + + + 44 + + + GBImgFromCam + + + System.Windows.Forms.GroupBox, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + $this + + + 7 + NoControl - 13, 215 - - - 4, 4, 4, 4 + 10, 175 - 80, 62 + 60, 50 43 @@ -565,13 +613,10 @@ NoControl - 13, 134 - - - 4, 4, 4, 4 + 10, 109 - 80, 62 + 60, 50 42 @@ -592,13 +637,10 @@ NoControl - 13, 34 - - - 4, 4, 4, 4 + 10, 28 - 80, 62 + 60, 50 39 @@ -615,31 +657,37 @@ 2 - - 667, 172 + + BtnSave - - 4, 4, 4, 4 + + System.Windows.Forms.Button, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 - - 4, 4, 4, 4 + + GBCorrected - - 107, 372 + + 0 - - 44 + + 598, 140 - - GBImgFromCam + + 80, 302 - + + 45 + + + GBCorrected + + System.Windows.Forms.GroupBox, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 - + $this - + 6 @@ -711,13 +759,10 @@ NoControl - 19, 295 - - - 4, 4, 4, 4 + 14, 240 - 80, 62 + 60, 50 22 @@ -734,31 +779,157 @@ 0 - - 797, 172 + + Label3 - - 4, 4, 4, 4 + + System.Windows.Forms.Label, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 - - 4, 4, 4, 4 + + GBCalibration - - 107, 372 + + 0 - - 45 + + Label2 - - GBCorrected + + System.Windows.Forms.Label, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 - + + GBCalibration + + + 1 + + + Label1 + + + System.Windows.Forms.Label, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + GBCalibration + + + 2 + + + lbYmm + + + System.Windows.Forms.Label, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + GBCalibration + + + 3 + + + lbXmm + + + System.Windows.Forms.Label, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + GBCalibration + + + 4 + + + PictureBox2 + + + System.Windows.Forms.PictureBox, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + GBCalibration + + + 5 + + + LbAltRif + + + System.Windows.Forms.Label, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + GBCalibration + + + 6 + + + LbAltCali + + + System.Windows.Forms.Label, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + GBCalibration + + + 7 + + + PictureBox1 + + + System.Windows.Forms.PictureBox, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + GBCalibration + + + 8 + + + BtnAbortCal + + + System.Windows.Forms.Button, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + GBCalibration + + + 9 + + + BtnSaveCal + + + System.Windows.Forms.Button, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + GBCalibration + + + 10 + + + 684, 114 + + + 108, 365 + + + 46 + + + GBCalibration + + System.Windows.Forms.GroupBox, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 - + $this - + 5 @@ -768,13 +939,10 @@ NoControl - 36, 212 - - - 4, 0, 4, 0 + 27, 172 - 88, 16 + 69, 13 56 @@ -801,13 +969,10 @@ NoControl - 8, 268 - - - 4, 0, 4, 0 + 6, 218 - 16, 16 + 14, 13 55 @@ -834,13 +999,10 @@ NoControl - 8, 234 - - - 4, 0, 4, 0 + 6, 190 - 15, 16 + 14, 13 54 @@ -867,13 +1029,10 @@ NoControl - 32, 267 - - - 4, 0, 4, 0 + 24, 217 - 101, 26 + 76, 21 53 @@ -897,13 +1056,10 @@ NoControl - 32, 230 - - - 4, 0, 4, 0 + 24, 187 - 101, 26 + 76, 21 52 @@ -924,13 +1080,10 @@ NoControl - 16, 123 - - - 4, 4, 4, 4 + 12, 100 - 87, 49 + 65, 40 51 @@ -954,13 +1107,10 @@ NoControl - 16, 176 - - - 4, 0, 4, 0 + 12, 143 - 87, 26 + 65, 21 50 @@ -984,13 +1134,10 @@ NoControl - 16, 65 - - - 4, 0, 4, 0 + 12, 53 - 87, 26 + 65, 21 49 @@ -1011,13 +1158,10 @@ NoControl - 16, 28 - - - 4, 4, 4, 4 + 12, 23 - 87, 33 + 65, 27 48 @@ -1038,13 +1182,10 @@ NoControl - 19, 327 - - - 4, 4, 4, 4 + 14, 266 - 80, 46 + 60, 37 24 @@ -1133,13 +1274,10 @@ NoControl - 16, 380 - - - 4, 4, 4, 4 + 12, 309 - 80, 62 + 60, 50 23 @@ -1156,40 +1294,37 @@ 10 - - 912, 140 - - - 4, 4, 4, 4 - - - 4, 4, 4, 4 - - - 144, 449 - - - 46 - - - GBCalibration - - - System.Windows.Forms.GroupBox, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 - - - $this - - - 4 - 372, 12 + + 0, 0 + + + 795, 45 + + + 101 + + + ToolStrip1 + + + ToolStrip1 + + + System.Windows.Forms.ToolStrip, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + $this + + + 3 + iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8 - YQUAAAAJcEhZcwAAEnQAABJ0Ad5mH3gAAABlSURBVDhPxZBRCsAwCEM9uufZJTdkWrpoaToKDbyvmodW + YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAABlSURBVDhPxZBRCsAwCEM9uufZJTdkWrpoaToKDbyvmodW ZGdU9UZwZhgbrkJJWvmSjEsqOIFLMC54JVNBQRPgWgxJwCZKA4HdOsdKsUn+g6KARPG3wEiCVUlX/gpW SAJP/8ByOA85jMsZFmo5BQAAAABJRU5ErkJggg== @@ -1198,7 +1333,7 @@ Magenta - 29, 42 + 24, 42 Open picture @@ -1206,7 +1341,7 @@ iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8 - YQUAAAAJcEhZcwAAEnQAABJ0Ad5mH3gAAADjSURBVFhHxZTRDcIwDAU9Avv/MAojMBIoFQ+Vw2nslJiT + YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAADjSURBVFhHxZTRDcIwDAU9Avv/MAojMBIoFQ+Vw2nslJiT nkQF9jupIWbzXMzsbmZXflGByh+vlEqwvFSiV14iMSpfKhEtXypBWFpOmQCLspmivXPBhdmk0YETs4s4 FzqY+9MuuCgK59rnoUT7gTf4K4FDiX25N5iFc/vdXxIs95KF88xbIlLekoXzXjaJ6BWbhfNeNoHoPZ+F 88zHOfAkBJ+jcK5bLigh+ByFc4fl4u8XUeOvV7GHFs3mNFyYzTLKinqUCvAvOsr0gTsiKrGkXIwklpaL @@ -1217,7 +1352,7 @@ Magenta - 29, 42 + 24, 42 Zoom All @@ -1225,7 +1360,7 @@ iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8 - YQUAAAAJcEhZcwAAEnQAABJ0Ad5mH3gAAAIFSURBVDhPpZLtS1NhGMbPPxJmmlYSgqHiKzGU1EDxg4iK + YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAIFSURBVDhPpZLtS1NhGMbPPxJmmlYSgqHiKzGU1EDxg4iK YKyG2WBogqMYJQOtCEVRFBGdTBCJfRnkS4VaaWNT5sqx1BUxRXxDHYxAJLvkusEeBaPAB+5z4Jzn+t3X /aLhnEfjo8m+dCoa+7/C3O2Hqe0zDC+8KG+cRZHZhdzaaWTVTCLDMIY0vfM04Nfh77/G/sEhwpEDbO3t I7TxE8urEVy99fT/AL5gWDLrTB/hnF4XsW0khCu5ln8DmJliT2AXrcNBsU1gj/MH4nMeKwBrPktM28xM @@ -1241,7 +1376,7 @@ Magenta - 32, 42 + 26, 42 1:1 @@ -1250,7 +1385,7 @@ Magenta - 29, 42 + 24, 42 ToolStripButton1 @@ -1258,7 +1393,7 @@ iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8 - YQUAAAAJcEhZcwAAEnQAABJ0Ad5mH3gAAAIFSURBVDhPpZLtS1NhGMbPPxJmmlYSgqHiKzGU1EDxg4iK + YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAIFSURBVDhPpZLtS1NhGMbPPxJmmlYSgqHiKzGU1EDxg4iK YKyG2WBogqMYJQOtCEVRFBGdTBCJfRnkS4VaaWNT5sqx1BUxRXxDHYxAJLvkusEeBaPAB+5z4Jzn+t3X /aLhnEfjo8m+dCoa+7/C3O2Hqe0zDC+8KG+cRZHZhdzaaWTVTCLDMIY0vfM04Nfh77/G/sEhwpEDbO3t I7TxE8urEVy99fT/AL5gWDLrTB/hnF4XsW0khCu5ln8DmJliT2AXrcNBsU1gj/MH4nMeKwBrPktM28xM @@ -1274,7 +1409,7 @@ Magenta - 85, 42 + 70, 42 Corr. Prosp @@ -1283,7 +1418,7 @@ Magenta - 29, 42 + 24, 42 Cfg @@ -1291,7 +1426,7 @@ iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8 - YQUAAAAJcEhZcwAAEnQAABJ0Ad5mH3gAAAIFSURBVDhPpZLtS1NhGMbPPxJmmlYSgqHiKzGU1EDxg4iK + YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAIFSURBVDhPpZLtS1NhGMbPPxJmmlYSgqHiKzGU1EDxg4iK YKyG2WBogqMYJQOtCEVRFBGdTBCJfRnkS4VaaWNT5sqx1BUxRXxDHYxAJLvkusEeBaPAB+5z4Jzn+t3X /aLhnEfjo8m+dCoa+7/C3O2Hqe0zDC+8KG+cRZHZhdzaaWTVTCLDMIY0vfM04Nfh77/G/sEhwpEDbO3t I7TxE8urEVy99fT/AL5gWDLrTB/hnF4XsW0khCu5ln8DmJliT2AXrcNBsU1gj/MH4nMeKwBrPktM28xM @@ -1307,7 +1442,7 @@ Magenta - 90, 42 + 72, 42 Back Image @@ -1330,7 +1465,7 @@ iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8 - YQUAAAAJcEhZcwAAEnQAABJ0Ad5mH3gAAAIFSURBVDhPpZLtS1NhGMbPPxJmmlYSgqHiKzGU1EDxg4iK + YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAIFSURBVDhPpZLtS1NhGMbPPxJmmlYSgqHiKzGU1EDxg4iK YKyG2WBogqMYJQOtCEVRFBGdTBCJfRnkS4VaaWNT5sqx1BUxRXxDHYxAJLvkusEeBaPAB+5z4Jzn+t3X /aLhnEfjo8m+dCoa+7/C3O2Hqe0zDC+8KG+cRZHZhdzaaWTVTCLDMIY0vfM04Nfh77/G/sEhwpEDbO3t I7TxE8urEVy99fT/AL5gWDLrTB/hnF4XsW0khCu5ln8DmJliT2AXrcNBsU1gj/MH4nMeKwBrPktM28xM @@ -1346,7 +1481,7 @@ Magenta - 35, 42 + 30, 42 Th- @@ -1354,7 +1489,7 @@ iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8 - YQUAAAAJcEhZcwAAEnQAABJ0Ad5mH3gAAAIFSURBVDhPpZLtS1NhGMbPPxJmmlYSgqHiKzGU1EDxg4iK + YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAIFSURBVDhPpZLtS1NhGMbPPxJmmlYSgqHiKzGU1EDxg4iK YKyG2WBogqMYJQOtCEVRFBGdTBCJfRnkS4VaaWNT5sqx1BUxRXxDHYxAJLvkusEeBaPAB+5z4Jzn+t3X /aLhnEfjo8m+dCoa+7/C3O2Hqe0zDC+8KG+cRZHZhdzaaWTVTCLDMIY0vfM04Nfh77/G/sEhwpEDbO3t I7TxE8urEVy99fT/AL5gWDLrTB/hnF4XsW0khCu5ln8DmJliT2AXrcNBsU1gj/MH4nMeKwBrPktM28xM @@ -1370,7 +1505,7 @@ Magenta - 39, 42 + 33, 42 Th+ @@ -1393,59 +1528,14 @@ Check Vacuum - - 0, 0 - - - 1060, 45 - - - 101 - - - ToolStrip1 - - - ToolStrip1 - - - System.Windows.Forms.ToolStrip, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 - - - $this - - - 2 - 479, 12 - - 86, 20 - - - Not Started - - - No - - - 200, 18 - - - 38, 20 - - - X Y - - 0, 678 - - - 1, 0, 19, 0 + 0, 550 - 1060, 26 + 795, 22 102 @@ -1463,7 +1553,25 @@ $this - 1 + 2 + + + 67, 17 + + + Not Started + + + No + + + 150, 16 + + + 30, 17 + + + X Y 596, 12 @@ -1472,13 +1580,10 @@ NoControl - 965, 620 - - - 4, 4, 4, 4 + 724, 504 - 80, 62 + 60, 50 22 @@ -1493,7 +1598,7 @@ $this - 3 + 4 0 @@ -1502,13 +1607,10 @@ NoControl - 928, 71 - - - 4, 4, 4, 4 + 696, 58 - 80, 62 + 60, 50 4 @@ -1523,19 +1625,97 @@ $this - 10 + 11 + + + BtnVentosa + + + System.Windows.Forms.Button, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + GBDefAree + + + 0 + + + BtnExpT + + + System.Windows.Forms.Button, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + GBDefAree + + + 1 + + + BtnStone + + + System.Windows.Forms.Button, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + GBDefAree + + + 2 + + + BtnAbortDefAree + + + System.Windows.Forms.Button, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + GBDefAree + + + 3 + + + BtnSaveAree + + + System.Windows.Forms.Button, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + GBDefAree + + + 4 + + + 586, 48 + + + 97, 317 + + + 103 + + + GBDefAree + + + System.Windows.Forms.GroupBox, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + $this + + + 1 NoControl - 24, 137 - - - 4, 4, 4, 4 + 18, 111 - 80, 46 + 60, 37 29 @@ -1559,13 +1739,10 @@ NoControl - 24, 28 - - - 4, 4, 4, 4 + 18, 23 - 80, 46 + 60, 37 28 @@ -1589,13 +1766,10 @@ NoControl - 24, 81 - - - 4, 4, 4, 4 + 18, 66 - 80, 46 + 60, 37 27 @@ -1619,13 +1793,10 @@ NoControl - 21, 247 - - - 4, 4, 4, 4 + 16, 201 - 80, 46 + 60, 37 26 @@ -1714,13 +1885,10 @@ NoControl - 21, 309 - - - 4, 4, 4, 4 + 16, 251 - 80, 62 + 60, 50 25 @@ -1737,44 +1905,17 @@ 4 - - 781, 59 - - - 4, 4, 4, 4 - - - 4, 4, 4, 4 - - - 129, 390 - - - 103 - - - GBDefAree - - - System.Windows.Forms.GroupBox, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 - - - $this - - - 0 - Top, Bottom, Left, Right - 16, 69 + 12, 56 - 5, 5, 5, 5 + 4, 4, 4, 4 - 581, 545 + 436, 443 35 @@ -1789,7 +1930,28 @@ $this - 7 + 8 + + + 449, 5 + + + 121, 21 + + + 104 + + + ComboBoxCamera + + + System.Windows.Forms.ComboBox, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + $this + + + 0 True @@ -1798,13 +1960,10 @@ 25 - 8, 16 + 6, 13 - 1060, 704 - - - 4, 4, 4, 4 + 795, 572 CenterScreen diff --git a/CameraMng/FrmMain.vb b/CameraMng/FrmMain.vb index 55e11ec..814c0ee 100644 --- a/CameraMng/FrmMain.vb +++ b/CameraMng/FrmMain.vb @@ -1,18 +1,15 @@ Option Strict Off Option Explicit On Imports System.IO -Imports System.IO.Path Imports System.Runtime.InteropServices -Imports System.Windows.Forms -Imports System.Drawing Imports Emgu.CV -Imports Emgu.Util Imports System.Text Imports System.Globalization Imports System.Threading Public Class FrmMain - 'Implements Observer + +#Region "FIELDS & PROPERTIES" Private Enum en_status NoImage @@ -39,23 +36,19 @@ Public Class FrmMain Private _borderType As Integer Private WithEvents _search As New clsRicerca(ImageMng) Private Event _waitingCmd() + ' Impiegata per simulare l'input di una stringa di processo + Private varDebug As String = "2" + +#End Region ' Fields & Properties + +#Region "EVENTS" Private Sub BtnTakeFoto_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnTakeFoto.Click - CorrezioneAutomatica = False - EseguiScatto() - - End Sub - Protected Overrides Sub Finalize() - If (Camera.Connected) Then - Camera.Disconnect() - End If - MyBase.Finalize() End Sub Private Sub BtnCfg_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnCfg.Click - 'CfgForm.LbDeviceDescription.Text = Camera.cameraModelFactory CfgForm.LbDeviceStatus.Text = If(Camera.Connected, "Connected", "Disconnected") ' assegnato solo dall'evento connessione, perciò lo ribadisco CfgForm.LbCameraID.Text = Camera.CameraID @@ -67,7 +60,6 @@ Public Class FrmMain End Sub Private Sub BtnLoad_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) - OpenFileDialog1.InitialDirectory = SaveDir OpenFileDialog1.FileName = "" OpenFileDialog1.Filter = "JPEG Format (*.JPG)|*.jpg|BMP Format (*.BMP) |*.bmp" @@ -88,10 +80,8 @@ Public Class FrmMain End Sub Private Sub BtnSave_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnSave.Click - ' recupero l'immagine che avevo già salvato Dim objBmp As New Drawing.Bitmap(SaveDir & "FinalImage.jpg") - Dim NomeFile, NomeFile2, NomeSou As String Dim nf As Integer Dim xyDpi As Single @@ -101,12 +91,10 @@ Public Class FrmMain ' Sistemare !!!! If Len(KeyBoard.Text) > 0 Then - ' nel file jpeg non so se questo settaggio viene salvato NomeFile = SaveDir & KeyBoard.Text & ".jpg" xyDpi = 25.4 * ImageMng.mm2pixelAtZ ' se calibrazione distorsione lente, non serve objBmp.SetResolution(xyDpi, xyDpi) - Try objBmp.Save(NomeFile, System.Drawing.Imaging.ImageFormat.Jpeg) NomeFile2 = SaveDir & "click.txt" @@ -130,134 +118,38 @@ Public Class FrmMain status = en_status.NoImage End Sub - Private Sub SetFormStatus() - - If Camera.Connected Then - BtnTakeFoto.ImageIndex = 0 - TStatus.Text = "CameraID = " & Camera.CameraID - Else - BtnTakeFoto.ImageIndex = 1 - TStatus.Text = "--" - End If - - BtnCfg.Visible = bExtended - BtnCorrProsp.Visible = False 'bExtended - - BtnVentosa.Visible = VacuumCheckEnable - btnSearch.Visible = VacuumCheckEnable - - Select Case status - Case en_status.NoImage - GBCalibration.Visible = False - GBCorrected.Visible = False - GBImgFromCam.Visible = False - BtnLoad.Visible = bBtnLoad - BtnTakeFoto.Visible = True - GBDefAree.Visible = False - - Case en_status.ImageFromCamera - GBCalibration.Visible = False - GBCorrected.Visible = False - GBImgFromCam.Visible = True - BtnLoad.Visible = bBtnLoad - BtnTakeFoto.Visible = True - GBDefAree.Visible = False - - Case en_status.Calibration - GBCalibration.Visible = True - GBCorrected.Visible = False - GBImgFromCam.Visible = False - BtnLoad.Visible = False - BtnTakeFoto.Visible = False - GBDefAree.Visible = False - - Case en_status.ImgCorrected - GBCalibration.Visible = False - GBCorrected.Visible = True - GBImgFromCam.Visible = False - BtnLoad.Visible = bBtnLoad - BtnTakeFoto.Visible = True - GBDefAree.Visible = False - - Case en_status.DefAree - GBCalibration.Visible = False - GBCorrected.Visible = False - GBImgFromCam.Visible = False - BtnLoad.Visible = False - BtnTakeFoto.Visible = False - GBDefAree.Visible = True - BtnExpT.Visible = True - BtnStone.Visible = True - BtnVentosa.Visible = VacuumCheckEnable - BtnSaveAree.Visible = False - BtnExpT.Enabled = _visione.ExpCorrType <> clsVisione.eExpCorrMode.none - BtnAbortDefAree.Text = "Close" - - Case en_status.DefTexp, en_status.DefStone, en_status.DefVentosa - GBCalibration.Visible = False - GBCorrected.Visible = False - GBImgFromCam.Visible = False - BtnLoad.Visible = False - BtnTakeFoto.Visible = False - GBDefAree.Visible = True - BtnExpT.Visible = False - BtnStone.Visible = False - BtnVentosa.Visible = False - BtnSaveAree.Visible = True - BtnExpT.Enabled = _visione.ExpCorrType <> clsVisione.eExpCorrMode.none - BtnAbortDefAree.Text = "Abort" - - End Select - - PosizionaControlli() - End Sub - - Public Sub Inizializza() - ' non visualizzo pagina programma - If Not ModalitaNascosta Then FrmStart.Show() - - Application.DoEvents() - - SpessLastra = 0 - + Private Sub ComboBoxCamera_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ComboBoxCamera.SelectedIndexChanged LeggiFileConfigurazione() - - AggiornaPulsantiVIsibili() - MostraStato() - - If Not ImageMng.SetFileCalibrazione(FileLensCalib, FileCalibProsp) Then - StatoGenerale = statoGenEnum.ErroreCalibrazione - TStatus.Text = "Error in Calibration Files" - End If - - Camera.LbImageStatus = LbImageStatus - - ProgressBar.Minimum = 0 - ProgressBar.Maximum = 100 - ProgressBar.Value = 0 - - SetFormStatus() - ' connessione automatica - Camera.Connect(Camera.CameraID) - 'Me.Text = "ID Camera = " & Camera.CameraID - status = en_status.NoImage - SetFormStatus() - SpessLastra = ImageMng.ZCali - FrmStart.Close() - - 'If Camera.Connected And RichiestaFoto Then - ' Camera.TakeFoto() - ' RichiestaFoto = False - 'End If - - If VacuumCheckEnable Then - TimerMain.Enabled = True - End If - + Camera.Connect(ComboBoxCamera.SelectedIndex.ToString()) End Sub - ' Impiegata per simulare l'input di una stringa di processo - Private varDebug As String = "2" + Private Sub FrmMain_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing + Try + If Camera.Connected Then + Camera.Disconnect() + End If + Catch ex As Exception + End Try + End + End Sub + + Private Sub FrmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load + Dim strWinXP As String = "" + +#If WinXp Then + strWinXP = " (WinXP)" +#End If + + Me.Text = "EgalTech Camera Manager" & strWinXP & " v" & System.Reflection.Assembly.GetExecutingAssembly().GetName().Version.ToString() + BtnLoad.Visible = bExtended + ImageControl1.PanMode = True + Inizializza() + TStatus.Text = "Initialized" + If ModalitaNascosta Then Me.Visible = False + + Dim ThreadCmdProcess As New Thread(AddressOf StartThreadCmdProcess) + ThreadCmdProcess.Start() + End Sub Public Sub WaitingForInstruction() Handles Me._waitingCmd Dim sNewReadLine As String = Console.ReadLine @@ -299,63 +191,10 @@ Public Class FrmMain End Sub Private Sub BtnDelete_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) - 'CancelFile(Camera.PhotoFileName) CancelDir(DirTmp) - - End Sub - - Private Sub FrmMain_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing - Try - If Camera.Connected Then - Camera.Disconnect() - End If - - Catch ex As Exception - - End Try - End - End Sub - - Private Sub FrmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load - - Dim strWinXP As String = "" - -#If WinXp Then - strWinXP = " (WinXP)" -#End If - - Me.Text = "EgalTech Camera Manager" & strWinXP & " v" & System.Reflection.Assembly.GetExecutingAssembly().GetName().Version.ToString() - BtnLoad.Visible = bExtended - ImageControl1.PanMode = True - Inizializza() - TStatus.Text = "Initialized" - If ModalitaNascosta Then Me.Visible = False - - Dim ThreadCmdProcess As New Thread(AddressOf StartThreadCmdProcess) - ThreadCmdProcess.Start() - End Sub - - Private Sub StartThreadCmdProcess() - RaiseEvent _waitingCmd() - End Sub - - Private Sub LeggiExif(ByVal FileName As String) - ' qui potrei vedere se leggo gli exif ... - Try - Dim EW As New ExifWorks(FileName) - LbFocalLenght.Text = EW.FocalLength.ToString("0.0mm") - - LbFocalLenght.Text = EW.Artist - - FocalLength = EW.FocalLength - EW.Dispose() - Catch ex As Exception - End Try - End Sub Private Sub ImageControl1_NewMousePosImage(pima As System.Drawing.PointF) Handles ImageControl1.NewMousePosImage - lbMousePosmm.Text = "px: X" & pima.X.ToString("0.00") & " Y" & pima.Y.ToString("0.00") If ImageMng.Corrected Then @@ -364,66 +203,24 @@ Public Class FrmMain ImageMng.Pix2MMOnUndist(pima, pmm) lbMousePosmm.Text = lbMousePosmm.Text & " mm: X" & pmm.X.ToString("0.00") & " Y" & pmm.Y.ToString("0.00") Catch ex As Exception - End Try End If End Sub + Private Sub ImageControl1_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles ImageControl1.Paint SetFormStatus() End Sub - Private Sub CaliForm2Data() - Dim i As Integer - - For i = 0 To 3 - ImageMng.m_psrc(i).X = ImageControl1.DBoard.GetXCorner(i) - ImageMng.m_psrc(i).Y = ImageControl1.DBoard.GetYCorner(i) - ImageMng.XHpix(i) = ImageControl1.DBoard.GetXHpx(i) - ImageMng.YHpix(i) = ImageControl1.DBoard.GetYHpx(i) - Next - ImageMng.CalcolaDatiCorrezione() - ImageMng.SalvaFileCorrezioneProsp() - End Sub - Private Sub CaliData2Form() - - Dim i As Integer - For i = 0 To 3 - ImageControl1.DBoard.SetPuntoCorner(i, ImageMng.m_psrc(i).X, ImageMng.m_psrc(i).Y) - ImageControl1.DBoard.SetPuntoH(i, ImageMng.XHpix(i), ImageMng.YHpix(i)) - Next - LbAltCali.Text = Format(ImageMng.m_ZCali, "0.00") & " mm" - LbAltRif.Text = Format(ImageMng.m_AltRif, "0.00") & " mm" - End Sub - - ' TODO DA sistemare - Private Sub AreaForm2Data() - Dim i As Integer - - For i = 0 To 3 - ImageMng.m_psrc(i).X = ImageControl1.DBoard.GetXCorner(i) - ImageMng.m_psrc(i).Y = ImageControl1.DBoard.GetYCorner(i) - Next - ' ImageMng.SalvaDatiArea() - End Sub - Private Sub AreaData2Form() - - Dim i As Integer - For i = 0 To 3 - ImageControl1.DBoard.SetPuntoCorner(i, ImageMng.m_psrc(i).X, ImageMng.m_psrc(i).Y) - Next - End Sub - Private Sub BtnCorrCompleta_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnCorrCompleta.Click - frmSce.ShowDialog() Refresh() Me.Cursor = Cursors.WaitCursor CorrezioneCompleta() Me.Cursor = Cursors.Default End Sub + Private Sub BtnCorrLens_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnCorrLens.Click Try - status = en_status.Calibration Me.Cursor = Cursors.WaitCursor SetFormStatus() @@ -442,7 +239,6 @@ Public Class FrmMain Finally Me.Cursor = Cursors.Default End Try - End Sub Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) @@ -475,38 +271,11 @@ Public Class FrmMain Private Sub FrmMain_Resize(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Resize PosizionaControlli() End Sub - Private Sub PosizionaControlli() - ' Posizione di ancoraggio (in alto a sinistra sullo schermo) - Dim x As Integer, y As Integer - Dim Width As Integer, Height As Integer - Dim XGroupBoxes As Integer - x = ImageControl1.Location.X - y = 50 - Width = Me.Size.Width - x - 150 - Height = Me.Size.Height - y - 40 - StatusStrip1.Height - - ImageControl1.SetBounds(x, y, Width, Height) - XGroupBoxes = x + Width + 5 - - BtnTakeFoto.SetBounds(XGroupBoxes + 10, BtnTakeFoto.Location.Y, 60, 50) - BtnEnd.SetBounds(Me.Size.Width - 80, Me.Size.Height - 90 - StatusStrip1.Height, 60, 50) - ' BtnLoad.SetBounds(XGroupBoxes + 10, BtnLoad.Location.Y, 60, 50) - - y = BtnTakeFoto.Location.Y + BtnTakeFoto.Size.Height + 1 - GBImgFromCam.SetBounds(XGroupBoxes, y, 100, 330) - GBCalibration.SetBounds(XGroupBoxes, 30, 100, 370) - GBCorrected.SetBounds(XGroupBoxes, y, 100, 330) - GBDefAree.SetBounds(XGroupBoxes, y, 100, 330) - - 'ProgressBar1.SetBounds(ImageControl1.Location.X, ImageControl1.Location.Y + ImageControl1.Size.Height / 2, ImageControl1.Size.Width, ProgressBar1.Size.Height) - - 'ProgressBar.Width = StatusStrip1.Size.Width - TStatus.Width - - End Sub Private Sub BtnSaveCal_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnSaveCal.Click FineCalibrazione(True) End Sub + Private Sub BtnAbortCal_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnAbortCal.Click FineCalibrazione(False) End Sub @@ -520,21 +289,7 @@ Public Class FrmMain Private Sub BtnZoomPan_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnZoomPan.Click ImageControl1.PanMode = Not ImageControl1.PanMode End Sub - Private Sub FineCalibrazione(ByVal bsalva As Boolean) - If bsalva Then CaliForm2Data() - ImageControl1.DBoard.VisPuntiCorner = False - ImageControl1.DBoard.VisPuntiCaliH = False - If m_Image IsNot Nothing Then - m_Image.Dispose() - m_Image = Nothing - End If - status = en_status.NoImage - ImageControl1.Image = Nothing - ImageControl1.Refresh() - SetFormStatus() - - End Sub Private Sub LbAltCali_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles LbAltCali.Click NumPad.Text = Format(ImageMng.m_ZCali, "0.00") ' la stringa di uscita NumPad.ShowDialog() @@ -555,8 +310,606 @@ Public Class FrmMain End If End Sub - Private Sub LeggiFileConfigurazione() + Private Sub cmdZoomAll_Click(sender As System.Object, e As System.EventArgs) Handles cmdZoomAll.Click + ImageControl1.fittoscreen() + End Sub + Private Sub BtnZom11_Click(sender As System.Object, e As System.EventArgs) Handles BtnZoom11.Click + ImageControl1.ZoomFactor = 1 + End Sub + + Private Sub cmdOpen_Click(sender As System.Object, e As System.EventArgs) Handles BtnLoad.Click + OpenFileDialog1.InitialDirectory = SaveLogDir + OpenFileDialog1.FileName = "" + OpenFileDialog1.Filter = "JPEG Format (*.JPG)|*.jpg|BMP Format (*.BMP) |*.bmp" + OpenFileDialog1.CheckFileExists = True + OpenFileDialog1.ShowDialog() + ImageMng.Corrected = False + ImageControl1.Image = Nothing + GC.Collect() + If Len(OpenFileDialog1.FileName) > 0 Then + ImageMng.ProcessStop() + If Not m_Image Is Nothing Then + m_Image.Dispose() + End If + m_Image = Nothing + m_Image = New Bitmap(OpenFileDialog1.FileName) + ImageControl1.Image = m_Image + ImageControl1.fittoscreen() + LeggiExif(OpenFileDialog1.FileName) + status = en_status.ImageFromCamera + ImageMng.InputImage = m_Image + TStatus.Text = "Image Loaded" + End If + SetFormStatus() + If CorrezioneAutomatica Then + Me.Cursor = Cursors.WaitCursor + CorrezioneCompleta() + Me.Cursor = Cursors.Default + End If + End Sub + + Private Sub ImageMng_AvanzamentoCorrezioneLente(value As Double) Handles ImageMng.AvanzamentoCorrezioneLente + If Me.InvokeRequired Then + Me.Invoke(Sub() ImageMng_AvanzamentoCorrezioneLente(value)) + Return + End If + If (value >= 0 And value <= 100) Then + ProgressBar.Value = value + End If + TStatus.Text = "Image Undistortion..." + End Sub + + Private Sub ImageMng_AvanzamentoCorrezioneProspettiva(value As Double) Handles ImageMng.AvanzamentoCorrezioneProspettiva + If Me.InvokeRequired Then + Me.Invoke(Sub() ImageMng_AvanzamentoCorrezioneProspettiva(value)) + Return + End If + If (value >= 0 And value <= 100) Then + ProgressBar.Value = value + End If + TStatus.Text = "Image Correction..." + End Sub + + Private Sub ImageMng_FineCorrezioneLente() Handles ImageMng.FineCorrezioneLente + If Me.InvokeRequired Then + Me.Invoke(New MethodInvoker(AddressOf ImageMng_FineCorrezioneLente)) + Exit Sub + End If + + ProgressBar.Value = 0 + TStatus.Text = "Image Undistorced" + End Sub + + Private Sub ImageMng_FineCorrezioneProspettiva() Handles ImageMng.FineCorrezioneProspettiva + If Me.InvokeRequired Then + Me.Invoke(New MethodInvoker(AddressOf ImageMng_FineCorrezioneProspettiva)) + Exit Sub + End If + If Not RichiestaBordi And Not VaacumCheckReq Then + ImageMng.SaveClickMsg(0) + End If + + ProgressBar.Value = 0 + + Try + ImageControl1.Image = ImageMng.FinalImage + ImageControl1.fittoscreen() + TStatus.Text = "Image Correction OK" + Catch ex As Exception + TStatus.Text = "Failed showing Image" + End Try + + status = en_status.ImgCorrected + SetFormStatus() + End Sub + + Private Sub Camera_DownloadedCompleted() Handles Camera.DownloadedCompleted + ImageMng.DownloadCompletato() + ImageMng.InputImage = Camera.CameraImage + TStatus.Text = "Image Downloaded" + + Console.WriteLine("DOWNLOAD DA CAMERA COMPLETATO: " & MainModule.IndexProc) + + LeggiExif(Camera.PhotoFileName) + status = en_status.ImageFromCamera + m_Image = Camera.CameraImage + ImageControl1.Image = Camera.CameraImage + ImageControl1.fittoscreen() + SetFormStatus() + + If RichiestaBackGround Then + SalvaNuovoBackGround() + ImageMng.SaveClickMsg(0) + Return + End If + + ' potrei salvare solo se richiesta bordi .. + SalvaImmagineCiclica() + + If VaacumCheckReq Then + VaacumCheckReq = False + If Len(VacFilePos) > 0 Then + ImageMng.CorrezioneCompleta() + _search.GeneraIstruzioniRicerca(VacFilePos, VacMinScore, VacTolmm) + _search.Ricerca() + ImageControl1.Image = _search.FinalImage + End If + TimerMain.Enabled = True + End If + + If RichiestaBordi Then + SetThreshold() + RilevaBordi(m_Image) + Return + End If + + If CorrezioneAutomatica Then + Me.Cursor = Cursors.WaitCursor + CorrezioneCompleta() + Me.Cursor = Cursors.Default + End If + + If RichiestaFoto Then + RichiestaFoto = False + RichiestaClick() + Return + End If + End Sub + + Private Sub ImageMng_ProcessAborted(err As Integer) Handles ImageMng.ProcessAborted + If Me.InvokeRequired Then + Me.Invoke(Sub() ImageMng_ProcessAborted(err)) + Return + End If + + ProgressBar.Value = 0 + TStatus.Text = "Process Aborted" + End Sub + + Private Sub Camera_StatusChanged() Handles Camera.StatusChanged + If Camera.Connected Then + BtnTakeFoto.ImageIndex = 0 + CfgForm.LbCameraID.Text = Camera.CameraID + CfgForm.LbDeviceStatus.Text = "Connected" + Else + BtnTakeFoto.ImageIndex = 1 + CfgForm.LbCameraID.Text = "" + CfgForm.LbDeviceStatus.Text = "Disconnected" + End If + End Sub + + Private Sub BtnBackG_Click(sender As System.Object, e As System.EventArgs) Handles BtnBackG.Click + ScattoBackGround() + End Sub + + Private Sub BtnEdgeFinder_Click(sender As System.Object, e As System.EventArgs) Handles BtnEdgeFinder.Click + _ActTh = 127 + VisualizzaThreshold() + RilevaBordi(m_Image) + End Sub + + Private Sub BtnChangeThreshold_Click(sender As System.Object, e As System.EventArgs) Handles BtnChangeThreshold.Click + _ActTh = _ActTh - 10 + _ActTh = Math.Max(_ActTh, 1) + VisualizzaThreshold() + _visione.ApplicaTreshold(_ActTh) + ImageControl1.Image = _visione.FinalImage + End Sub + + Private Sub BtnIncrTh_Click(sender As System.Object, e As System.EventArgs) Handles BtnIncrTh.Click + Dim tm As New Stopwatch + Dim t1, t2 As Long + + tm.Start() + _ActTh = _ActTh + 10 + _ActTh = Math.Min(_ActTh, 250) + VisualizzaThreshold() + _visione.ApplicaTreshold(_ActTh) + t1 = tm.ElapsedMilliseconds + ImageControl1.Image = _visione.FinalImage + t2 = tm.ElapsedMilliseconds + End Sub + + Private Sub ImageControl1_PointSelected(n As Integer) Handles ImageControl1.PointSelected + lbXmm.Text = ImageMng.m_pworld(n).X.ToString("0.00") + lbYmm.Text = ImageMng.m_pworld(n).Y.ToString("0.00") + _npProspSel = n + End Sub + + Private Sub ImageControl1_PointUnselected() Handles ImageControl1.PointUnselected + lbXmm.Text = "" + lbYmm.Text = "" + _npProspSel = -1 + End Sub + + Private Sub lbXmm_Click(sender As System.Object, e As System.EventArgs) Handles lbXmm.Click + If _npProspSel < 0 Then Return + NumPad.Text = CDbl(lbXmm.Text).ToString("0.00") + NumPad.ShowDialog() + ImageMng.m_pworld(_npProspSel).X = CDbl(NumPad.Text) + lbXmm.Text = ImageMng.m_pworld(_npProspSel).X.ToString("0.00") + End Sub + + Private Sub lbYmm_Click(sender As System.Object, e As System.EventArgs) Handles lbYmm.Click + If _npProspSel < 0 Then Return + NumPad.Text = lbYmm.Text + NumPad.ShowDialog() + ImageMng.m_pworld(_npProspSel).Y = CDbl(NumPad.Text) + lbYmm.Text = ImageMng.m_pworld(_npProspSel).Y.ToString("0.00") + End Sub + + Private Sub ImageControl1_Load(sender As System.Object, e As System.EventArgs) Handles ImageControl1.Load + End Sub + + Private Sub btnSearch_Click(sender As System.Object, e As System.EventArgs) Handles btnSearch.Click + Try + If ImageMng.InputImage Is Nothing Then Return + + If Len(VacFilePos) > 0 Then + ImageMng.CorrezioneCompleta() + _search.GeneraIstruzioniRicerca(VacFilePos, VacMinScore, VacTolmm) + _search.Ricerca() + ImageControl1.Image = _search.FinalImage + ImageControl1.fittoscreen() + End If + Catch ex As Exception + End Try + End Sub + + Private Sub _search_LogMessage(msg As String) Handles _search.LogMessage + MsgBox(msg) + End Sub + + Private Sub TimerMain_Tick(sender As System.Object, e As System.EventArgs) Handles TimerMain.Tick + If Not VacuumCheckEnable Then + TimerMain.Enabled = False + Return + End If + + TimerMain.Enabled = False + + ' Check esistenza file + If (File.Exists(VacFileStart)) Then + Dim ok As Boolean = False + For i As Integer = 1 To 20 + Try + File.Delete(VacFileStart) + ok = True + Catch ex As Exception + Threading.Thread.Sleep(100) + End Try + Next + If Not ok Then + MsgBox("Error on deleting File" & VacFileStart) + Return + End If + VaacumCheckReq = True + RichiestaClick() + Else + TimerMain.Enabled = True + End If + End Sub + + Private Sub BtnDefAree_Click(sender As System.Object, e As System.EventArgs) Handles BtnDefAree.Click + Try + status = en_status.DefAree + Me.Cursor = Cursors.WaitCursor + SetFormStatus() + Refresh() + ImageMng.ProcessStop() + ImageMng.CorrezioneCompleta(False) + ProgressBar.Value = 0 + ImageControl1.Image = ImageMng.FinalImage + ImageControl1.fittoscreen() + GC.Collect() + ImageControl1.Refresh() + Catch ex As Exception + TStatus.Text = "Process Aborted" + Finally + Me.Cursor = Cursors.Default + End Try + End Sub + + Private Sub BtnAbortDefAree_Click(sender As System.Object, e As System.EventArgs) Handles BtnAbortDefAree.Click + Select Case status + Case en_status.DefAree + status = en_status.ImgCorrected + Case en_status.DefTexp, en_status.DefStone, en_status.DefVentosa + status = en_status.DefAree + End Select + + ImageControl1.DBoard.VisAreaGen = False + ImageControl1.Refresh() + SetFormStatus() + End Sub + + Private Sub BtnSaveAree_Click(sender As System.Object, e As System.EventArgs) Handles BtnSaveAree.Click + ' TODO fare i salvataggi opportuni + Dim x1, y1, x2, y2 As Double + ImageControl1.DBoard.GetArea(x1, y1, x2, y2) + + Select Case status + Case en_status.DefTexp + _visione.SetExpRectangle(x1, y1, x2, y2) + Case en_status.DefStone + _visione.SetStoneRectangle(x1, y1, x2, y2) + Case en_status.DefVentosa + Dim NomeFile As String + NumPad.Text = "1" + NumPad.ShowDialog() + If Len(NumPad.Text) > 0 Then + ' nel file jpeg non so se questo settaggio viene salvato + NomeFile = VacDirModels & NumPad.Text & ".png" + ImageMng.SaveModelFromRectangle(NomeFile, x1, y1, x2, y2) + End If + End Select + + status = en_status.DefAree + ImageControl1.DBoard.VisAreaGen = False + ImageControl1.Refresh() + SetFormStatus() + SaveDefAree() + End Sub + + Private Sub BtnExpT_Click(sender As System.Object, e As System.EventArgs) Handles BtnExpT.Click + ' Prendo i valori attuali del rettangolo 0 + Dim x1, y1, x2, y2 As Double + + _visione.GetExpRectangle(x1, y1, x2, y2) + ImageControl1.DBoard.SetArea(x1, y1, x2, y2) + status = en_status.DefTexp + SetFormStatus() + ImageControl1.DBoard.VisAreaGen = True + ImageControl1.Refresh() + End Sub + + Private Sub BtnStone_Click(sender As Object, e As System.EventArgs) Handles BtnStone.Click + ' Prendo i valori attuali del rettangolo 0 + Dim x1, y1, x2, y2 As Double + + _visione.GetStoneRectangle(x1, y1, x2, y2) + ImageControl1.DBoard.SetArea(x1, y1, x2, y2) + status = en_status.DefStone + SetFormStatus() + ImageControl1.DBoard.VisAreaGen = True + ImageControl1.Refresh() + End Sub + + Private Sub BtnVentosa_Click(sender As System.Object, e As System.EventArgs) Handles BtnVentosa.Click + ImageControl1.DBoard.SetArea(1000, 1000, 1800, 1600) + status = en_status.DefVentosa + SetFormStatus() + ImageControl1.DBoard.VisAreaGen = True + ImageControl1.Refresh() + End Sub + +#End Region ' Events + +#Region "METHODS" + + Private Sub SetFormStatus() + If Camera.Connected Then + BtnTakeFoto.ImageIndex = 0 + TStatus.Text = "CameraID = " & Camera.CameraID + Else + BtnTakeFoto.ImageIndex = 1 + TStatus.Text = "--" + End If + + BtnCfg.Visible = bExtended + BtnCorrProsp.Visible = False 'bExtended + BtnVentosa.Visible = VacuumCheckEnable + btnSearch.Visible = VacuumCheckEnable + + Select Case status + Case en_status.NoImage + GBCalibration.Visible = False + GBCorrected.Visible = False + GBImgFromCam.Visible = False + BtnLoad.Visible = bBtnLoad + BtnTakeFoto.Visible = True + GBDefAree.Visible = False + Case en_status.ImageFromCamera + GBCalibration.Visible = False + GBCorrected.Visible = False + GBImgFromCam.Visible = True + BtnLoad.Visible = bBtnLoad + BtnTakeFoto.Visible = True + GBDefAree.Visible = False + Case en_status.Calibration + GBCalibration.Visible = True + GBCorrected.Visible = False + GBImgFromCam.Visible = False + BtnLoad.Visible = False + BtnTakeFoto.Visible = False + GBDefAree.Visible = False + Case en_status.ImgCorrected + GBCalibration.Visible = False + GBCorrected.Visible = True + GBImgFromCam.Visible = False + BtnLoad.Visible = bBtnLoad + BtnTakeFoto.Visible = True + GBDefAree.Visible = False + Case en_status.DefAree + GBCalibration.Visible = False + GBCorrected.Visible = False + GBImgFromCam.Visible = False + BtnLoad.Visible = False + BtnTakeFoto.Visible = False + GBDefAree.Visible = True + BtnExpT.Visible = True + BtnStone.Visible = True + BtnVentosa.Visible = VacuumCheckEnable + BtnSaveAree.Visible = False + BtnExpT.Enabled = _visione.ExpCorrType <> clsVisione.eExpCorrMode.none + BtnAbortDefAree.Text = "Close" + Case en_status.DefTexp, en_status.DefStone, en_status.DefVentosa + GBCalibration.Visible = False + GBCorrected.Visible = False + GBImgFromCam.Visible = False + BtnLoad.Visible = False + BtnTakeFoto.Visible = False + GBDefAree.Visible = True + BtnExpT.Visible = False + BtnStone.Visible = False + BtnVentosa.Visible = False + BtnSaveAree.Visible = True + BtnExpT.Enabled = _visione.ExpCorrType <> clsVisione.eExpCorrMode.none + BtnAbortDefAree.Text = "Abort" + End Select + + PosizionaControlli() + End Sub + + Protected Overrides Sub Finalize() + If Camera.Connected Then + Camera.Disconnect() + End If + MyBase.Finalize() + End Sub + + Public Sub Inizializza() + ' non visualizzo pagina programma + If Not ModalitaNascosta Then FrmStart.Show() + Application.DoEvents() + SpessLastra = 0 + LeggiFileConfigurazione() + AggiornaPulsantiVIsibili() + MostraStato() + + If Not ImageMng.SetFileCalibrazione(FileLensCalib, FileCalibProsp) Then + StatoGenerale = statoGenEnum.ErroreCalibrazione + TStatus.Text = "Error in Calibration Files" + End If + + Camera.LbImageStatus = LbImageStatus + ProgressBar.Minimum = 0 + ProgressBar.Maximum = 100 + ProgressBar.Value = 0 + + SetFormStatus() + ' connessione automatica + Camera.Connect(Camera.CameraID) + ' Recupero il numero di camera + GetCamera() + status = en_status.NoImage + SetFormStatus() + SpessLastra = ImageMng.ZCali + FrmStart.Close() + + If VacuumCheckEnable Then + TimerMain.Enabled = True + End If + End Sub + + Private Sub GetCamera() + If Camera.ConnectedCameras > 0 Then + For i As Integer = 0 To Camera.ConnectedCameras - 1 + ComboBoxCamera.Items.Add("Camera " & i.ToString()) + Next + ComboBoxCamera.SelectedIndex = 0 + Else + ComboBoxCamera.Visible = 0 + End If + End Sub + + Private Sub StartThreadCmdProcess() + RaiseEvent _waitingCmd() + End Sub + + Private Sub LeggiExif(ByVal FileName As String) + ' qui potrei vedere se leggo gli exif ... + Try + Dim EW As New ExifWorks(FileName) + LbFocalLenght.Text = EW.FocalLength.ToString("0.0mm") + LbFocalLenght.Text = EW.Artist + FocalLength = EW.FocalLength + EW.Dispose() + Catch ex As Exception + End Try + End Sub + + Private Sub CaliForm2Data() + Dim i As Integer = 0 + + For i = 0 To 3 + ImageMng.m_psrc(i).X = ImageControl1.DBoard.GetXCorner(i) + ImageMng.m_psrc(i).Y = ImageControl1.DBoard.GetYCorner(i) + ImageMng.XHpix(i) = ImageControl1.DBoard.GetXHpx(i) + ImageMng.YHpix(i) = ImageControl1.DBoard.GetYHpx(i) + Next + ImageMng.CalcolaDatiCorrezione() + ImageMng.SalvaFileCorrezioneProsp() + End Sub + + Private Sub CaliData2Form() + Dim i As Integer = 0 + + For i = 0 To 3 + ImageControl1.DBoard.SetPuntoCorner(i, ImageMng.m_psrc(i).X, ImageMng.m_psrc(i).Y) + ImageControl1.DBoard.SetPuntoH(i, ImageMng.XHpix(i), ImageMng.YHpix(i)) + Next + LbAltCali.Text = Format(ImageMng.m_ZCali, "0.00") & " mm" + LbAltRif.Text = Format(ImageMng.m_AltRif, "0.00") & " mm" + End Sub + + ' TODO DA sistemare + Private Sub AreaForm2Data() + Dim i As Integer = 0 + + For i = 0 To 3 + ImageMng.m_psrc(i).X = ImageControl1.DBoard.GetXCorner(i) + ImageMng.m_psrc(i).Y = ImageControl1.DBoard.GetYCorner(i) + Next + ' ImageMng.SalvaDatiArea() + End Sub + + Private Sub AreaData2Form() + Dim i As Integer = 0 + + For i = 0 To 3 + ImageControl1.DBoard.SetPuntoCorner(i, ImageMng.m_psrc(i).X, ImageMng.m_psrc(i).Y) + Next + End Sub + + Private Sub PosizionaControlli() + ' Posizione di ancoraggio (in alto a sinistra sullo schermo) + Dim x As Integer, y As Integer + Dim Width As Integer, Height As Integer + Dim XGroupBoxes As Integer + + x = ImageControl1.Location.X + y = 50 + Width = Me.Size.Width - x - 150 + Height = Me.Size.Height - y - 40 - StatusStrip1.Height + ImageControl1.SetBounds(x, y, Width, Height) + XGroupBoxes = x + Width + 5 + BtnTakeFoto.SetBounds(XGroupBoxes + 10, BtnTakeFoto.Location.Y, 60, 50) + BtnEnd.SetBounds(Me.Size.Width - 80, Me.Size.Height - 90 - StatusStrip1.Height, 60, 50) + y = BtnTakeFoto.Location.Y + BtnTakeFoto.Size.Height + 1 + GBImgFromCam.SetBounds(XGroupBoxes, y, 100, 330) + GBCalibration.SetBounds(XGroupBoxes, 30, 100, 370) + GBCorrected.SetBounds(XGroupBoxes, y, 100, 330) + GBDefAree.SetBounds(XGroupBoxes, y, 100, 330) + End Sub + + Private Sub FineCalibrazione(ByVal bsalva As Boolean) + If bsalva Then CaliForm2Data() + + ImageControl1.DBoard.VisPuntiCorner = False + ImageControl1.DBoard.VisPuntiCaliH = False + If m_Image IsNot Nothing Then + m_Image.Dispose() + m_Image = Nothing + End If + status = en_status.NoImage + ImageControl1.Image = Nothing + ImageControl1.Refresh() + SetFormStatus() + End Sub + + Private Sub LeggiFileConfigurazione() Console.WriteLine("LETTURA CONFIGURAZIONE '../CameraMng" & MainModule.IndexProc.ToString()) Dim NomeFileCfg, TmpString As String Dim NomeFileIni, DirToReadCfg As String @@ -568,14 +921,11 @@ Public Class FrmMain ' tutto parte dal file DataRoot.ini che deve trovarsi nella stessa ' cartelle dell'eseguibile NomeFileIni = Application.StartupPath & "\DataRoot.ini" - DirToReadCfg = "" - DirToReadCfg = GetIniValue("Data", "DataRoot", NomeFileIni, DirToReadCfg) ' Indirizzo il programma al processo desiderato DirToReadCfg = DirToReadCfg & MainModule.IndexProc.ToString() Debug.Assert(DirToReadCfg <> "") - NomeFileCfg = DirToReadCfg & "\CameraMng.cfg" ' default sovrascritti dalla letture del file cfg @@ -586,20 +936,16 @@ Public Class FrmMain FileCalibProsp = "c:\CameraMng\Calib.txt" FileCalibRes = "c:\CameraMng\CaliRes.bin" SaveLogDir = "" - VacFileStart = "" VacFilePos = "" VacFileEnd = "" VacDirModels = "" - bExtended = False bBtnLoad = False - reader = New StreamReader(NomeFileCfg) nfi.NumberDecimalSeparator = "." - - TmpString = "" + Try While (Not reader.EndOfStream) TmpString = reader.ReadLine() @@ -640,7 +986,6 @@ Public Class FrmMain TmpInt = Convert.ToInt16(Mid(TmpString, 12)) _maxImage = TmpInt ElseIf TmpString.StartsWith("RectCheckExp=") Then - Dim xl, yt, xr, yb As Integer Dim split() As String split = Mid(TmpString, 14).Split(",", 8, StringSplitOptions.RemoveEmptyEntries) @@ -649,14 +994,11 @@ Public Class FrmMain xr = Convert.ToInt32(split(2)) yb = Convert.ToInt32(split(3)) _visione.AddExpRectangle(xl, yt, xr, yb) - ElseIf TmpString.StartsWith("ExpCorrection=") Then TmpInt = Convert.ToInt16(Mid(TmpString, 15)) If TmpInt < 0 Or TmpInt > 4 Then TmpInt = 0 _visione.ExpCorrType = TmpInt - ElseIf TmpString.StartsWith("RectCheckStone=") Then - Dim xl, yt, xr, yb As Integer Dim split() As String split = Mid(TmpString, 16).Split(",", 8, StringSplitOptions.RemoveEmptyEntries) @@ -665,67 +1007,50 @@ Public Class FrmMain xr = Convert.ToInt32(split(2)) yb = Convert.ToInt32(split(3)) _visione.SetStoneRectangle(xl, yt, xr, yb) - - ElseIf TmpString.StartsWith("BlackThFactor=") Then TmpDou = 0 TmpDou = Convert.ToDouble(Mid(TmpString, 15), nfi) If TmpDou > 0 Then _visione.ThFactorNero = TmpDou - - ElseIf TmpString.StartsWith("VacuumCheckEnable=") Then TmpInt = Convert.ToInt16(Mid(TmpString, Len("VacuumCheckEnable=") + 1)) VacuumCheckEnable = TmpInt > 0 - ElseIf TmpString.StartsWith("VacFileStart=") Then VacFileStart = Mid(TmpString, Len("StartVacFile=") + 1) - ElseIf TmpString.StartsWith("VacFilePos=") Then VacFilePos = Mid(TmpString, Len("VacFilePos=") + 1) - ElseIf TmpString.StartsWith("VacFileEnd=") Then VacFileEnd = Mid(TmpString, Len("VacFileEnd=") + 1) - ElseIf TmpString.StartsWith("VacDirModels=") Then VacDirModels = Mid(TmpString, Len("VacDirModels=") + 1) - ElseIf TmpString.StartsWith("VacMinScore=") Then VacMinScore = Convert.ToDouble(Mid(TmpString, Len("VacMinScore=") + 1), nfi) - ElseIf TmpString.StartsWith("VacTolmm=") Then VacTolmm = Convert.ToDouble(Mid(TmpString, Len("VacTolmm=") + 1), nfi) - End If - - End While reader.Close() reader.Dispose() - Catch ex As Exception MsgBox("Error in Cfg File " & TmpString) End Try - ' temoraneo + ' temporaneo #If WinXp Then _visione.SearchMode = CvEnum.RETR_TYPE.CV_RETR_EXTERNAL #Else _visione.SearchMode = CvEnum.RetrType.External #End If - CreateDefaultDirs() - CfgForm.LbFileCali.Text = FileLensCalib CfgForm.LbImageDir.Text = SaveDir CfgForm.LbTempDir.Text = DirTmp Camera.DownloadDir = DirTmp AggiornaNumImage() - End Sub Public Function CancelFile(ByVal inPath As String) As Boolean - Dim ret As Boolean + Dim ret As Boolean = False Try Dim objFile As FileInfo = New FileInfo(inPath) @@ -735,14 +1060,13 @@ Public Class FrmMain Catch e As Exception ret = False 'return false on error End Try - Return ret - End Function - Public Function CreateDefaultDirs() As Boolean - Dim ret As Boolean + Public Function CreateDefaultDirs() As Boolean + Dim ret As Boolean = False Dim objDir As New System.IO.DirectoryInfo(DirTmp) + Try If Not objDir.Exists Then objDir.Create() @@ -750,8 +1074,8 @@ Public Class FrmMain Catch e As Exception ret = False 'return false on error End Try - objDir = Nothing + objDir = Nothing objDir = New System.IO.DirectoryInfo(SaveDir) Try @@ -761,13 +1085,12 @@ Public Class FrmMain Catch e As Exception ret = False 'return false on error End Try - objDir = Nothing + objDir = Nothing ' creo SaveLogDir If SaveLogDir.Length > 0 Then objDir = New System.IO.DirectoryInfo(SaveLogDir) - Try If Not objDir.Exists Then objDir.Create() @@ -776,66 +1099,17 @@ Public Class FrmMain ret = False 'return false on error End Try objDir = Nothing - End If Return ret - End Function - Private Sub cmdZoomAll_Click(sender As System.Object, e As System.EventArgs) Handles cmdZoomAll.Click - ImageControl1.fittoscreen() - End Sub - - Private Sub BtnZom11_Click(sender As System.Object, e As System.EventArgs) Handles BtnZoom11.Click - ImageControl1.ZoomFactor = 1 - End Sub - - Private Sub cmdOpen_Click(sender As System.Object, e As System.EventArgs) Handles BtnLoad.Click - ' OpenFileDialog1.InitialDirectory = SaveDir - OpenFileDialog1.InitialDirectory = SaveLogDir - - OpenFileDialog1.FileName = "" - OpenFileDialog1.Filter = "JPEG Format (*.JPG)|*.jpg|BMP Format (*.BMP) |*.bmp" - OpenFileDialog1.CheckFileExists = True - OpenFileDialog1.ShowDialog() - ImageMng.Corrected = False - ImageControl1.Image = Nothing - GC.Collect() - If Len(OpenFileDialog1.FileName) > 0 Then - ImageMng.ProcessStop() - If Not m_Image Is Nothing Then - m_Image.Dispose() - End If - m_Image = Nothing - m_Image = New Bitmap(OpenFileDialog1.FileName) - ImageControl1.Image = m_Image - ImageControl1.fittoscreen() - LeggiExif(OpenFileDialog1.FileName) - status = en_status.ImageFromCamera - ImageMng.InputImage = m_Image - TStatus.Text = "Image Loaded" - End If - SetFormStatus() - - If CorrezioneAutomatica Then - Me.Cursor = Cursors.WaitCursor - CorrezioneCompleta() - Me.Cursor = Cursors.Default - End If - End Sub - Private Sub CorrezioneCompleta() - 'ImageMng.CorrezioneCompletaAsync() ImageMng.CorrezioneCompleta() TStatus.Text = "Image Correction" End Sub Public Sub RichiestaClick() - - 'If StatoGenerale <> statoGenEnum.StatoOk Then - ' Return - 'End If Console.WriteLine("RICHIESTA CLICK: " & MainModule.IndexProc) If Camera.Connected Then @@ -844,146 +1118,6 @@ Public Class FrmMain TStatus.Text = "Click sent" RichiestaFoto = False End If - 'CorrezioneAutomatica = True - - End Sub - Public Sub SetSpessLastra(spess As Double) - - End Sub - - Private Sub ImageMng_AvanzamentoCorrezioneLente(value As Double) Handles ImageMng.AvanzamentoCorrezioneLente - - If Me.InvokeRequired Then - Me.Invoke(Sub() ImageMng_AvanzamentoCorrezioneLente(value)) - Return - End If - - If (value >= 0 And value <= 100) Then - ProgressBar.Value = value - End If - TStatus.Text = "Image Undistortion..." - - End Sub - - Private Sub ImageMng_AvanzamentoCorrezioneProspettiva(value As Double) Handles ImageMng.AvanzamentoCorrezioneProspettiva - - If Me.InvokeRequired Then - Me.Invoke(Sub() ImageMng_AvanzamentoCorrezioneProspettiva(value)) - Return - End If - - If (value >= 0 And value <= 100) Then - ProgressBar.Value = value - End If - TStatus.Text = "Image Correction..." - - End Sub - - Private Sub ImageMng_FineCorrezioneLente() Handles ImageMng.FineCorrezioneLente - - If Me.InvokeRequired Then - Me.Invoke(New MethodInvoker(AddressOf ImageMng_FineCorrezioneLente)) - Exit Sub - End If - - ProgressBar.Value = 0 - 'ImageControl1.Image = ImageMng.UndistorcedImage - 'ImageControl1.fittoscreen() - TStatus.Text = "Image Undistorced" - - End Sub - - Private Sub ImageMng_FineCorrezioneProspettiva() Handles ImageMng.FineCorrezioneProspettiva - - If Me.InvokeRequired Then - Me.Invoke(New MethodInvoker(AddressOf ImageMng_FineCorrezioneProspettiva)) - Exit Sub - End If - - If Not RichiestaBordi And Not VaacumCheckReq Then - ImageMng.SaveClickMsg(0) - End If - - ProgressBar.Value = 0 - Try - ImageControl1.Image = ImageMng.FinalImage - ImageControl1.fittoscreen() - TStatus.Text = "Image Correction OK" - Catch ex As Exception - TStatus.Text = "Failed showing Image" - End Try - - status = en_status.ImgCorrected - SetFormStatus() - - End Sub - - Private Sub Camera_DownloadedCompleted() Handles Camera.DownloadedCompleted - - ImageMng.DownloadCompletato() - ImageMng.InputImage = Camera.CameraImage - TStatus.Text = "Image Downloaded" - - Console.WriteLine("DOWNLOAD DA CAMERA COMPLETATO: " & MainModule.IndexProc) - - LeggiExif(Camera.PhotoFileName) - status = en_status.ImageFromCamera - m_Image = Camera.CameraImage - ImageControl1.Image = Camera.CameraImage - ImageControl1.fittoscreen() - SetFormStatus() - - If RichiestaBackGround Then - SalvaNuovoBackGround() - ImageMng.SaveClickMsg(0) - Return - End If - - ' potrei salvare solo se richiesta bordi .. - SalvaImmagineCiclica() - - If VaacumCheckReq Then - - VaacumCheckReq = False - If Len(VacFilePos) > 0 Then - ImageMng.CorrezioneCompleta() - _search.GeneraIstruzioniRicerca(VacFilePos, VacMinScore, VacTolmm) - _search.Ricerca() - ImageControl1.Image = _search.FinalImage - End If - TimerMain.Enabled = True - End If - - - If RichiestaBordi Then - SetThreshold() - RilevaBordi(m_Image) - Return - End If - - If CorrezioneAutomatica Then - Me.Cursor = Cursors.WaitCursor - CorrezioneCompleta() - Me.Cursor = Cursors.Default - End If - - If RichiestaFoto Then - RichiestaFoto = False - RichiestaClick() - Return - End If - - End Sub - - Private Sub ImageMng_ProcessAborted(err As Integer) Handles ImageMng.ProcessAborted - If Me.InvokeRequired Then - Me.Invoke(Sub() ImageMng_ProcessAborted(err)) - Return - End If - - ProgressBar.Value = 0 - TStatus.Text = "Process Aborted" - End Sub Public Sub RichiestaStatoCamera() @@ -993,43 +1127,19 @@ Public Class FrmMain Try If Not Camera.Connected Then Camera.Connect(CameraID) - 'Me.Text = "ID Camera = " & Camera.CameraID End If - NomeFile = SaveDir & "click.txt" nf = FreeFile() FileOpen(nf, NomeFile, OpenMode.Output) - If Camera.Connected Then Print(nf, "Err=0") Else Print(nf, "Err=1") End If FileClose(nf) - Catch ex As Exception ' ?? che faccio? - End Try - - End Sub - - Private Sub Camera_StatusChanged() Handles Camera.StatusChanged - If Camera.Connected Then - BtnTakeFoto.ImageIndex = 0 - CfgForm.LbCameraID.Text = Camera.CameraID - CfgForm.LbDeviceStatus.Text = "Connected" - Else - BtnTakeFoto.ImageIndex = 1 - CfgForm.LbCameraID.Text = "" - CfgForm.LbDeviceStatus.Text = "Disconnected" - End If - - - End Sub - - Private Sub BtnBackG_Click(sender As System.Object, e As System.EventArgs) Handles BtnBackG.Click - ScattoBackGround() End Sub Private Sub SalvaNuovoBackGround() @@ -1042,9 +1152,7 @@ Public Class FrmMain RichiestaBackGround = False 'TODO qui sarebbe utile salvare i dati di scatto dell'immagine backSaved = True - Catch ex As Exception - End Try Try @@ -1054,28 +1162,21 @@ Public Class FrmMain Debug.Print("Aperture=" & EW.Aperture.ToString("0.0")) Debug.Print("ISO=" & EW.ISO.ToString) Debug.Print("TimeExp=" & EW.ExposureTime.ToString("0.0")) - EW.Dispose() End If Catch ex As Exception - End Try - End Sub Private Sub RilevaBordi(img As Bitmap) - _visione.BackImageFile = SaveDir & "BackImage.jpg" _visione.Image1 = img - '_visione.TrovaBordi(2) _visione.BorderType = _borderType VisualizzaThreshold() _visione.TrovaBordiMCh(_ActTh) - ImageControl1.Image = _visione.FinalImage - - End Sub + Private Sub MostraStato() If StatoGenerale = statoGenEnum.StatoOk Then Return If ModalitaNascosta Then Return @@ -1087,66 +1188,31 @@ Public Class FrmMain MsgBox("Cfg Error") Case statoGenEnum.ErroreSconosciuto MsgBox("Unknown Error") - End Select - - End Sub - - Private Sub BtnEdgeFinder_Click(sender As System.Object, e As System.EventArgs) Handles BtnEdgeFinder.Click - _ActTh = 127 - VisualizzaThreshold() - RilevaBordi(m_Image) - End Sub - - Private Sub BtnChangeThreshold_Click(sender As System.Object, e As System.EventArgs) Handles BtnChangeThreshold.Click - _ActTh = _ActTh - 10 - _ActTh = Math.Max(_ActTh, 1) - VisualizzaThreshold() - _visione.ApplicaTreshold(_ActTh) - ImageControl1.Image = _visione.FinalImage - End Sub - - Private Sub BtnIncrTh_Click(sender As System.Object, e As System.EventArgs) Handles BtnIncrTh.Click - - Dim tm As New Stopwatch - - Dim t1, t2 As Long - tm.Start() - - _ActTh = _ActTh + 10 - _ActTh = Math.Min(_ActTh, 250) - VisualizzaThreshold() - _visione.ApplicaTreshold(_ActTh) - t1 = tm.ElapsedMilliseconds - ImageControl1.Image = _visione.FinalImage - t2 = tm.ElapsedMilliseconds - End Sub Private Sub EseguiScatto() ' Take Picture If Not Camera.Connected Then Camera.Connect(CameraID) - 'Me.Text = "ID Camera = " & Camera.CameraID End If RichiestaFoto = False - RichiestaClick() - SetFormStatus() - End Sub Public Sub ScattoBackGround() RichiestaBackGround = True EseguiScatto() End Sub + Private Sub SetThreshold() _ActTh = SogliaPercentuale * 2.55 _ActTh = Math.Min(_ActTh, 255) VisualizzaThreshold() End Sub + Public Sub RipetiThreshold() SetThreshold() VisualizzaThreshold() @@ -1155,29 +1221,28 @@ Public Class FrmMain End Sub Private Sub SalvaImmagineCiclica() - If _maxImage <= 0 Then Return If SaveLogDir.Length = 0 Then Return Try AggiornaNumImage() FileCopy(Camera.PhotoFileName, SaveLogDir & "Image" & _numImage.ToString("000") & ".jpg") - 'FileCopy(Camera.PhotoFileName, SaveDir & "BackImage" & Format(Now, "yyMMdd_HHmmss") & ".jpg") - ' RichiestaBackGround = False - Catch ex As Exception - End Try - - End Sub - Private Sub AggiornaNumImage() + Private Sub AggiornaNumImage() + Dim NomiFiles() As String + ' devo capire dove ero arrivato + NomiFiles = Directory.GetFiles(SaveLogDir, "Image???.jpg") + Dim i As Integer + Dim maxDateIndex As Integer = -1 + Dim ActualDate, MaxDate As Date + Dim ActualNumber, MaxNumber As Integer If _maxImage <= 0 Then Return If SaveLogDir.Length = 0 Then Return - If _numImage >= 0 Then _numImage = _numImage + 1 If _numImage > _maxImage Then @@ -1186,14 +1251,6 @@ Public Class FrmMain Return End If - Dim NomiFiles() As String - ' devo capire dove ero arrivato - NomiFiles = Directory.GetFiles(SaveLogDir, "Image???.jpg") - Dim i As Integer - Dim maxDateIndex As Integer = -1 - Dim ActualDate, MaxDate As Date - Dim ActualNumber, MaxNumber As Integer - If NomiFiles.Length = 0 Then _numImage = 0 Return @@ -1220,8 +1277,8 @@ Public Class FrmMain ElseIf maxDateIndex > -1 Then _numImage = CInt(NomiFiles(maxDateIndex).Substring(NomiFiles(maxDateIndex).Length - 7, 3)) + 1 End If - End Sub + Public Sub SetSearchMode(smode As Integer) If smode >= 0 AndAlso smode <= 3 Then _visione.SearchMode = smode @@ -1247,7 +1304,6 @@ Public Class FrmMain End If End Function - Public Sub SetDefaultCamera(Optional resetID As Boolean = False) Dim NomeFileCfg, TmpString As String Dim NomeFileTempCfg, DirToReadCfg As String @@ -1256,18 +1312,8 @@ Public Class FrmMain Dim nf As Integer Dim writer As StreamWriter - - - - '#If DEBUG Then - ' NomeFileIni = "c:\CameraMng\DataRoot.ini" - ' DefaultNomeFileCfg = "c:\CameraMng\CameraMng.Cfg" - ' 'DirExe = "c:\CameraMng" - '#Else NomeFileIni = Application.StartupPath & "\DataRoot.ini" DirToReadCfg = Application.StartupPath - 'DirExe = Application.StartupPath - '#End If Try DirToReadCfg = GetIniValue("Data", "DataRoot", NomeFileIni, DirToReadCfg) @@ -1276,30 +1322,31 @@ Public Class FrmMain NomeFileCfg = DirToReadCfg & "\CameraMng.cfg" NomeFileTempCfg = DirToReadCfg & "\CameraMngTmp.cfg" SaveFileCfg = DirToReadCfg & "\CameraMng" & Format(Now, "yyyyMMddhhmmss") & ".cfg" + If (File.Exists(NomeFileTempCfg)) Then File.Delete(NomeFileTempCfg) End If - nf = FreeFile() FileOpen(nf, NomeFileCfg, OpenMode.Input) writer = New StreamWriter(NomeFileTempCfg) - TmpString = "" + While Not EOF(nf) TmpString = LineInput(nf) If Not TmpString.StartsWith("CameraID=") Then writer.WriteLine(TmpString, CultureInfo.InvariantCulture) End If End While + If Not resetID Then writer.WriteLine("CameraID=" & Camera.CameraID, CultureInfo.InvariantCulture) End If + FileClose(nf) writer.Close() - - File.Copy(NomeFileCfg, SaveFileCfg) + If (File.Exists(NomeFileCfg)) Then File.Delete(NomeFileCfg) End If @@ -1316,12 +1363,11 @@ Public Class FrmMain MsgBox("New ID written on cfg") CfgForm.LbCfgCameraID.Text = Camera.CameraID End If - Catch ex As Exception MsgBox("Error in Writing Cfg File " & ex.Message) End Try - End Sub + Private Sub AggiornaPulsantiVIsibili() BtnCfg.Visible = bExtended BtnCorrProsp.Visible = False 'bExtended @@ -1331,320 +1377,87 @@ Public Class FrmMain BtnIncrTh.Visible = bEnableBorder End Sub - Private Sub ImageControl1_PointSelected(n As Integer) Handles ImageControl1.PointSelected - - lbXmm.Text = ImageMng.m_pworld(n).X.ToString("0.00") - lbYmm.Text = ImageMng.m_pworld(n).Y.ToString("0.00") - _npProspSel = n - 'lbXmm.Text = (n + 1).ToString - End Sub - - Private Sub ImageControl1_PointUnselected() Handles ImageControl1.PointUnselected - lbXmm.Text = "" - lbYmm.Text = "" - _npProspSel = -1 - End Sub - - Private Sub lbXmm_Click(sender As System.Object, e As System.EventArgs) Handles lbXmm.Click - If _npProspSel < 0 Then Return - NumPad.Text = CDbl(lbXmm.Text).ToString("0.00") - NumPad.ShowDialog() - ImageMng.m_pworld(_npProspSel).X = CDbl(NumPad.Text) - lbXmm.Text = ImageMng.m_pworld(_npProspSel).X.ToString("0.00") - End Sub - - Private Sub lbYmm_Click(sender As System.Object, e As System.EventArgs) Handles lbYmm.Click - If _npProspSel < 0 Then Return - NumPad.Text = lbYmm.Text - NumPad.ShowDialog() - ImageMng.m_pworld(_npProspSel).Y = CDbl(NumPad.Text) - lbYmm.Text = ImageMng.m_pworld(_npProspSel).Y.ToString("0.00") - End Sub - - Private Sub ImageControl1_Load(sender As System.Object, e As System.EventArgs) Handles ImageControl1.Load - - End Sub - - Private Sub btnSearch_Click(sender As System.Object, e As System.EventArgs) Handles btnSearch.Click - - Try - If ImageMng.InputImage Is Nothing Then Return - - If Len(VacFilePos) > 0 Then - ImageMng.CorrezioneCompleta() - _search.GeneraIstruzioniRicerca(VacFilePos, VacMinScore, VacTolmm) - _search.Ricerca() - ImageControl1.Image = _search.FinalImage - ImageControl1.fittoscreen() - End If - - Catch ex As Exception - - End Try - - End Sub - - Private Sub _search_LogMessage(msg As String) Handles _search.LogMessage - MsgBox(msg) - End Sub - - Private Sub TimerMain_Tick(sender As System.Object, e As System.EventArgs) Handles TimerMain.Tick - - If Not VacuumCheckEnable Then - TimerMain.Enabled = False - Return - End If - - TimerMain.Enabled = False - - ' Check esistenza file - If (File.Exists(VacFileStart)) Then - Dim ok As Boolean = False - For i As Integer = 1 To 20 - Try - File.Delete(VacFileStart) - ok = True - Catch ex As Exception - Threading.Thread.Sleep(100) - End Try - Next - If Not ok Then - MsgBox("Error on deleting File" & VacFileStart) - Return - End If - - VaacumCheckReq = True - RichiestaClick() - Else - TimerMain.Enabled = True - End If - - - End Sub - - Private Sub BtnDefAree_Click(sender As System.Object, e As System.EventArgs) Handles BtnDefAree.Click - Try - - status = en_status.DefAree - Me.Cursor = Cursors.WaitCursor - SetFormStatus() - Refresh() - - ImageMng.ProcessStop() - ImageMng.CorrezioneCompleta(False) - - ProgressBar.Value = 0 - ImageControl1.Image = ImageMng.FinalImage - ImageControl1.fittoscreen() - GC.Collect() - ImageControl1.Refresh() - Catch ex As Exception - TStatus.Text = "Process Aborted" - Finally - Me.Cursor = Cursors.Default - End Try - - End Sub - - - - Private Sub BtnAbortDefAree_Click(sender As System.Object, e As System.EventArgs) Handles BtnAbortDefAree.Click - - Select Case status - - Case en_status.DefAree - status = en_status.ImgCorrected - Case en_status.DefTexp, en_status.DefStone, en_status.DefVentosa - status = en_status.DefAree - End Select - - ImageControl1.DBoard.VisAreaGen = False - ImageControl1.Refresh() - SetFormStatus() - End Sub - - Private Sub BtnSaveAree_Click(sender As System.Object, e As System.EventArgs) Handles BtnSaveAree.Click - - ' TODO fare i salvataggi opportuni - Dim x1, y1, x2, y2 As Double - ImageControl1.DBoard.GetArea(x1, y1, x2, y2) - - Select Case status - - Case en_status.DefTexp - _visione.SetExpRectangle(x1, y1, x2, y2) - Case en_status.DefStone - _visione.SetStoneRectangle(x1, y1, x2, y2) - - Case en_status.DefVentosa - - Dim NomeFile As String - - NumPad.Text = "1" - NumPad.ShowDialog() - - If Len(NumPad.Text) > 0 Then - ' nel file jpeg non so se questo settaggio viene salvato - NomeFile = VacDirModels & NumPad.Text & ".png" - ImageMng.SaveModelFromRectangle(NomeFile, x1, y1, x2, y2) - End If - - End Select - - status = en_status.DefAree - ImageControl1.DBoard.VisAreaGen = False - ImageControl1.Refresh() - SetFormStatus() - SaveDefAree() - - End Sub - - Private Sub BtnExpT_Click(sender As System.Object, e As System.EventArgs) Handles BtnExpT.Click - ' Prendo i valori attuali del rettangolo 0 - Dim x1, y1, x2, y2 As Double - - _visione.GetExpRectangle(x1, y1, x2, y2) - ImageControl1.DBoard.SetArea(x1, y1, x2, y2) - status = en_status.DefTexp - SetFormStatus() - ImageControl1.DBoard.VisAreaGen = True - ImageControl1.Refresh() - - End Sub - - Private Sub BtnStone_Click(sender As Object, e As System.EventArgs) Handles BtnStone.Click - - ' Prendo i valori attuali del rettangolo 0 - Dim x1, y1, x2, y2 As Double - - _visione.GetStoneRectangle(x1, y1, x2, y2) - ImageControl1.DBoard.SetArea(x1, y1, x2, y2) - status = en_status.DefStone - SetFormStatus() - ImageControl1.DBoard.VisAreaGen = True - ImageControl1.Refresh() - - End Sub - ' salva l'area in cui si verifica l'esposizione Private Sub SaveDefAree() - Dim NomeFileCfg, TmpString As String Dim NomeFileTempCfg, DirToReadCfg As String Dim SaveFileCfg As String Dim NomeFileIni As String Dim nf As Integer Dim writer As StreamWriter - - '#If DEBUG Then - ' NomeFileIni = "c:\CameraMng\DataRoot.ini" - ' DefaultNomeFileCfg = "c:\CameraMng\CameraMng.Cfg" - ' DirExe = "c:\CameraMng" - '#Else - NomeFileIni = Application.StartupPath & "\DataRoot.ini" - DirToReadCfg = Application.StartupPath - 'DirExe = Application.StartupPath - '#End If - - Dim ExpEnableSet As Boolean = False Dim AreaExpSet As Boolean = False Dim AreaStoneSet As Boolean = False Dim x1, y1, x2, y2 As Integer - + NomeFileIni = Application.StartupPath & "\DataRoot.ini" + DirToReadCfg = Application.StartupPath Try DirToReadCfg = GetIniValue("Data", "DataRoot", NomeFileIni, DirToReadCfg) + ' aggiungiamo indici processo corrente + DirToReadCfg = DirToReadCfg & MainModule.IndexProc.ToString() NomeFileCfg = DirToReadCfg & "\CameraMng.cfg" NomeFileTempCfg = DirToReadCfg & "\CameraMngTmp.cfg" SaveFileCfg = DirToReadCfg & "\CameraMng" & Format(Now, "yyyyMMddhhmmss") & ".cfg" + If (File.Exists(NomeFileTempCfg)) Then File.Delete(NomeFileTempCfg) End If - nf = FreeFile() FileOpen(nf, NomeFileCfg, OpenMode.Input) writer = New StreamWriter(NomeFileTempCfg) - TmpString = "" + While Not EOF(nf) TmpString = LineInput(nf) - If TmpString.StartsWith("RectCheckExp=") AndAlso _visione.ExpCorrType <> clsVisione.eExpCorrMode.none Then _visione.GetExpRectangle(x1, y1, x2, y2) - writer.WriteLine("RectCheckExp={0},{1},{2},{3}", x1.ToString, y1.ToString, x2.ToString, y2.ToString, - CultureInfo.InvariantCulture) + writer.WriteLine("RectCheckExp={0},{1},{2},{3}", x1.ToString, y1.ToString, x2.ToString, y2.ToString, CultureInfo.InvariantCulture) AreaExpSet = True ElseIf TmpString.StartsWith("RectCheckStone=") Then _visione.GetStoneRectangle(x1, y1, x2, y2) - writer.WriteLine("RectCheckStone={0},{1},{2},{3}", x1.ToString, y1.ToString, x2.ToString, y2.ToString, - CultureInfo.InvariantCulture) + writer.WriteLine("RectCheckStone={0},{1},{2},{3}", x1.ToString, y1.ToString, x2.ToString, y2.ToString, CultureInfo.InvariantCulture) AreaStoneSet = True Else writer.WriteLine(TmpString, CultureInfo.InvariantCulture) End If - - End While - 'If Not ExpEnableSet Then - ' writer.WriteLine("ExpCorrection=1") - 'End If - If Not AreaExpSet AndAlso _visione.ExpCorrType <> clsVisione.eExpCorrMode.none Then _visione.GetExpRectangle(x1, y1, x2, y2) - writer.WriteLine("RectCheckExp={0},{1},{2},{3}", x1.ToString, y1.ToString, x2.ToString, y2.ToString, - CultureInfo.InvariantCulture) + writer.WriteLine("RectCheckExp={0},{1},{2},{3}", x1.ToString, y1.ToString, x2.ToString, y2.ToString, CultureInfo.InvariantCulture) End If If Not AreaStoneSet Then _visione.GetStoneRectangle(x1, y1, x2, y2) - writer.WriteLine("RectCheckStone={0},{1},{2},{3}", x1.ToString, y1.ToString, x2.ToString, y2.ToString, - CultureInfo.InvariantCulture) + writer.WriteLine("RectCheckStone={0},{1},{2},{3}", x1.ToString, y1.ToString, x2.ToString, y2.ToString, CultureInfo.InvariantCulture) End If - FileClose(nf) writer.Close() - - File.Copy(NomeFileCfg, SaveFileCfg) + If (File.Exists(NomeFileCfg)) Then File.Delete(NomeFileCfg) End If File.Copy(NomeFileTempCfg, NomeFileCfg) File.Delete(NomeFileTempCfg) - - Catch ex As Exception MsgBox("Error in Writing Cfg File " & ex.Message) End Try - End Sub - Private Sub BtnVentosa_Click(sender As System.Object, e As System.EventArgs) Handles BtnVentosa.Click - - ImageControl1.DBoard.SetArea(1000, 1000, 1800, 1600) - status = en_status.DefVentosa - SetFormStatus() - ImageControl1.DBoard.VisAreaGen = True - ImageControl1.Refresh() - - End Sub Private Sub VisualizzaThreshold() Dim thPerc As Double = (CDbl(_ActTh) / 255) * 100 lbThreshold.Text = _ActTh.ToString & " (" & thPerc.ToString("0.0") & "%)" End Sub - Private Sub TestRaddrizzamento() Dim _bmp As Bitmap = New Bitmap("c:\Temp\Test.jpg") - - Dim cameraMatrix As New Matrix(Of Double)(3, 3) '[fx 0 cx; 0 fy cy; 0 0 1] cameraMatrix.Data(0, 0) = _bmp.Width / 2 @@ -1664,33 +1477,6 @@ Public Class FrmMain distCoeffs.Data(0, 2) = 0.00075256 distCoeffs.Data(0, 3) = -0.000269617 - ' rms = 2.729067 - ' fx = 4609.251961 - ' fy = 4609.251961 - ' cx = 3076.747294 - ' cy = 2073.815575 - ' k1 = -0.160129 - ' k2 = 0.167262 - ' p1 = -0.00901 - ' p2 = -0.000612 - - ' hfov = 67.4Deg - 'vfov = 48.4Deg - - - 'rms = 2.912043 - 'fx = 4775.944905 - 'fy = 4775.944905 - 'cx = 3103.561924 - 'cy = 2033.648165 - 'k1 = -0.153547 - 'k2 = 0.127935 - 'p1 = -0.00626 - 'p2 = -0.000005 - - 'hfov = 66Deg - 'vfov = 46.1Deg - '[fx 0 cx; 0 fy cy; 0 0 1] cameraMatrix.Data(0, 0) = 4775.944905 cameraMatrix.Data(0, 1) = 0 @@ -1709,14 +1495,14 @@ Public Class FrmMain distCoeffs.Data(0, 3) = -0.000005 Dim outFrame As New Image(Of Emgu.CV.Structure.Rgb, Byte)(_bmp.Width, _bmp.Height) - Dim newIntrinsecMatrix As IInputArray + Dim newIntrinsecMatrix As IInputArray = Nothing + CvInvoke.Undistort(New Image(Of Emgu.CV.Structure.Rgb, Byte)(_bmp), outFrame, cameraMatrix, distCoeffs, newIntrinsecMatrix) _bmp = outFrame.Bitmap - _bmp.Save("c:\temp\Testu.png", System.Drawing.Imaging.ImageFormat.Png) - - End Sub +#End Region ' Methods + End Class diff --git a/CameraMng/FrmStart.vb b/CameraMng/FrmStart.vb index c230181..2e697ac 100644 --- a/CameraMng/FrmStart.vb +++ b/CameraMng/FrmStart.vb @@ -1,8 +1,3 @@ -Imports System.IO -Imports System.IO.Path -Imports System.Drawing -Imports System.Windows.Forms - Public Class FrmStart End Class \ No newline at end of file diff --git a/CameraMng/ImageCtrl/DrawingBoard.vb b/CameraMng/ImageCtrl/DrawingBoard.vb index 9c791f8..3c4e5f1 100644 --- a/CameraMng/ImageCtrl/DrawingBoard.vb +++ b/CameraMng/ImageCtrl/DrawingBoard.vb @@ -1,80 +1,52 @@ Imports System.Drawing.Imaging Imports System.Drawing.Font - _ + Public Class DrawingBoard - 'Public Events - Public Event SetScrollPositions() - Public Event PointSelected(n As Integer) - Public Event PointUnselected() +#Region "FIELDS & PROPERTIES" - 'Member Variables - Private m_PanButton As System.Windows.Forms.MouseButtons = Windows.Forms.MouseButtons.Middle - Private m_EditButton As System.Windows.Forms.MouseButtons = Windows.Forms.MouseButtons.Left - Private m_OriginalImage As System.Drawing.Bitmap - - Private m_StartPoint As System.Drawing.Point - - Private m_Origin As New System.Drawing.Point(0, 0) - - Private SrcRect As System.Drawing.Rectangle - Private DestRect As System.Drawing.Rectangle - - Private m_ZoomOnMouseWheel As Boolean = True - Private m_ZoomFactor As Double = 1.0 - - Private m_ApparentImageSize As New Size(0, 0) - - Private m_DrawWidth As Integer - Private m_DrawHeight As Integer - - Private m_centerpoint As Point - - Private m_PanMode As Boolean = True - Private m_StretchImageToFit As Boolean = False - - Private m_Select_Rect As Rectangle - Private m_Select_Pen As New Pen(Color.Blue, 2) ' Pen used to indicate a selection on the image (zoom window) - - Private EndPoint As Point ' for pan and box-zoom - - ' 4 punti di precalibrazione - Private m_pCaliCorner() As System.Drawing.Point - Private m_pCaliCornerH() As System.Drawing.Point - - ' per la calibrazione delle altezze - ' per ora lo tengo - Private m_nPuntiCaliH As Integer - Private m_pCaliH() As System.Drawing.Point - - Private m_bVisPuntiCaliH As Boolean - Private m_bVisPuntiCorner As Boolean - - Private m_bPointSelected As Integer - Private m_isel As Integer, m_jsel As Integer - Private m_bCkRow As Boolean, m_bCkCol As Boolean - Private m_MouseEnabled As Boolean - - Private Const std_radius As Integer = 40 - Private Const small_radius As Integer = 30 - Private Const dA_radius As Integer = 20 'Private m_MousePosImg As PointF Private Enum ptype PuntoCorner PuntoCaliH PuntoArea ' area generica End Enum - Private m_ptypesel As ptype + 'Public Events + Public Event SetScrollPositions() + Public Event PointSelected(n As Integer) + Public Event PointUnselected() Event NewMousePosImage(pm As PointF) + 'Member Variables + Private m_EditButton As System.Windows.Forms.MouseButtons = Windows.Forms.MouseButtons.Left + Private m_StartPoint As System.Drawing.Point + Private SrcRect As System.Drawing.Rectangle + Private DestRect As System.Drawing.Rectangle + Private m_DrawWidth As Integer + Private m_DrawHeight As Integer + Private m_centerpoint As Point + Private m_Select_Pen As New Pen(Color.Blue, 2) ' Pen used to indicate a selection on the image (zoom window) + Private EndPoint As Point ' for pan and box-zoom + ' 4 punti di precalibrazione + Private m_pCaliCorner() As System.Drawing.Point + Private m_pCaliCornerH() As System.Drawing.Point + ' per la calibrazione delle altezze + ' per ora lo tengo + Private m_nPuntiCaliH As Integer + Private m_pCaliH() As System.Drawing.Point + Private m_bPointSelected As Integer + Private m_isel As Integer, m_jsel As Integer + Private Const std_radius As Integer = 40 + Private Const small_radius As Integer = 30 + Private Const dA_radius As Integer = 20 + Private m_ptypesel As ptype ' gestione aree lastra (checkEsposizione, CheckStone, Def Ventosa) ' uso un'area generica rettangolare - Private m_bVisAreaGen As Boolean Private m_pArea(3) As System.Drawing.Point - -#Region "Public/Private Shadows" + + Private m_OriginalImage As System.Drawing.Bitmap Public Shadows Property Image() As System.Drawing.Image Get Return m_OriginalImage @@ -86,7 +58,6 @@ Public Class DrawingBoard m_ApparentImageSize = New Size(0, 0) m_ZoomFactor = 1 GC.Collect() - 'GC.GetTotalMemory(True) End If If Value Is Nothing Then @@ -96,10 +67,6 @@ Public Class DrawingBoard End If GC.Collect() - - 'Dim totalmem As Long = GC.GetTotalMemory(False) - - 'Dim r As New Rectangle(0, 0, Value.Width, Value.Height) m_OriginalImage = Value Me.Invalidate() End Set @@ -125,8 +92,7 @@ Public Class DrawingBoard End Set End Property -#End Region - + Private m_bVisPuntiCorner As Boolean Public Property VisPuntiCorner() As Boolean Get Return m_bVisPuntiCorner @@ -135,6 +101,8 @@ Public Class DrawingBoard m_bVisPuntiCorner = value End Set End Property + + Private m_bVisPuntiCaliH As Boolean Public Property VisPuntiCaliH() As Boolean Get Return m_bVisPuntiCaliH @@ -143,16 +111,22 @@ Public Class DrawingBoard m_bVisPuntiCaliH = value End Set End Property + + Private m_bCkRow As Boolean Public WriteOnly Property CkRow() As Boolean Set(ByVal value As Boolean) m_bCkRow = value End Set End Property + + Private m_bCkCol As Boolean Public WriteOnly Property CkCol() As Boolean Set(ByVal value As Boolean) m_bCkCol = value End Set End Property + + Private m_MouseEnabled As Boolean Public Property MouseEnaBled() As Boolean Get Return m_MouseEnabled @@ -164,6 +138,8 @@ Public Class DrawingBoard End If End Set End Property + + Private m_bVisAreaGen As Boolean Public Property VisAreaGen() As Boolean Get Return m_bVisAreaGen @@ -173,9 +149,114 @@ Public Class DrawingBoard End Set End Property + Private m_PanButton As System.Windows.Forms.MouseButtons = Windows.Forms.MouseButtons.Middle + Public Property PanButton() As System.Windows.Forms.MouseButtons + Get + Return m_PanButton + End Get + Set(ByVal value As System.Windows.Forms.MouseButtons) + m_PanButton = value + End Set + End Property + Private m_ZoomOnMouseWheel As Boolean = True + Public Property ZoomOnMouseWheel() As Boolean + Get + Return m_ZoomOnMouseWheel + End Get + Set(ByVal value As Boolean) + m_ZoomOnMouseWheel = value + End Set + End Property -#Region "Protected Overrides" + Private m_ZoomFactor As Double = 1.0 + Public Property ZoomFactor() As Double + Get + Return m_ZoomFactor + End Get + Set(ByVal value As Double) + m_ZoomFactor = value + If m_ZoomFactor > 15 Then m_ZoomFactor = 15 + If m_ZoomFactor < 0.05 Then m_ZoomFactor = 0.05 + If Not m_OriginalImage Is Nothing Then + m_ApparentImageSize.Height = m_OriginalImage.Height * m_ZoomFactor + m_ApparentImageSize.Width = m_OriginalImage.Width * m_ZoomFactor + ComputeDrawingArea() + CheckBounds() + End If + Me.Invalidate() + End Set + End Property + + Private m_Origin As New System.Drawing.Point(0, 0) + Public Property Origin() As System.Drawing.Point + Get + Return m_Origin + End Get + Set(ByVal value As System.Drawing.Point) + m_Origin = value + Me.Invalidate() + End Set + End Property + + Private m_ApparentImageSize As New Size(0, 0) + Public ReadOnly Property ApparentImageSize() As System.Drawing.Size + Get + Return m_ApparentImageSize + End Get + End Property + + Private m_PanMode As Boolean = True + Public Property PanMode() As Boolean + Get + Return m_PanMode + End Get + Set(ByVal value As Boolean) + m_PanMode = value + End Set + End Property + + Private m_StretchImageToFit As Boolean = False + Public Property StretchImageToFit() As Boolean + Get + Return m_StretchImageToFit + End Get + Set(ByVal value As Boolean) + m_StretchImageToFit = value + Me.Invalidate() + End Set + End Property + + Private m_Select_Rect As Rectangle + Private Property Selected_Rectangle() As Rectangle + Get + Return m_Select_Rect + End Get + Set(ByVal Value As Rectangle) + m_Select_Rect = Value + Me.Invalidate() + End Set + End Property + +#End Region ' Fields & Properties + +#Region "CONSTRUCTOR" + + Public Sub New() + ' This call is required by the Windows Form Designer. + InitializeComponent() + + ' Add any initialization after the InitializeComponent() call. + Me.SetStyle(ControlStyles.AllPaintingInWmPaint, True) + Me.SetStyle(ControlStyles.DoubleBuffer, True) + ReDim m_pCaliH(4) + ReDim m_pCaliCorner(4) + ReDim m_pCaliCornerH(4) + End Sub + +#End Region ' Constructor + +#Region "METHODS" Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs) e.Graphics.Clear(Me.BackColor) @@ -189,10 +270,6 @@ Public Class DrawingBoard MyBase.OnSizeChanged(e) End Sub -#End Region - -#Region "Public Properties" - Public Sub ZoomIn() ZoomImage(True) End Sub @@ -219,12 +296,11 @@ Public Class DrawingBoard CheckBounds() End Sub - Private Sub ZoomImage(ByVal ZoomIn As Boolean, origin As Point) + Private Sub ZoomImage(ByVal ZoomIn As Boolean, origin As Point) ZoomImage(ZoomIn) Return - ' tentativo di zoommare sul punto del mouse ' Get center point m_centerpoint.X = m_Origin.X + SrcRect.Width / 2 @@ -251,20 +327,12 @@ Public Class DrawingBoard Cursor = Cursors.WaitCursor If m_OriginalImage Is Nothing Then Exit Sub ' This is the color matrix to invert the image colors. - Dim cm As ColorMatrix = New ColorMatrix(New Single()() _ - {New Single() {-1, 0, 0, 0, 0}, _ - New Single() {0, -1, 0, 0, 0}, _ - New Single() {0, 0, -1, 0, 0}, _ - New Single() {0, 0, 0, 1, 0}, _ - New Single() {1, 1, 1, 1, 1}}) - + Dim cm As ColorMatrix = New ColorMatrix(New Single()() {New Single() {-1, 0, 0, 0, 0}, New Single() {0, -1, 0, 0, 0}, New Single() {0, 0, -1, 0, 0}, New Single() {0, 0, 0, 1, 0}, New Single() {1, 1, 1, 1, 1}}) Dim ImageAttributes As New ImageAttributes() - ImageAttributes.SetColorMatrix(cm) - - Dim g As Graphics - g = Graphics.FromImage(m_OriginalImage) - + Dim g As Graphics = Graphics.FromImage(m_OriginalImage) Dim rc As New Rectangle(0, 0, m_OriginalImage.Width, m_OriginalImage.Height) + + ImageAttributes.SetColorMatrix(cm) g.DrawImage(m_OriginalImage, rc, 0, 0, m_OriginalImage.Width, m_OriginalImage.Height, GraphicsUnit.Pixel, ImageAttributes) Me.Invalidate() @@ -275,77 +343,6 @@ Public Class DrawingBoard End Try End Sub - Public Property PanButton() As System.Windows.Forms.MouseButtons - Get - Return m_PanButton - End Get - Set(ByVal value As System.Windows.Forms.MouseButtons) - m_PanButton = value - End Set - End Property - - Public Property ZoomOnMouseWheel() As Boolean - Get - Return m_ZoomOnMouseWheel - End Get - Set(ByVal value As Boolean) - m_ZoomOnMouseWheel = value - End Set - End Property - - Public Property ZoomFactor() As Double - Get - Return m_ZoomFactor - End Get - Set(ByVal value As Double) - m_ZoomFactor = value - If m_ZoomFactor > 15 Then m_ZoomFactor = 15 - If m_ZoomFactor < 0.05 Then m_ZoomFactor = 0.05 - If Not m_OriginalImage Is Nothing Then - m_ApparentImageSize.Height = m_OriginalImage.Height * m_ZoomFactor - m_ApparentImageSize.Width = m_OriginalImage.Width * m_ZoomFactor - ComputeDrawingArea() - CheckBounds() - End If - Me.Invalidate() - End Set - End Property - - Public Property Origin() As System.Drawing.Point - Get - Return m_Origin - End Get - Set(ByVal value As System.Drawing.Point) - m_Origin = value - Me.Invalidate() - End Set - End Property - - Public ReadOnly Property ApparentImageSize() As System.Drawing.Size - Get - Return m_ApparentImageSize - End Get - End Property - - Public Property PanMode() As Boolean - Get - Return m_PanMode - End Get - Set(ByVal value As Boolean) - m_PanMode = value - End Set - End Property - - Public Property StretchImageToFit() As Boolean - Get - Return m_StretchImageToFit - End Get - Set(ByVal value As Boolean) - m_StretchImageToFit = value - Me.Invalidate() - End Set - End Property - Public Sub fittoscreen() Me.StretchImageToFit = False Me.Origin = New Point(0, 0) @@ -353,18 +350,6 @@ Public Class DrawingBoard ZoomFactor = Math.Min(ClientSize.Width / m_OriginalImage.Width, ClientSize.Height / m_OriginalImage.Height) End Sub -#End Region - - Private Property Selected_Rectangle() As Rectangle - Get - Return m_Select_Rect - End Get - Set(ByVal Value As Rectangle) - m_Select_Rect = Value - Me.Invalidate() - End Set - End Property - Private Sub Draw_Rectangle(ByVal e As System.Windows.Forms.MouseEventArgs) If (New Rectangle(0, 0, ClientSize.Width, ClientSize.Height)).Contains(PointToClient(Windows.Forms.Cursor.Position)) Then Dim Width As Integer = System.Math.Abs(m_StartPoint.X - e.X) @@ -405,7 +390,6 @@ Public Class DrawingBoard Dim ix As Integer, iy As Integer Dim ix2 As Integer, iy2 As Integer - If m_bVisPuntiCorner Then For i = 0 To 3 ix = -m_Origin.X * m_ZoomFactor + m_pCaliCorner(i).X * m_ZoomFactor - std_radius @@ -428,7 +412,6 @@ Public Class DrawingBoard Next End If - If m_bVisPuntiCaliH Then Dim raggio As Integer For i = 0 To 3 @@ -436,7 +419,6 @@ Public Class DrawingBoard ix = -m_Origin.X * m_ZoomFactor + m_pCaliH(i).X * m_ZoomFactor - raggio iy = -m_Origin.Y * m_ZoomFactor + m_pCaliH(i).Y * m_ZoomFactor - raggio g.DrawArc(Pens.Beige, ix, iy, raggio * 2, raggio * 2, 0, 360) - Next For i = 0 To 2 Step 2 ix = -m_Origin.X * m_ZoomFactor + m_pCaliH(i).X * m_ZoomFactor @@ -445,10 +427,8 @@ Public Class DrawingBoard iy2 = -m_Origin.Y * m_ZoomFactor + m_pCaliH(i + 1).Y * m_ZoomFactor g.DrawLine(Pens.Beige, ix, iy, ix2, iy2) Next - End If - If m_bVisAreaGen Then ' 4 cerchi For i = 0 To 3 Step 2 @@ -468,18 +448,10 @@ Public Class DrawingBoard Next End If - - - - - RaiseEvent SetScrollPositions() - End Sub Private Sub ComputeDrawingArea() - 'm_DrawHeight = Me.Height / m_ZoomFactor - 'm_DrawWidth = Me.Width / m_ZoomFactor m_DrawHeight = ClientSize.Height / m_ZoomFactor m_DrawWidth = ClientSize.Width / m_ZoomFactor End Sub @@ -487,11 +459,14 @@ Public Class DrawingBoard Private Sub ImageViewer_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown If m_OriginalImage Is Nothing Then Exit Sub If Not m_MouseEnabled Then Exit Sub + EndPoint = Nothing Selected_Rectangle = Nothing + Dim i As Integer, previusSelection As Integer Dim previusPtypeSel As ptype Dim px As Double, py As Double + 'Set the start point. This is used for panning and zooming so we always set it. m_StartPoint = New Point(e.X, e.Y) previusSelection = m_bPointSelected @@ -537,40 +512,39 @@ Public Class DrawingBoard m_ptypesel = ptype.PuntoArea End If Next - - End If - ' l'evento interessa solo per i punto corner If (previusSelection <> 0 AndAlso m_bPointSelected = 0) OrElse (previusPtypeSel = ptype.PuntoCorner AndAlso m_ptypesel <> ptype.PuntoCorner) Then RaiseEvent PointUnselected() End If - Me.Focus() End Sub Private Sub ImageViewer_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove - If m_OriginalImage Is Nothing Then Exit Sub Dim Px As Single, Py As Single + Px = e.X Py = e.Y + If Px > ClientSize.Width Then Px = ClientSize.Width End If + If Py > ClientSize.Height Then Py = ClientSize.Height End If + If e.X < 0 Then Px = 0 If e.Y < 0 Then Py = 0 If e.Button = m_PanButton OrElse e.Button = m_EditButton Then - Dim DeltaX As Integer, DeltaY As Integer + If PanMode Then DeltaX = (m_StartPoint.X - Px) / m_ZoomFactor DeltaY = (m_StartPoint.Y - Py) / m_ZoomFactor @@ -578,6 +552,7 @@ Public Class DrawingBoard If (DeltaX <> 0) Then m_StartPoint.X = m_StartPoint.X - DeltaX * m_ZoomFactor 'e.X End If + If (DeltaY <> 0) Then m_StartPoint.Y = m_StartPoint.Y - DeltaY * m_ZoomFactor 'e.Y End If @@ -586,7 +561,6 @@ Public Class DrawingBoard DeltaY = (m_StartPoint.Y - Py) End If - If m_bPointSelected And PanMode AndAlso e.Button = m_EditButton Then If m_ptypesel = ptype.PuntoCorner Then If m_bPointSelected = 2 Then @@ -604,21 +578,17 @@ Public Class DrawingBoard m_pCaliH(m_isel).X = m_pCaliH(m_isel).X - DeltaX m_pCaliH(m_isel).Y = m_pCaliH(m_isel).Y - DeltaY ElseIf m_ptypesel = ptype.PuntoArea Then - If m_isel = 0 Then - For i As Integer = 0 To 3 m_pArea(i).X = m_pArea(i).X - DeltaX m_pArea(i).Y = m_pArea(i).Y - DeltaY Next - ElseIf m_isel = 2 Then m_pArea(1).X = m_pArea(1).X - DeltaX m_pArea(2).X = m_pArea(1).X m_pArea(2).Y = m_pArea(2).Y - DeltaY m_pArea(3).Y = m_pArea(2).Y End If - End If Me.Invalidate() Exit Sub @@ -646,173 +616,166 @@ Public Class DrawingBoard 'ix = (pimg.x-m_Origin.X)*m_ZoomFactor '(pimg.x-m_Origin.X) = ix/m_ZoomFactor - pimg.X = m_Origin.X + e.X / m_ZoomFactor pimg.Y = m_Origin.Y + e.Y / m_ZoomFactor RaiseEvent NewMousePosImage(pimg) - End If - - End Sub - Private Sub CheckBounds() - If m_OriginalImage Is Nothing Then Exit Sub - 'Make sure we don't go out of bounds - If m_Origin.X < 0 Then m_Origin.X = 0 - If m_Origin.Y < 0 Then m_Origin.Y = 0 + Private Sub CheckBounds() + If m_OriginalImage Is Nothing Then Exit Sub + 'Make sure we don't go out of bounds + If m_Origin.X < 0 Then m_Origin.X = 0 + If m_Origin.Y < 0 Then m_Origin.Y = 0 - If m_Origin.X > m_OriginalImage.Width - (ClientSize.Width / m_ZoomFactor) Then - m_Origin.X = m_OriginalImage.Width - (ClientSize.Width / m_ZoomFactor) - End If - If m_Origin.Y > m_OriginalImage.Height - (ClientSize.Height / m_ZoomFactor) Then - m_Origin.Y = m_OriginalImage.Height - (ClientSize.Height / m_ZoomFactor) - End If + If m_Origin.X > m_OriginalImage.Width - (ClientSize.Width / m_ZoomFactor) Then + m_Origin.X = m_OriginalImage.Width - (ClientSize.Width / m_ZoomFactor) + End If - If m_Origin.X < 0 Then m_Origin.X = 0 - If m_Origin.Y < 0 Then m_Origin.Y = 0 - End Sub - Private Sub CheckPointBounds() - If m_OriginalImage Is Nothing Then Exit Sub + If m_Origin.Y > m_OriginalImage.Height - (ClientSize.Height / m_ZoomFactor) Then + m_Origin.Y = m_OriginalImage.Height - (ClientSize.Height / m_ZoomFactor) + End If - 'Make sure we don't go out of bounds - If m_pCaliCorner(m_isel).X < 0 Then m_pCaliCorner(m_isel).X = 0 - If m_pCaliCorner(m_isel).Y < 0 Then m_pCaliCorner(m_isel).Y = 0 - If m_pCaliCorner(m_isel).X > m_OriginalImage.Width - (ClientSize.Width / m_ZoomFactor) Then - m_pCaliCorner(m_isel).X = m_OriginalImage.Width - (ClientSize.Width / m_ZoomFactor) - End If - If m_pCaliCorner(m_isel).Y > m_OriginalImage.Height Then ' - (ClientSize.Height / m_ZoomFactor) Then - m_pCaliCorner(m_isel).Y = m_OriginalImage.Height '- (ClientSize.Height / m_ZoomFactor) - End If + If m_Origin.X < 0 Then m_Origin.X = 0 + If m_Origin.Y < 0 Then m_Origin.Y = 0 + End Sub + + Private Sub CheckPointBounds() + If m_OriginalImage Is Nothing Then Exit Sub + + 'Make sure we don't go out of bounds + If m_pCaliCorner(m_isel).X < 0 Then m_pCaliCorner(m_isel).X = 0 + If m_pCaliCorner(m_isel).Y < 0 Then m_pCaliCorner(m_isel).Y = 0 + + If m_pCaliCorner(m_isel).X > m_OriginalImage.Width - (ClientSize.Width / m_ZoomFactor) Then + m_pCaliCorner(m_isel).X = m_OriginalImage.Width - (ClientSize.Width / m_ZoomFactor) + End If + + If m_pCaliCorner(m_isel).Y > m_OriginalImage.Height Then ' - (ClientSize.Height / m_ZoomFactor) Then + m_pCaliCorner(m_isel).Y = m_OriginalImage.Height '- (ClientSize.Height / m_ZoomFactor) + End If ' anche per i punti area If m_pArea(m_isel).X < 0 Then m_pArea(m_isel).X = 0 If m_pArea(m_isel).Y < 0 Then m_pArea(m_isel).Y = 0 + If m_pArea(m_isel).X > m_OriginalImage.Width - (ClientSize.Width / m_ZoomFactor) Then m_pArea(m_isel).X = m_OriginalImage.Width - (ClientSize.Width / m_ZoomFactor) End If + If m_pArea(m_isel).Y > m_OriginalImage.Height Then ' - (ClientSize.Height / m_ZoomFactor) Then m_pArea(m_isel).Y = m_OriginalImage.Height '- (ClientSize.Height / m_ZoomFactor) End If + End Sub + Private Sub DrawingBoard_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp + If m_OriginalImage Is Nothing Then Exit Sub + If Not PanMode Then + EndPoint = New Point(e.X, e.Y) + If Selected_Rectangle = Nothing Then Exit Sub + ZoomSelection() + PanMode = True + End If + End Sub + Private Sub ZoomSelection() + If m_OriginalImage Is Nothing Then Exit Sub - End Sub + Try + Dim NewOrigin As New Point(CInt(Me.Origin.X + (Selected_Rectangle.X / ZoomFactor)), Me.Origin.Y + (Selected_Rectangle.Y / ZoomFactor)) + Dim NewFactor As Double - Private Sub DrawingBoard_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp - If m_OriginalImage Is Nothing Then Exit Sub - If Not PanMode Then - EndPoint = New Point(e.X, e.Y) - If Selected_Rectangle = Nothing Then Exit Sub - ZoomSelection() - PanMode = True - End If - End Sub + If Selected_Rectangle.Width > Selected_Rectangle.Height Then + NewFactor = (ClientSize.Width / (Selected_Rectangle.Width / ZoomFactor)) + Else + NewFactor = (ClientSize.Height / (Selected_Rectangle.Height / ZoomFactor)) + End If - Private Sub ZoomSelection() - If m_OriginalImage Is Nothing Then Exit Sub - Try + Me.Origin = NewOrigin + Me.ZoomFactor = NewFactor + Catch ex As Exception + Throw ex + End Try + Selected_Rectangle = Nothing + End Sub - Dim NewOrigin As New Point(CInt(Me.Origin.X + (Selected_Rectangle.X / ZoomFactor)), _ - Me.Origin.Y + (Selected_Rectangle.Y / ZoomFactor)) - - Dim NewFactor As Double - If Selected_Rectangle.Width > Selected_Rectangle.Height Then - NewFactor = (ClientSize.Width / (Selected_Rectangle.Width / ZoomFactor)) - Else - NewFactor = (ClientSize.Height / (Selected_Rectangle.Height / ZoomFactor)) - End If - - Me.Origin = NewOrigin - Me.ZoomFactor = NewFactor - - Catch ex As Exception - Throw ex - End Try - Selected_Rectangle = Nothing - End Sub - - - Private Sub ImageViewer_MouseWheel(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseWheel - If Not ZoomOnMouseWheel Then Exit Sub - 'set new zoomfactor - If e.Delta > 0 Then + Private Sub ImageViewer_MouseWheel(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseWheel + If Not ZoomOnMouseWheel Then Exit Sub + 'set new zoomfactor + If e.Delta > 0 Then ZoomImage(True, e.Location) ElseIf e.Delta < 0 Then ZoomImage(False, e.Location) End If - End Sub + End Sub - Public Sub RotateFlip(ByVal RotateFlipType As System.Drawing.RotateFlipType) - If m_OriginalImage Is Nothing Then Exit Sub - m_OriginalImage.RotateFlip(RotateFlipType) - Me.Invalidate() - End Sub + Public Sub RotateFlip(ByVal RotateFlipType As System.Drawing.RotateFlipType) + If m_OriginalImage Is Nothing Then Exit Sub + m_OriginalImage.RotateFlip(RotateFlipType) + Me.Invalidate() + End Sub - Public Sub New() - ' This call is required by the Windows Form Designer. - InitializeComponent() + Private Sub DrawingBoard_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize + Me.ComputeDrawingArea() + If Me.StretchImageToFit Then Me.Invalidate() + End Sub - ' Add any initialization after the InitializeComponent() call. - Me.SetStyle(ControlStyles.AllPaintingInWmPaint, True) - Me.SetStyle(ControlStyles.DoubleBuffer, True) - ReDim m_pCaliH(4) - ReDim m_pCaliCorner(4) - ReDim m_pCaliCornerH(4) - End Sub + Private Sub DrawingBoard_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load + End Sub - Private Sub DrawingBoard_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize - Me.ComputeDrawingArea() - If Me.StretchImageToFit Then Me.Invalidate() - End Sub + Public Sub SetPuntoCorner(ByVal i As Integer, ByVal x As Double, ByVal y As Double) + If i >= 0 And i < 4 Then + m_pCaliCorner(i).X = x + m_pCaliCorner(i).Y = y + End If + End Sub - Private Sub DrawingBoard_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load + Public Sub SetPuntoCornerH(ByVal i As Integer, ByVal x As Double, ByVal y As Double) + If i >= 0 And i < 4 Then + m_pCaliCornerH(i).X = x + m_pCaliCornerH(i).Y = y + End If + End Sub - End Sub - Public Sub SetPuntoCorner(ByVal i As Integer, ByVal x As Double, ByVal y As Double) - If i >= 0 And i < 4 Then - m_pCaliCorner(i).X = x - m_pCaliCorner(i).Y = y - End If - End Sub - Public Sub SetPuntoCornerH(ByVal i As Integer, ByVal x As Double, ByVal y As Double) - If i >= 0 And i < 4 Then - m_pCaliCornerH(i).X = x - m_pCaliCornerH(i).Y = y - End If - End Sub + Public Sub SetPuntoH(ByVal i As Integer, ByVal x As Double, ByVal y As Double) + If i >= 0 And i < 4 Then + m_pCaliH(i).X = x + m_pCaliH(i).Y = y + End If + End Sub + + Public Function GetXCorner(ByVal i As Integer) As Integer + GetXCorner = m_pCaliCorner(i).X + End Function + + Public Function GetYCorner(ByVal i As Integer) As Integer + GetYCorner = m_pCaliCorner(i).Y + End Function + + Public Function GetXCornerH(ByVal i As Integer) As Integer + GetXCornerH = m_pCaliCornerH(i).X + End Function + + Public Function GetYCornerH(ByVal i As Integer) As Integer + GetYCornerH = m_pCaliCornerH(i).Y + End Function + + Public Function GetXHpx(ByVal i As Integer) As Integer + GetXHpx = m_pCaliH(i).X + End Function + + Public Function GetYHpx(ByVal i As Integer) As Integer + GetYHpx = m_pCaliH(i).Y + End Function - Public Sub SetPuntoH(ByVal i As Integer, ByVal x As Double, ByVal y As Double) - If i >= 0 And i < 4 Then - m_pCaliH(i).X = x - m_pCaliH(i).Y = y - End If - End Sub - Public Function GetXCorner(ByVal i As Integer) As Integer - GetXCorner = m_pCaliCorner(i).X - End Function - Public Function GetYCorner(ByVal i As Integer) As Integer - GetYCorner = m_pCaliCorner(i).Y - End Function - Public Function GetXCornerH(ByVal i As Integer) As Integer - GetXCornerH = m_pCaliCornerH(i).X - End Function - Public Function GetYCornerH(ByVal i As Integer) As Integer - GetYCornerH = m_pCaliCornerH(i).Y - End Function - Public Function GetXHpx(ByVal i As Integer) As Integer - GetXHpx = m_pCaliH(i).X - End Function - Public Function GetYHpx(ByVal i As Integer) As Integer - GetYHpx = m_pCaliH(i).Y - End Function Public Sub SetPuntoArea(ByVal i As Integer, ByVal x As Double, ByVal y As Double) If i >= 0 And i < 4 Then m_pArea(i).X = x m_pArea(i).Y = y End If End Sub + Public Sub SetArea(x1 As Double, y1 As Double, x2 As Double, y2 As Double) m_pArea(0).X = x1 m_pArea(0).Y = y1 @@ -839,5 +802,7 @@ Public Class DrawingBoard y2 = m_pArea(2).Y End Sub +#End Region ' Methods + End Class diff --git a/CameraMng/ImageCtrl/ImageControl.vb b/CameraMng/ImageCtrl/ImageControl.vb index aa343f8..1d87a11 100644 --- a/CameraMng/ImageCtrl/ImageControl.vb +++ b/CameraMng/ImageCtrl/ImageControl.vb @@ -1,182 +1,190 @@ - _ + Public Class ImageControl +#Region "FIELDS & PROPERTIES" + Public Event PointSelected(n As Integer) Public Event PointUnselected() Public Event NewMousePosImage(pima As PointF) - Private m_ScrollVisible As Boolean = True + Private m_ScrollVisible As Boolean = True + Public Property ScrollbarsVisible() As Boolean + Get + Return m_ScrollVisible + End Get + Set(ByVal value As Boolean) + m_ScrollVisible = value + Me.HScrollBar1.Visible = value + Me.VScrollBar1.Visible = value + If value = False Then + Me.DrawingBoard1.Dock = DockStyle.Fill + Else + Me.DrawingBoard1.Dock = DockStyle.None + Me.DrawingBoard1.Location = New Point(0, 0) + Me.DrawingBoard1.Width = ClientSize.Width - VScrollBar1.Width + Me.DrawingBoard1.Height = ClientSize.Height - HScrollBar1.Height - Public Sub New() + End If + End Set + End Property - ' This call is required by the Windows Form Designer. - InitializeComponent() + Public ReadOnly Property DBoard() As DrawingBoard + Get + Return DrawingBoard1 + End Get + End Property - ' Add any initialization after the InitializeComponent() call. - End Sub + Public Property PanMode() As Boolean + Get + Return DrawingBoard1.PanMode + End Get + Set(ByVal value As Boolean) + DrawingBoard1.PanMode = value + End Set + End Property -#Region "Public Properties" - Public ReadOnly Property DBoard() As DrawingBoard - Get - Return DrawingBoard1 - End Get - End Property + Public Property PanButton() As System.Windows.Forms.MouseButtons + Get + Return DrawingBoard1.PanButton + End Get + Set(ByVal value As System.Windows.Forms.MouseButtons) + DrawingBoard1.PanButton = value + End Set + End Property - Public Property PanMode() As Boolean - Get - Return DrawingBoard1.PanMode - End Get - Set(ByVal value As Boolean) - DrawingBoard1.PanMode = value - End Set - End Property + Public Property ZoomOnMouseWheel() As Boolean + Get + Return DrawingBoard1.ZoomOnMouseWheel + End Get + Set(ByVal value As Boolean) + DrawingBoard1.ZoomOnMouseWheel = value + End Set + End Property - Public Property PanButton() As System.Windows.Forms.MouseButtons - Get - Return DrawingBoard1.PanButton - End Get - Set(ByVal value As System.Windows.Forms.MouseButtons) - DrawingBoard1.PanButton = value - End Set - End Property + Public Property ZoomFactor() As Double + Get + Return DrawingBoard1.ZoomFactor + End Get + Set(ByVal value As Double) + DrawingBoard1.ZoomFactor = value + End Set + End Property - Public Property ZoomOnMouseWheel() As Boolean - Get - Return DrawingBoard1.ZoomOnMouseWheel - End Get - Set(ByVal value As Boolean) - DrawingBoard1.ZoomOnMouseWheel = value - End Set - End Property + Public Property Origin() As System.Drawing.Point + Get + Return DrawingBoard1.Origin + End Get + Set(ByVal value As System.Drawing.Point) + DrawingBoard1.Origin = value + End Set + End Property - Public Property ZoomFactor() As Double - Get - Return DrawingBoard1.ZoomFactor - End Get - Set(ByVal value As Double) - DrawingBoard1.ZoomFactor = value - End Set - End Property + Public Property StretchImageToFit() As Boolean + Get + Return Me.DrawingBoard1.StretchImageToFit + End Get + Set(ByVal value As Boolean) + Me.DrawingBoard1.StretchImageToFit = value + End Set + End Property - Public Property Origin() As System.Drawing.Point - Get - Return DrawingBoard1.Origin - End Get - Set(ByVal value As System.Drawing.Point) - DrawingBoard1.Origin = value - End Set - End Property + Public Property MouseEnabled() As Boolean + Get + Return Me.DrawingBoard1.MouseEnaBled + End Get + Set(ByVal value As Boolean) + Me.DrawingBoard1.MouseEnaBled = value + End Set + End Property - Public Property StretchImageToFit() As Boolean - Get - Return Me.DrawingBoard1.StretchImageToFit - End Get - Set(ByVal value As Boolean) - Me.DrawingBoard1.StretchImageToFit = value - End Set - End Property - Public Property MouseEnabled() As Boolean - Get - Return Me.DrawingBoard1.MouseEnaBled - End Get - Set(ByVal value As Boolean) - Me.DrawingBoard1.MouseEnaBled = value - End Set - End Property + Public ReadOnly Property ApparentImageSize() As System.Drawing.Size + Get + Return DrawingBoard1.ApparentImageSize + End Get + End Property - Public ReadOnly Property ApparentImageSize() As System.Drawing.Size - Get - Return DrawingBoard1.ApparentImageSize - End Get - End Property + Public Shadows Property Image() As System.Drawing.Image + Get + Return DrawingBoard1.Image + End Get + Set(ByVal Value As System.Drawing.Image) + DrawingBoard1.Image = Value + If Value Is Nothing Then + HScrollBar1.Enabled = False + VScrollBar1.Enabled = False + Exit Property + End If + End Set + End Property - Public Sub fittoscreen() - Me.DrawingBoard1.fittoscreen() - End Sub + Public Shadows Property initialimage() As System.Drawing.Image + Get + Return DrawingBoard1.initialimage + End Get + Set(ByVal value As System.Drawing.Image) + DrawingBoard1.initialimage = value + If value Is Nothing Then + HScrollBar1.Enabled = False + VScrollBar1.Enabled = False + Exit Property + End If + End Set + End Property - Public Sub InvertColors() - Me.DrawingBoard1.InvertColors() - End Sub + Public Shadows Property BackgroundImage() As System.Drawing.Image + Get + Return DrawingBoard1.BackgroundImage + End Get + Set(ByVal Value As System.Drawing.Image) + DrawingBoard1.BackgroundImage = Value + If Value Is Nothing Then + HScrollBar1.Enabled = False + VScrollBar1.Enabled = False + Exit Property + End If + End Set + End Property - Public Sub ZoomIn() - Me.DrawingBoard1.ZoomIn() - End Sub +#End Region ' Fields & Properties - Public Sub ZoomOut() - Me.DrawingBoard1.ZoomOut() - End Sub +#Region "CONSTRUCTOR" - Public Property ScrollbarsVisible() As Boolean - Get - Return m_ScrollVisible - End Get - Set(ByVal value As Boolean) - m_ScrollVisible = value - Me.HScrollBar1.Visible = value - Me.VScrollBar1.Visible = value - If value = False Then - Me.DrawingBoard1.Dock = DockStyle.Fill - Else - Me.DrawingBoard1.Dock = DockStyle.None - Me.DrawingBoard1.Location = New Point(0, 0) - Me.DrawingBoard1.Width = ClientSize.Width - VScrollBar1.Width - Me.DrawingBoard1.Height = ClientSize.Height - HScrollBar1.Height + Public Sub New() - End If - End Set - End Property + ' This call is required by the Windows Form Designer. + InitializeComponent() -#End Region - -#Region "Public/Private Shadows" - Public Shadows Property Image() As System.Drawing.Image - Get - Return DrawingBoard1.Image - End Get - Set(ByVal Value As System.Drawing.Image) - DrawingBoard1.Image = Value - If Value Is Nothing Then - HScrollBar1.Enabled = False - VScrollBar1.Enabled = False - Exit Property - End If - End Set - End Property - - Public Shadows Property initialimage() As System.Drawing.Image - Get - Return DrawingBoard1.initialimage - End Get - Set(ByVal value As System.Drawing.Image) - DrawingBoard1.initialimage = value - If value Is Nothing Then - HScrollBar1.Enabled = False - VScrollBar1.Enabled = False - Exit Property - End If - End Set - End Property - - Public Shadows Property BackgroundImage() As System.Drawing.Image - Get - Return DrawingBoard1.BackgroundImage - End Get - Set(ByVal Value As System.Drawing.Image) - DrawingBoard1.BackgroundImage = Value - If Value Is Nothing Then - HScrollBar1.Enabled = False - VScrollBar1.Enabled = False - Exit Property - End If - End Set - End Property - -#End Region - - Public Sub RotateFlip(ByVal RotateFlipType As System.Drawing.RotateFlipType) - DrawingBoard1.RotateFlip(RotateFlipType) + ' Add any initialization after the InitializeComponent() call. End Sub +#End Region ' Constructor + +#Region "METHODS" + + Public Sub fittoscreen() + Me.DrawingBoard1.fittoscreen() + End Sub + + Public Sub InvertColors() + Me.DrawingBoard1.InvertColors() + End Sub + + Public Sub ZoomIn() + Me.DrawingBoard1.ZoomIn() + End Sub + + Public Sub ZoomOut() + Me.DrawingBoard1.ZoomOut() + End Sub + + Public Sub RotateFlip(ByVal RotateFlipType As System.Drawing.RotateFlipType) + DrawingBoard1.RotateFlip(RotateFlipType) + End Sub + +#End Region ' Methods + +#Region "EVENTS" + Private Sub DrawingBoard1_NewMousePosImage(pm As System.Drawing.PointF) Handles DrawingBoard1.NewMousePosImage RaiseEvent NewMousePosImage(pm) End Sub @@ -185,51 +193,50 @@ Public Class ImageControl RaiseEvent PointSelected(n) End Sub - Private Sub DrawingBoard1_SetScrollPositions() Handles DrawingBoard1.SetScrollPositions + Private Sub DrawingBoard1_SetScrollPositions() Handles DrawingBoard1.SetScrollPositions + Dim DrawingWidth As Integer = DrawingBoard1.Image.Width + Dim DrawingHeight As Integer = DrawingBoard1.Image.Height + Dim OriginX As Integer = DrawingBoard1.Origin.X + Dim OriginY As Integer = DrawingBoard1.Origin.Y + Dim FactoredCtrlWidth As Integer = DrawingBoard1.Width / DrawingBoard1.ZoomFactor + Dim FactoredCtrlHeight As Integer = DrawingBoard1.Height / DrawingBoard1.ZoomFactor - Dim DrawingWidth As Integer = DrawingBoard1.Image.Width - Dim DrawingHeight As Integer = DrawingBoard1.Image.Height - Dim OriginX As Integer = DrawingBoard1.Origin.X - Dim OriginY As Integer = DrawingBoard1.Origin.Y - Dim FactoredCtrlWidth As Integer = DrawingBoard1.Width / DrawingBoard1.ZoomFactor - Dim FactoredCtrlHeight As Integer = DrawingBoard1.Height / DrawingBoard1.ZoomFactor - HScrollBar1.Maximum = Me.DrawingBoard1.Image.Width - VScrollBar1.Maximum = Me.DrawingBoard1.Image.Height - - If FactoredCtrlWidth >= DrawingBoard1.Image.Width Or StretchImageToFit Then - HScrollBar1.Enabled = False - HScrollBar1.Value = 0 - Else - HScrollBar1.LargeChange = FactoredCtrlWidth - HScrollBar1.Enabled = True - HScrollBar1.Value = OriginX - End If - - If FactoredCtrlHeight >= DrawingBoard1.Image.Height Or StretchImageToFit Then - VScrollBar1.Enabled = False - VScrollBar1.Value = 0 - Else - VScrollBar1.Enabled = True - VScrollBar1.LargeChange = FactoredCtrlHeight - VScrollBar1.Value = OriginY - End If + HScrollBar1.Maximum = Me.DrawingBoard1.Image.Width + VScrollBar1.Maximum = Me.DrawingBoard1.Image.Height + If FactoredCtrlWidth >= DrawingBoard1.Image.Width Or StretchImageToFit Then + HScrollBar1.Enabled = False + HScrollBar1.Value = 0 + Else + HScrollBar1.LargeChange = FactoredCtrlWidth + HScrollBar1.Enabled = True + HScrollBar1.Value = OriginX + End If + If FactoredCtrlHeight >= DrawingBoard1.Image.Height Or StretchImageToFit Then + VScrollBar1.Enabled = False + VScrollBar1.Value = 0 + Else + VScrollBar1.Enabled = True + VScrollBar1.LargeChange = FactoredCtrlHeight + VScrollBar1.Value = OriginY + End If End Sub - Private Sub ScrollBar_ValueChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles HScrollBar1.ValueChanged, VScrollBar1.ValueChanged - Me.DrawingBoard1.Origin = New Point(HScrollBar1.Value, VScrollBar1.Value) - End Sub + Private Sub ScrollBar_ValueChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles HScrollBar1.ValueChanged, VScrollBar1.ValueChanged + Me.DrawingBoard1.Origin = New Point(HScrollBar1.Value, VScrollBar1.Value) + End Sub - Private Sub DrawingBoard1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles DrawingBoard1.Load + Private Sub DrawingBoard1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles DrawingBoard1.Load + End Sub - End Sub - - Private Sub VScrollBar1_Scroll(ByVal sender As System.Object, ByVal e As System.Windows.Forms.ScrollEventArgs) Handles VScrollBar1.Scroll - - End Sub + Private Sub VScrollBar1_Scroll(ByVal sender As System.Object, ByVal e As System.Windows.Forms.ScrollEventArgs) Handles VScrollBar1.Scroll + End Sub Private Sub DrawingBoard1_PointUnselected() Handles DrawingBoard1.PointUnselected RaiseEvent PointUnselected() End Sub + +#End Region ' Events + End Class \ No newline at end of file diff --git a/CameraMng/MainModule.vb b/CameraMng/MainModule.vb index 872447f..4fee629 100644 --- a/CameraMng/MainModule.vb +++ b/CameraMng/MainModule.vb @@ -1,10 +1,9 @@ -Imports system.io -Imports system.io.path -Imports system.Drawing -Imports System.Windows.Forms Imports IPadLibrary.FormsInterfaces Public Module MainModule + +#Region "FIELDS & PROPERTIES" + Public Enum statoGenEnum StatoOk = 0 ErroreCfg = 1 @@ -46,6 +45,10 @@ Public Module MainModule Public IndexProc As String = String.Empty +#End Region ' Fields & Properties + +#Region "METHODS" + Public Function CancelDir(ByVal inPath As String) As Boolean Try Kill(inPath & "\*.*") @@ -54,4 +57,6 @@ Public Module MainModule Return True End Function +#End Region ' Methods + End Module diff --git a/CameraMng/Observer.vb b/CameraMng/Observer.vb index 4803790..f37049a 100644 --- a/CameraMng/Observer.vb +++ b/CameraMng/Observer.vb @@ -20,100 +20,89 @@ '******************************************************************************/ Option Explicit On -Imports System -Imports System.Runtime.InteropServices - - Public Interface Observer - Sub update(ByVal from As Observable, ByVal msg As Integer, ByVal data As Integer) + Sub update(ByVal from As Observable, ByVal msg As Integer, ByVal data As Integer) End Interface - - Public Class Observable - Private m_numof_ob As Integer - Private m_observers() As Observer +#Region "FIELDS & PROPERTIES" + Private m_numof_ob As Integer + Private m_observers() As Observer - Public Sub New() - m_numof_ob = -1 ' ArraySize = 0 - End Sub +#End Region ' Fields & Properties - Protected Overrides Sub Finalize() - deleteObservers() - End Sub +#Region "CONSTRUCTOR" - '// Add an observer. - Public Sub addObserver(ByVal ob As Object) + Public Sub New() + m_numof_ob = -1 ' ArraySize = 0 + End Sub - m_numof_ob = m_numof_ob + 1 - ReDim Preserve m_observers(m_numof_ob) - m_observers(m_numof_ob) = ob +#End Region ' Constructor - End Sub +#Region "METHODS" - '// Delete an observer . - Public Sub deleteObserver(ByVal ob As Observer) + Protected Overrides Sub Finalize() + deleteObservers() + End Sub - Dim iCnt As Integer + '// Add an observer. + Public Sub addObserver(ByVal ob As Object) + m_numof_ob = m_numof_ob + 1 + ReDim Preserve m_observers(m_numof_ob) + m_observers(m_numof_ob) = ob + End Sub - If m_numof_ob <= 0 Then + '// Delete an observer . + Public Sub deleteObserver(ByVal ob As Observer) + Dim iCnt As Integer - ReDim m_observers(-1) - m_numof_ob = -1 + If m_numof_ob <= 0 Then + ReDim m_observers(-1) + m_numof_ob = -1 + Else + For iCnt = 0 To m_numof_ob + If m_observers(iCnt) Is ob Then + Do + m_observers(iCnt) = m_observers(iCnt + 1) + iCnt = iCnt + 1 + Loop Until iCnt = m_numof_ob + End If + Next + m_observers(m_numof_ob) = Nothing + m_numof_ob = m_numof_ob - 1 + ReDim Preserve m_observers(m_numof_ob) + End If + End Sub - Else - For iCnt = 0 To m_numof_ob - If m_observers(iCnt) Is ob Then - Do - m_observers(iCnt) = m_observers(iCnt + 1) - iCnt = iCnt + 1 - Loop Until iCnt = m_numof_ob - End If - Next - - m_observers(m_numof_ob) = Nothing - m_numof_ob = m_numof_ob - 1 - ReDim Preserve m_observers(m_numof_ob) - - End If - - End Sub - - - '// Notify to observers. - Public Sub notifyObservers(ByVal msg As Integer, Optional ByVal data As Integer = 0) + '// Notify to observers. + Public Sub notifyObservers(ByVal msg As Integer, Optional ByVal data As Integer = 0) Exit Sub - Dim iCnt As Integer + Dim iCnt As Integer - For iCnt = m_numof_ob To 0 Step -1 + For iCnt = m_numof_ob To 0 Step -1 + m_observers(iCnt).update(Me, msg, data) + iCnt = iCnt - 1 + Next + End Sub - m_observers(iCnt).update(Me, msg, data) - iCnt = iCnt - 1 + Public Sub deleteObservers() + Dim icnt As Integer - Next + For icnt = 0 To m_numof_ob + m_observers(icnt) = Nothing + Next - End Sub + ' Set the number of observer as 0. + m_numof_ob = 0 + End Sub + Public Function countObservers() As Integer + Return m_numof_ob + End Function - Public Sub deleteObservers() - Dim icnt As Integer - - For icnt = 0 To m_numof_ob - m_observers(icnt) = Nothing - Next - - ' Set the number of observer as 0. - m_numof_ob = 0 - - End Sub - - - Public Function countObservers() As Integer - Return m_numof_ob - - End Function +#End Region ' Methods End Class diff --git a/CameraMng/clsCamera/clsCamera.vb b/CameraMng/clsCamera/clsCamera.vb index 6b75cbe..4750daa 100644 --- a/CameraMng/clsCamera/clsCamera.vb +++ b/CameraMng/clsCamera/clsCamera.vb @@ -1,78 +1,18 @@ - -Imports System.Runtime.InteropServices -Imports System.Windows.Forms -Imports System.Collections -Imports System.IO Imports System.IO.Path -Imports System.Drawing.Imaging -Imports System.Drawing.Bitmap Public Class clsCamera Implements Observer +#Region "FIELDS & PROPERTIES" - - Private m_PhotoFileName As String Private m_ImgCtrl As ImageControl - Private m_Image As System.Drawing.Bitmap - Private m_bDownloaded As Boolean - Private m_LbImageStatus As Label - Private m_DownloadDir As String = "C:\CameraMng\" Private m_isSDKLoaded As Boolean = False - Private _lastError As Integer = EDS_ERR_OK - Private _bodyID As String = "" Private m_idList As List(Of String) = Nothing - Private m_ConnectedCameras As Integer = 0 - ReadOnly Property PhotoFileName() As String - Get - Return m_PhotoFileName - End Get - End Property - ReadOnly Property CameraImage As Bitmap - Get - Return m_Image - End Get - End Property - WriteOnly Property DownloadDir As String - Set(ByVal value As String) - m_DownloadDir = value - End Set - End Property - - ReadOnly Property Downloaded() As Boolean - Get - Return m_bDownloaded - End Get - End Property - ReadOnly Property LastError() As Integer - Get - Return _lastError - End Get - End Property - - ReadOnly Property CameraID As String - Get - Return _bodyID - End Get - End Property - - WriteOnly Property LbImageStatus() As Label - Set(ByVal LbToSet As Label) - m_LbImageStatus = LbToSet - End Set - End Property - - Public Sub New() - - End Sub - - Public Sub Dispose(ByVal disposing As Boolean) - - End Sub - - Private _connected As Boolean = False + Private m_bDownloaded As Boolean + Private _lastError As Integer = EDS_ERR_OK Event DownloadedCompleted() Event StatusChanged() + Public nCount As Integer = 0 #Region "User defined attributes" @@ -81,44 +21,184 @@ Public Class clsCamera 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 + Private m_PhotoFileName As String + ReadOnly Property PhotoFileName() As String + Get + Return m_PhotoFileName + End Get + End Property -#End Region + 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 - Delegate Sub UpdateDelegate( - ByVal from As Observable, - ByVal msg As Integer, - ByVal data As Integer) + Private _bodyID As String = "" + ReadOnly Property CameraID As String + Get + Return _bodyID + End Get + End Property + Private m_ConnectedCameras As Integer = 0 + ReadOnly Property ConnectedCameras As String + Get + Return m_ConnectedCameras + End Get + End Property - Public Function cameraModelFactory(ByVal camera As IntPtr, ByVal deviceInfo As EdsDeviceInfo) As CameraModel + Private m_LbImageStatus As Label + WriteOnly Property LbImageStatus() As Label + Set(ByVal LbToSet As Label) + m_LbImageStatus = LbToSet + End Set + End Property - ' if Legacy protocol. - If deviceInfo.DeviceSubType = 0 Then - Return New CameraModelLegacy(camera) - End If - - ' PTP protocol. - Return New CameraModel(camera) - - End Function + Private _connected As Boolean = False ReadOnly Property Connected As Boolean Get Return _connected End Get End Property +#End Region ' Fields & Properties + +#Region "CONSTRUCTOR" + + Public Sub New() + End Sub + +#End Region ' Constructor + +#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 + 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 + + 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 + RaiseEvent StatusChanged() + End Select + + rtn = CLng(EDS_ERR_OK) + Return rtn + End Function + +#End Region ' Events + +#Region "METHODS" + + 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. @@ -127,7 +207,6 @@ Public Class clsCamera '// Notify Error. If err <> EDS_ERR_OK Then - End If controller.actionPerformed("takepicture") @@ -137,7 +216,6 @@ Public Class clsCamera ' Creo la connessione con la camera Public Sub Connect(Optional bodyID As String = "") - If bodyID = "" Then Connect(0) Return @@ -150,32 +228,8 @@ Public Class clsCamera End If If _connected Then Disconnect() Next - End Sub - Public Sub CameraList() - - 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 2 - Connect(i) - If Not _connected Then Exit For - m_idList.Add(CameraID) - Disconnect() - Next - - - End Sub - - ' Da rivedere !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' Setta il valore di CameraID Private Sub Connect(ncam As Integer) @@ -184,6 +238,7 @@ Public Class clsCamera Dim cameraList As IntPtr = Nothing Dim camera As IntPtr = Nothing Dim propObj As New CameraProperty + Dim deviceInfo As EdsDeviceInfo = Nothing m_ConnectedCameras = 0 _connected = False @@ -200,10 +255,8 @@ Public Class clsCamera 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 @@ -212,18 +265,14 @@ Public Class clsCamera 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 @@ -231,49 +280,26 @@ Public Class clsCamera 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 @@ -307,35 +333,25 @@ Public Class clsCamera _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 = "" @@ -349,12 +365,9 @@ Public Class clsCamera _connected = True RaiseEvent StatusChanged() - - End Sub Public Sub Disconnect() - controller.actionPerformed("close") _bodyID = "" @@ -367,177 +380,38 @@ Public Class clsCamera EdsTerminateSDK() m_isSDKLoaded = False _connected = False - End Sub - 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 nCount As Integer = 0 - - ' 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 - - Private Function ProgressFunc(ByVal inPercent As Integer, - ByVal inContext As IntPtr, ByRef outCancel As Boolean) As Long - + 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 + 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 @@ -546,21 +420,17 @@ Public Class clsCamera '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) @@ -577,11 +447,8 @@ Public Class clsCamera 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 @@ -598,6 +465,7 @@ Public Class clsCamera cmb.BeginUpdate() cmb.Items.Clear() + For iCnt = 0 To desc.numElements - 1 propStr = propList(desc.propDesc(iCnt)) If propStr <> Nothing Then @@ -607,14 +475,16 @@ Public Class clsCamera 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 + End Class diff --git a/CameraMng/clsImageMng/BitmapBytesRGB24.vb b/CameraMng/clsImageMng/BitmapBytesRGB24.vb index ced3b0b..5afb24d 100644 --- a/CameraMng/clsImageMng/BitmapBytesRGB24.vb +++ b/CameraMng/clsImageMng/BitmapBytesRGB24.vb @@ -1,86 +1,38 @@ Imports System.Runtime.InteropServices Imports System.Drawing.Imaging -Imports System.Drawing -Imports System.Drawing.Bitmap - Public Class BitmapBytesRGB24 - ' Provide public access to the picture's byte data. - Public ImageBytes() As Byte - Public RowSizeBytes As Integer - Public Const PixelDataSize As Integer = 24 - ' A reference to the Bitmap. - Private m_Bitmap As Drawing.Bitmap - ' Bitmap data. - Private m_BitmapData As BitmapData - ' Save a reference to the bitmap. - Public Sub New(ByVal bm As Drawing.Bitmap) - m_Bitmap = bm - End Sub - ' Lock the bitmap's data. - Public Sub LockBitmap() - ' Lock the bitmap data. - Dim bounds As Drawing.Rectangle = New Rectangle( _ - 0, 0, m_Bitmap.Width, m_Bitmap.Height) - m_BitmapData = m_Bitmap.LockBits(bounds, _ - Imaging.ImageLockMode.ReadWrite, _ - Imaging.PixelFormat.Format24bppRgb) - RowSizeBytes = m_BitmapData.Stride +#Region "FIELDS & PROPERTIES" - ' Allocate room for the data. - Dim total_size As Integer = m_BitmapData.Stride * m_BitmapData.Height - ReDim ImageBytes(total_size) - - ' Copy the data into the ImageBytes array. - Marshal.Copy(m_BitmapData.Scan0, ImageBytes, _ - 0, total_size) - End Sub - - ' Copy the data back into the Bitmap - ' and release resources. - Public Sub UnlockBitmap() - ' Copy the data back into the bitmap. - Dim total_size As Integer = m_BitmapData.Stride * m_BitmapData.Height - Marshal.Copy(ImageBytes, 0, _ - m_BitmapData.Scan0, total_size) - - ' Unlock the bitmap. - m_Bitmap.UnlockBits(m_BitmapData) - - ' Release resources. - 'ImageBytes = Nothing - 'm_BitmapData = Nothing - End Sub - Public Sub ReleaseBitmap() - ' Release resources. - ImageBytes = Nothing - m_BitmapData = Nothing - GC.Collect() - End Sub - -End Class -Public Class BitmapBytes8 ' Provide public access to the picture's byte data. Public ImageBytes() As Byte Public RowSizeBytes As Integer - Public Const PixelDataSize As Integer = 8 - + Public Const PixelDataSize As Integer = 24 ' A reference to the Bitmap. Private m_Bitmap As Drawing.Bitmap ' Bitmap data. Private m_BitmapData As BitmapData +#End Region ' Fields & Properties + +#Region "CONSTRUCTOR" + ' Save a reference to the bitmap. Public Sub New(ByVal bm As Drawing.Bitmap) m_Bitmap = bm End Sub + +#End Region ' Constructor + +#Region "METHODS" + ' Lock the bitmap's data. Public Sub LockBitmap() ' Lock the bitmap data. Dim bounds As Drawing.Rectangle = New Rectangle(0, 0, m_Bitmap.Width, m_Bitmap.Height) - m_BitmapData = m_Bitmap.LockBits(bounds, Imaging.ImageLockMode.ReadWrite, _ - m_Bitmap.PixelFormat) + + m_BitmapData = m_Bitmap.LockBits(bounds, Imaging.ImageLockMode.ReadWrite, Imaging.PixelFormat.Format24bppRgb) RowSizeBytes = m_BitmapData.Stride ' Allocate room for the data. @@ -89,7 +41,70 @@ Public Class BitmapBytes8 ' Copy the data into the ImageBytes array. Marshal.Copy(m_BitmapData.Scan0, ImageBytes, 0, total_size) + End Sub + ' Copy the data back into the Bitmap + ' and release resources. + Public Sub UnlockBitmap() + ' Copy the data back into the bitmap. + Dim total_size As Integer = m_BitmapData.Stride * m_BitmapData.Height + Marshal.Copy(ImageBytes, 0, m_BitmapData.Scan0, total_size) + + ' Unlock the bitmap. + m_Bitmap.UnlockBits(m_BitmapData) + End Sub + + Public Sub ReleaseBitmap() + ' Release resources. + ImageBytes = Nothing + m_BitmapData = Nothing + GC.Collect() + End Sub + +#End Region ' Methods + +End Class + +Public Class BitmapBytes8 + +#Region "FIELDS & PROPERTIES" + + ' Provide public access to the picture's byte data. + Public ImageBytes() As Byte + Public RowSizeBytes As Integer + Public Const PixelDataSize As Integer = 8 + ' A reference to the Bitmap. + Private m_Bitmap As Drawing.Bitmap + ' Bitmap data. + Private m_BitmapData As BitmapData + +#End Region ' Fields & Properties + +#Region "CONSTRUCTOR" + + ' Save a reference to the bitmap. + Public Sub New(ByVal bm As Drawing.Bitmap) + m_Bitmap = bm + End Sub + +#End Region ' Constructor + +#Region "METHODS" + + ' Lock the bitmap's data. + Public Sub LockBitmap() + ' Lock the bitmap data. + Dim bounds As Drawing.Rectangle = New Rectangle(0, 0, m_Bitmap.Width, m_Bitmap.Height) + + m_BitmapData = m_Bitmap.LockBits(bounds, Imaging.ImageLockMode.ReadWrite, m_Bitmap.PixelFormat) + RowSizeBytes = m_BitmapData.Stride + + ' Allocate room for the data. + Dim total_size As Integer = m_BitmapData.Stride * m_BitmapData.Height + ReDim ImageBytes(total_size) + + ' Copy the data into the ImageBytes array. + Marshal.Copy(m_BitmapData.Scan0, ImageBytes, 0, total_size) End Sub ' Copy the data back into the Bitmap @@ -100,6 +115,7 @@ Public Class BitmapBytes8 Marshal.Copy(ImageBytes, 0, m_BitmapData.Scan0, total_size) UnlockBitmap() End Sub + ' Release resources. Public Sub UnlockBitmap() m_Bitmap.UnlockBits(m_BitmapData) @@ -111,4 +127,6 @@ Public Class BitmapBytes8 GC.Collect() End Sub +#End Region ' Methods + End Class diff --git a/CameraMng/clsImageMng/FrmImgShow.vb b/CameraMng/clsImageMng/FrmImgShow.vb index 7165110..2f15f39 100644 --- a/CameraMng/clsImageMng/FrmImgShow.vb +++ b/CameraMng/clsImageMng/FrmImgShow.vb @@ -1,41 +1,46 @@ -Imports Emgu -Imports Emgu.CV -Imports Emgu.CV.Util -Imports Emgu.CV.Structure +Public Class FrmImgShow -Public Class FrmImgShow - - Private Sub ImageBox1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ImageBox1.Click - - End Sub - - Private Sub FrmImgShow_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load - ImageBox1.FunctionalMode = Emgu.CV.UI.ImageBox.FunctionalModeOption.Everything - End Sub +#Region "CONSTRUCTOR" Public Sub New(ByVal img As Emgu.CV.IImage) - ' This call is required by the designer. InitializeComponent() ' Add any initialization after the InitializeComponent() call. ImageBox1.Image = img - End Sub - Public Sub New() + Public Sub New() ' This call is required by the designer. InitializeComponent() ' Add any initialization after the InitializeComponent() call. End Sub +#End Region ' Constructor + +#Region "EVENTS" + + Private Sub FrmImgShow_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load + ImageBox1.FunctionalMode = Emgu.CV.UI.ImageBox.FunctionalModeOption.Everything + End Sub + + Private Sub ImageBox1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ImageBox1.Click + End Sub + Private Sub BtnZoomAll_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnZoomAll.Click Dim zallScale As Double = Math.Min(ImageBox1.Width / ImageBox1.Image.Bitmap.Width, ImageBox1.Height / ImageBox1.Image.Bitmap.Height) ImageBox1.SetZoomScale(zallScale, New Point(0, 0)) End Sub +#End Region ' Events + +#Region "METHODS" + Public Sub DisposeForm() ImageBox1.Image = Nothing End Sub + +#End Region ' Methods + End Class \ No newline at end of file diff --git a/CameraMng/clsImageMng/clsImageMng.vb b/CameraMng/clsImageMng/clsImageMng.vb index 3064f65..a3e72e8 100644 --- a/CameraMng/clsImageMng/clsImageMng.vb +++ b/CameraMng/clsImageMng/clsImageMng.vb @@ -1,6 +1,3 @@ -Imports System.Runtime - - Imports Emgu.CV.CvEnum Imports Emgu.CV.Structure Imports System.Math @@ -8,28 +5,23 @@ Imports System.IO Imports System.Globalization Imports Emgu.CV Imports System.Threading -Imports Emgu.CV.Util Imports System.Drawing.Imaging Public Class clsImageMng - -#Region "membri privati" +#Region "FIELDS & PROPERTIES" Private m_dimx As Short = 1 '3888 Private m_dimy As Short = 1 ' 2592 Private m_Pos_x_mm, m_Pos_y_mm As Double ' Posizione in mm del punto_3 (ibl=3) rispetto all'origine (punto_0) Private m_Pos_x_z0_mm, m_Pos_y_z0_mm As Double - Private m_bCorrected As Boolean = False Private m_pmm_bs As New clPuntomm Private m_pmm_bs_lev0 As New clPuntomm Private m_scale_center As New clPuntomm Private m_fscalaxmm As Double Private m_scale_centerZ As Double Private m_punto0 As New clCoppiaPunto - Private m_puntoH(4) As clCoppiaPunto - Private m_bCorrAltezzaEnabled As Boolean ' posizione in px dei punti dell'immagine originale rispetto al punto punto_0 (itl=0) Private m_pdst(3) As System.Drawing.PointF ' punti nuova foto ' indice per distinguere i punti salvati nei vettori 'm_pworld', 'm_psrc', 'm_pdst' @@ -42,13 +34,13 @@ Public Class clsImageMng Private m_dim_YProsp As Short = 1 ' mm to px all'altezza zero del tavolo Private m_mm2PixelProspZ0 As Double - Private m_mm2PixelProspFinal As Double ' Estension in Pixel dell'immagine Private m_ExtXL_pix As Integer, m_ExtXR_pix As Integer ' sinistra e destra Private m_ExtYT_pix As Integer, m_ExtYB_pix As Integer ' sopra e sotto ' Estension in mm dell'immagine Private m_ExtXL_mm As Single, m_ExtXR_mm As Single ' sinistra e destra Private m_ExtYT_mm As Single, m_ExtYB_mm As Single ' sopra e sotto + #If WinXP Then Private m_MatDir As Matrix(Of Double) 'HomographyMatrix ' Per creare l'immagine correttta, data la coord. XY, mi dà il pixel da prendere Private m_MatInv As Matrix(Of Double) 'HomographyMatrix ' Per ottenere la coord. in mm da un valore in pixel dell'imm. originale @@ -64,91 +56,36 @@ Public Class clsImageMng Private m_SpessLastra As Double = 0 Private m_SpessCorr As Double = 0 Private _thprocess As Thread = Nothing - Private m_UndistImage As Drawing.Bitmap = Nothing - Private m_FinalImage As Drawing.Bitmap = Nothing - Private m_InputImage As Drawing.Bitmap = Nothing Private m_dim_XProspExt As Integer Private m_dim_YProspExt As Integer Private m_bMatProspOk As Boolean = False Private m_FileCalibLens As String = Nothing Private m_FileCalibProsp As String = Nothing - Private m_widthImagePixMax As Integer = 6000 Private MatConvP(m_dimx, m_dimy) As clPuntoPix Private m_CalimageWidth As Integer = 0 - ' [ fx 0.0 cx ' 0.0 fy cy ' 0.0 0.0 1.0 ] Private _cameraMatrix As Matrix(Of Double) = Nothing ' [ k1, k2, p1, p2, p3 ] Private _distCoeffs As Matrix(Of Double) = Nothing - Private m_fileCaliLensRead As Boolean = False Private m_fileCaliProspRead As Boolean = False Private Shared ReadOnly m_sync As New Object ' vettore di correzione prospettica: convertita in matrice (m_MatDir) Private _perspMatDir As Emgu.CV.Mat - Private _ocvMapx As Emgu.CV.Matrix(Of Single) Private _ocvMapy As Emgu.CV.Matrix(Of Single) Private m_jpgQuality As Long = 80 -#End Region - -#Region "membri pubblici" ' --- variabili per la correzione prospettica Public m_AltRif As Double - Public m_ZCali As Double ' punti world in mm riferiti rispetto all'origine punto_0 (itl=0) Public m_pworld(3) As System.Drawing.PointF ' punti foto riferiti rispetto all'origine immagine Public m_psrc(3) As System.Drawing.PointF -#End Region - -#Region "eventi" - Public Event FineCorrezioneLente() - Public Event FineCorrezioneProspettiva() - Public Event AvanzamentoCorrezioneLente(value As Double) - Public Event AvanzamentoCorrezioneProspettiva(value As Double) - Public Event ProcessAborted(err As Integer) -#End Region - -#Region "Classi Private" - - Private Class clPuntoPix - Public X As Single - Public Y As Single - End Class - Private Class clPuntomm - Public x As Double - Public y As Double - End Class - Private Class clCoppiaPunto - Public XTrg As Double - Public YTrg As Double - Public XSrc As Double - Public YSrc As Double - End Class -#End Region - -#Region "Costruttori" - - Public Sub New() - Dim i As Integer - - For i = 0 To 3 - If IsNothing(m_puntoH(i)) Then m_puntoH(i) = New clCoppiaPunto - Next - m_ProspCalibrated = False - End Sub - Protected Overrides Sub Finalize() - MyBase.Finalize() - End Sub - -#End Region - -#Region "Proprietà" + Private m_UndistImage As Drawing.Bitmap = Nothing Public ReadOnly Property UndistorcedImage As Bitmap Get SyncLock m_sync @@ -156,6 +93,8 @@ Public Class clsImageMng End SyncLock End Get End Property + + Private m_FinalImage As Drawing.Bitmap = Nothing Public ReadOnly Property FinalImage As Bitmap Get SyncLock m_sync @@ -163,6 +102,8 @@ Public Class clsImageMng End SyncLock End Get End Property + + Private m_InputImage As Drawing.Bitmap = Nothing Public Property InputImage As Bitmap Get Return m_InputImage @@ -172,6 +113,7 @@ Public Class clsImageMng End Set End Property + Private m_widthImagePixMax As Integer = 6000 Public Property MaxPxWidthOutImage As Integer Set(value As Integer) m_widthImagePixMax = value @@ -181,30 +123,93 @@ Public Class clsImageMng End Get End Property + Private m_mm2PixelProspFinal As Double Public ReadOnly Property mm2pixelAtZ As Double Get Return m_mm2PixelProspFinal End Get End Property -#End Region + Private m_bCorrected As Boolean = False + Property Corrected() As Boolean + Get + Return m_bCorrected + End Get + Set(ByVal value As Boolean) + m_bCorrected = value + End Set + End Property -#Region "Metodi Pubblici" + Private m_bCorrAltezzaEnabled As Boolean + ReadOnly Property CorrAltEnabled() As Boolean + Get + Return m_bCorrAltezzaEnabled + End Get + End Property + + Public m_ZCali As Double + ReadOnly Property ZCali() As Double + Get + Return m_ZCali + End Get + End Property + + Private m_puntoH(4) As clCoppiaPunto + Property XHpix(ByVal i As Integer) As Short + Get + Return (m_puntoH(i).XSrc) + End Get + Set(ByVal value As Short) + m_puntoH(i).XSrc = value + End Set + End Property + + Property YHpix(ByVal i As Integer) As Short + Get + Return (m_puntoH(i).YSrc) + End Get + Set(ByVal value As Short) + m_puntoH(i).YSrc = value + End Set + End Property + + Public Event FineCorrezioneLente() + Public Event FineCorrezioneProspettiva() + Public Event AvanzamentoCorrezioneLente(value As Double) + Public Event AvanzamentoCorrezioneProspettiva(value As Double) + Public Event ProcessAborted(err As Integer) + +#End Region ' Fields & Properties + +#Region "CONSTRUCTOR" + + Public Sub New() + Dim i As Integer + + For i = 0 To 3 + If IsNothing(m_puntoH(i)) Then m_puntoH(i) = New clCoppiaPunto + Next + m_ProspCalibrated = False + End Sub + +#End Region ' Constructor + +#Region "METHODS" + + Protected Overrides Sub Finalize() + MyBase.Finalize() + End Sub Public Function SetFileCalibrazione(NomeFileCaliLens As String, NomeFileCaliProsp As String) As Boolean - m_FileCalibLens = NomeFileCaliLens m_FileCalibProsp = NomeFileCaliProsp Return True - - End Function - Public Sub Correggi() + Public Sub Correggi() ' corregge solo la lente e carica il file di calibrazione prospettiva per dare la possibilità di calibrare dall'interfaccia Try - If Not m_fileCaliLensRead Then m_fileCaliLensRead = LeggiFileCalibrazioneLenteOCV(m_FileCalibLens) End If @@ -214,39 +219,31 @@ Public Class clsImageMng End If If Not m_UndistImage Is Nothing Then - 'm_UndistImage.Dispose() m_UndistImage = Nothing End If Dim outFrame As New Image(Of Emgu.CV.Structure.Rgb, Byte)(m_InputImage.Width, m_InputImage.Height) - Dim newIntrinsecMatrix As IInputArray + Dim newIntrinsecMatrix As IInputArray = Nothing CvInvoke.Undistort(New Image(Of Emgu.CV.Structure.Rgb, Byte)(m_InputImage), outFrame, _cameraMatrix, _distCoeffs, newIntrinsecMatrix) m_UndistImage = outFrame.Bitmap - GC.Collect() - m_UndistImage.Save(DirTmp & "corrected.bmp", System.Drawing.Imaging.ImageFormat.Bmp) - m_bCorrected = True RaiseEvent AvanzamentoCorrezioneProspettiva(100) - Catch ex As Exception - If Not m_UndistImage Is Nothing Then - 'm_UndistImage.Dispose() m_UndistImage = Nothing End If Throw New Exception(ex.Message) End Try - End Sub + Public Sub DownloadCompletato() m_bCorrected = False End Sub - '* c00*xi + c01*yi + c02 '* ui = --------------------- '* c20*xi + c21*yi + c22 @@ -254,9 +251,7 @@ Public Class clsImageMng '* c10*xi + c11*yi + c12 '* vi = --------------------- '* c20*xi + c21*yi + c22 - Public Sub CorreggiProspettiva(ByVal SpessLastra As Double) - If Not m_bMatProspOk Then CalcolaMatriceCorrezioneProspettiva() CalcolaMatriceOCV() @@ -265,8 +260,8 @@ Public Class clsImageMng If m_bMatProspOk Then CorreggiProspettivaDaMatriceOCV(SpessLastra) End If - End Sub + Public Sub CalcolaDatiCorrezione() ' forzo il ricalcolo m_ProspCalibrated = False @@ -282,7 +277,6 @@ Public Class clsImageMng Dim i As Integer Dim nfi As New CultureInfo("en-US", False) - writer = New StreamWriter(m_NomeFileCorrezProsp) writer.WriteLine("ProspPnt") For i = 0 To 3 @@ -301,7 +295,6 @@ Public Class clsImageMng writer.WriteLine("ImageWidth= {0}", m_CalimageWidth.ToString("0")) writer.Close() CalcolaMatriceCorrezioneProspettiva() - End Sub Public Sub ProcessStop() @@ -311,11 +304,9 @@ Public Class clsImageMng _thprocess.Abort() _thprocess = Nothing End If - - End Sub - Public Sub CorrezioneCompletaAsync() + Public Sub CorrezioneCompletaAsync() ProcessStop() _thprocess = New Thread(Sub() @@ -323,12 +314,9 @@ Public Class clsImageMng End Sub) _thprocess.Start() - End Sub Public Sub SaveBitmap(bitm As Bitmap, fileName As String) - - ' Encoder parameter for image quality Dim qualityParam As New EncoderParameter(Encoder.Quality, m_jpgQuality) ' Jpeg image codec @@ -338,29 +326,19 @@ Public Class clsImageMng encoderParams.Param(0) = qualityParam bitm.Save(fileName, jpegCodec, encoderParams) - - End Sub -#End Region - -#Region "Metodi Privati" - - Private Function TrovaPuntoInmm4p(ByVal p As clCoppiaPunto) As Boolean - p.XTrg = (m_MatInv(0, 0) * p.XSrc + m_MatInv(0, 1) * p.YSrc + m_MatInv(0, 2)) / (m_MatInv(2, 0) * p.XSrc + m_MatInv(2, 1) * p.YSrc + m_MatInv(2, 2)) p.YTrg = (m_MatInv(1, 0) * p.XSrc + m_MatInv(1, 1) * p.YSrc + m_MatInv(1, 2)) / (m_MatInv(2, 0) * p.XSrc + m_MatInv(2, 1) * p.YSrc + m_MatInv(2, 2)) TrovaPuntoInmm4p = True - End Function Private Function TrovaDatiScalatura() As Boolean - ' trova il centro di scala e il fattore di scala in altezza, per mm - Dim a1, b1, c1, a2, b2, c2 As Double Dim denominatore As Double + Dim distl, disth As Double TrovaDatiScalatura = False @@ -391,9 +369,6 @@ Public Class clsImageMng Exit Function End If - - Dim distl, disth As Double - distl = (m_scale_center.x - m_puntoH(0).XTrg) * (m_scale_center.x - m_puntoH(0).XTrg) + (m_scale_center.y - m_puntoH(0).YTrg) * (m_scale_center.y - m_puntoH(0).YTrg) distl = Math.Sqrt(distl) @@ -406,16 +381,14 @@ Public Class clsImageMng m_scale_centerZ = m_ZCali + m_AltRif / (1 - distl / disth) TrovaDatiScalatura = True - End Function Private Function TrovaOffsetPosizione() As Boolean Dim pt As New clPuntomm Dim pTmp As New clCoppiaPunto - Dim offset As New clPuntomm ' calcolato - Try + Try ' trovo come si trasforma in mm (senza offset) il punto di origine in pixel pTmp.XSrc = m_punto0.XSrc pTmp.YSrc = m_punto0.YSrc @@ -429,17 +402,13 @@ Public Class clsImageMng ' Trovo dove si trova il punto in pixel in basso a sin m_pmm_bs_lev0.x = m_pmm_bs.x + offset.x m_pmm_bs_lev0.y = m_pmm_bs.y + offset.y - Catch ex As Exception Return False End Try Return True - End Function -#Region "Lettura configurazioni" - ''' ''' Legge il file che contiene i parametri di correzione della lente ''' @@ -452,12 +421,10 @@ Public Class clsImageMng Dim Linea As String Dim split() As String Dim reader As StreamReader - Dim i, j As Integer Dim nfi As NumberFormatInfo = New CultureInfo("en-US", False).NumberFormat Dim CalibType As Integer = 0 Dim FileVersion As Integer = 0 - If _cameraMatrix Is Nothing Then _cameraMatrix = New Matrix(Of Double)(3, 3) End If @@ -465,20 +432,6 @@ Public Class clsImageMng _distCoeffs = New Matrix(Of Double)(1, 4) End If - 'CalibType = 1 - 'FileVersion = 1 - 'rms = 2.912043 - 'fx = 4775.944905 - 'fy = 4775.944905 - 'cx = 3103.561924 - 'cy = 2033.648165 - 'k1 = -0.153547 - 'k2 = 0.127935 - 'p1 = -0.00626 - 'p2 = -0.000005 - 'hfov = 66Deg - 'vfov = 46.1Deg - '[fx 0 cx; 0 fy cy; 0 0 1] ' setto i coefficenti fissi: _cameraMatrix.Data(0, 1) = 0 @@ -490,19 +443,16 @@ Public Class clsImageMng Try nfi.NumberDecimalSeparator = "." reader = New StreamReader(NomeFile) - While (Not reader.EndOfStream) Linea = reader.ReadLine() split = Linea.Split(" =", 5, StringSplitOptions.RemoveEmptyEntries) If split.Length > 0 Then - If split(0).Equals("CalibType", StringComparison.InvariantCultureIgnoreCase) Then CalibType = CInt(split(1)) ElseIf split(0).Equals("FileVersion", StringComparison.InvariantCultureIgnoreCase) Then FileVersion = CInt(split(1)) ElseIf (Linea.StartsWith("rms")) Then ' non carico dato - ' CAMERA MATRIX ElseIf (Linea.StartsWith("fx")) Then _cameraMatrix.Data(0, 0) = Convert.ToDouble(split(1), nfi) @@ -521,7 +471,6 @@ Public Class clsImageMng _distCoeffs.Data(0, 2) = Convert.ToDouble(split(1), nfi) ElseIf (Linea.StartsWith("p2")) Then _distCoeffs.Data(0, 3) = Convert.ToDouble(split(1), nfi) - ElseIf (Linea.StartsWith("hfov")) Then ' non carico dato ElseIf (Linea.StartsWith("vfov")) Then @@ -532,7 +481,6 @@ Public Class clsImageMng ' non carico dato End If End If - End While reader.Close() @@ -546,23 +494,12 @@ Public Class clsImageMng If FileVersion <> 1 Then MsgBox("FileVersion error in file: " & NomeFile) End If - - ' alla prima acquisizione immagine si controllerà - ' controllare se le dimensioni dell'immagine usata per la calibrazione coincidono con quelle attuali - - ' ScalaCalibrazione() - - ' If creaMatrice Then - ' CreaMatriceCalibrazione() - ' End If - Catch ex As Exception MsgBox("Calibration error : " & NomeFile) Return False End Try Return True - End Function ''' @@ -590,7 +527,6 @@ Public Class clsImageMng ' m_nPixOut = 0 While (Not reader.EndOfStream) Linea = reader.ReadLine() - If (Linea.StartsWith("ProspPnt")) Then For i = 0 To 3 Linea = reader.ReadLine() @@ -600,41 +536,36 @@ Public Class clsImageMng m_psrc(i).X = Convert.ToSingle(split(2), nfi) m_psrc(i).Y = Convert.ToSingle(split(3), nfi) Next - ElseIf (Linea.StartsWith("Extend=")) Then split = Linea.Split(delimiter, 8, StringSplitOptions.RemoveEmptyEntries) m_ExtXL_mm = Convert.ToSingle(split(1), nfi) m_ExtXR_mm = Convert.ToSingle(split(2), nfi) m_ExtYT_mm = Convert.ToSingle(split(3), nfi) m_ExtYB_mm = Convert.ToSingle(split(4), nfi) - ElseIf (Linea.StartsWith("AltRif=")) Then split = Linea.Split(delimiter, 5, StringSplitOptions.RemoveEmptyEntries) m_AltRif = Convert.ToDouble(split(1), nfi) - ElseIf (Linea.StartsWith("p1Rif=")) Then split = Linea.Split(delimiter, 8, StringSplitOptions.RemoveEmptyEntries) m_puntoH(0).XSrc = Convert.ToDouble(split(1)) m_puntoH(0).YSrc = Convert.ToDouble(split(2)) m_puntoH(1).XSrc = Convert.ToDouble(split(3)) m_puntoH(1).YSrc = Convert.ToDouble(split(4)) - ElseIf (Linea.StartsWith("p2Rif=")) Then split = Linea.Split(delimiter, 8, StringSplitOptions.RemoveEmptyEntries) m_puntoH(2).XSrc = Convert.ToDouble(split(1)) m_puntoH(2).YSrc = Convert.ToDouble(split(2)) m_puntoH(3).XSrc = Convert.ToDouble(split(3)) m_puntoH(3).YSrc = Convert.ToDouble(split(4)) - ElseIf (Linea.StartsWith("ZCali=")) Then split = Linea.Split(delimiter, 8, StringSplitOptions.RemoveEmptyEntries) m_ZCali = Convert.ToDouble(split(1), nfi) - ElseIf (Linea.StartsWith("ImageWidth=")) Then split = Linea.Split(delimiter, 8, StringSplitOptions.RemoveEmptyEntries) m_CalimageWidth = Convert.ToDouble(split(1), nfi) End If End While + reader.Close() reader.Dispose() Catch ex As Exception @@ -644,57 +575,15 @@ Public Class clsImageMng CalcolaDatiCorrezione() Return True - - End Function -#End Region ' Lettura configurazioni - - Property Corrected() As Boolean - Get - Return m_bCorrected - End Get - Set(ByVal value As Boolean) - m_bCorrected = value - End Set - End Property - - ReadOnly Property CorrAltEnabled() As Boolean - Get - Return m_bCorrAltezzaEnabled - End Get - End Property - ReadOnly Property ZCali() As Double - Get - Return m_ZCali - End Get - End Property - Property XHpix(ByVal i As Integer) As Short - Get - Return (m_puntoH(i).XSrc) - End Get - Set(ByVal value As Short) - m_puntoH(i).XSrc = value - End Set - End Property - - Property YHpix(ByVal i As Integer) As Short - Get - Return (m_puntoH(i).YSrc) - End Get - Set(ByVal value As Short) - m_puntoH(i).YSrc = value - End Set - End Property - -#Region "Caolcolo matrici di correzione prospettica" +#Region "Calcolo matrici di correzione prospettica" ''' ''' Ottine la matrice 'm_MatDir' di correzione prospettica ''' Viene richiamato il metodo 'CalcolaDatiCorrezioneDiretta' ''' Private Sub CalcolaDatiCorrezioneDiretta() - ' L'immagine da rettificare non è un rettangolo CalcolaDatiCorrezioneDirettaNoRett() ' Se ' CalcolaDatiCorrezioneDirettaNoRett' andata a buon fine 'm_ProspCalibrated=true' @@ -769,15 +658,12 @@ Public Class clsImageMng m_Pos_x_z0_mm = m_pworld(ibl).X - m_ExtXL_mm m_Pos_y_z0_mm = m_pworld(ibl).Y - m_ExtYB_mm m_ProspCalibrated = True - - End Sub ''' ''' Ottiene la matrice 'm_MatDir' per la correzione prospettica nel piano Z=0 ''' Private Sub CalcolaDatiCorrezioneDirettaNoRett() - Dim distmm As Double, distpix As Double, mm2pix As Double Dim distXMax As Double, distYMax As Double @@ -867,15 +753,12 @@ Public Class clsImageMng m_Pos_x_z0_mm = m_pworld(ibl).X - m_ExtXL_mm m_Pos_y_z0_mm = m_pworld(ibl).Y - m_ExtYB_mm m_ProspCalibrated = True - - End Sub ''' ''' Ottiene la matrice 'm_MatInv' per la correzione prospettica nel piano Z=0 ''' Private Sub CalcolaDatiCorrezioneInversa() - Dim i As Integer For i = 0 To 3 @@ -897,14 +780,12 @@ Public Class clsImageMng Next Next #End If - End Sub #End Region ' Calcolo matrici di correzione prospettica ' Crea file FinalImage.txt Private Sub SaveDataImage(NomeFile As String) - Dim writer As New StreamWriter(NomeFile) writer.WriteLine("X = {0}", m_Pos_x_mm.ToString("F9", CultureInfo.InvariantCulture)) @@ -920,10 +801,8 @@ Public Class clsImageMng writer.Close() End Sub - Public Sub CorrezioneCompleta(Optional rEvents As Boolean = True) Try - m_UndistImage = Nothing Console.WriteLine("RICHIESTA CORREZIONE DISTORSIONE: " & MainModule.IndexProc) @@ -942,13 +821,9 @@ Public Class clsImageMng Catch ex As Exception RaiseEvent ProcessAborted(-1) End Try - End Sub - - Private Sub CalcolaMatriceCorrezioneProspettiva() - Dim ix As Integer, iy As Integer Dim px As Single, py As Single Dim m00 As Double, m01 As Double, m02 As Double @@ -957,8 +832,6 @@ Public Class clsImageMng Dim m01iy As Double, m11iy As Double, m21iy As Double Try - - If m_UndistImage Is Nothing Then Return m_dimx = m_UndistImage.Width m_dimy = m_UndistImage.Height @@ -968,12 +841,10 @@ Public Class clsImageMng m_SpessLastra = SpessLastra ' correggo calcolando i pixel (con funzione opencv non riesco a estendere) - m00 = m_MatDir(0, 0) : m01 = m_MatDir(0, 1) : m02 = m_MatDir(0, 2) m10 = m_MatDir(1, 0) : m11 = m_MatDir(1, 1) : m12 = m_MatDir(1, 2) m20 = m_MatDir(2, 0) : m21 = m_MatDir(2, 1) : m22 = m_MatDir(2, 2) - m_dim_XProspExt = m_dim_XProsp + m_ExtXL_pix + m_ExtXR_pix m_dim_YProspExt = m_dim_YProsp + m_ExtYT_pix + m_ExtYB_pix @@ -986,12 +857,10 @@ Public Class clsImageMng m21iy = m21 * iy2 For ix = 0 To m_dim_XProspExt - 1 - Dim ix2 As Short = ix - m_ExtXL_pix px = (m00 * ix2 + m01iy + m02) / (m20 * ix2 + m21iy + m22) py = (m10 * ix2 + m11iy + m12) / (m20 * ix2 + m21iy + m22) MatConvP(ix, iy) = New clPuntoPix - If px >= 0 And px < m_dimx And py >= 0 AndAlso py < m_dimy Then MatConvP(ix, iy).X = px MatConvP(ix, iy).Y = py @@ -999,20 +868,16 @@ Public Class clsImageMng MatConvP(ix, iy).X = -1 MatConvP(ix, iy).Y = -1 End If - - Next Next m_bMatProspOk = True - Catch ex As Exception m_bMatProspOk = False Throw New Exception(ex.Message) End Try - - End Sub + Private Sub CorreggiProspettivaDaMatriceOCV(spessLastra As Double) Console.WriteLine("INIZIO CREAZIONE IMMAGINE CON CORREZIONE OCV") @@ -1044,24 +909,21 @@ Public Class clsImageMng Return Nothing End Function - Private Sub CalcolaMatriceOCV() + Private Sub CalcolaMatriceOCV() Dim ix As Integer, iy As Integer + _ocvMapx = New Matrix(Of Single)(m_dim_YProspExt, m_dim_XProspExt) _ocvMapy = New Matrix(Of Single)(m_dim_YProspExt, m_dim_XProspExt) - For iy = 0 To m_dim_YProspExt - 1 For ix = 0 To (m_dim_XProspExt - 1) _ocvMapx(iy, ix) = MatConvP(ix, iy).X _ocvMapy(iy, ix) = MatConvP(ix, iy).Y Next Next - - End Sub - Private Sub CalcolaCorrezioniAltezza() ' fattore di scala data la nuova altezza Dim fattScala As Double @@ -1076,29 +938,28 @@ Public Class clsImageMng m_Pos_y_mm = m_Pos_y_mm * fattScala m_Pos_x_mm = m_Pos_x_mm + m_scale_center.x m_Pos_y_mm = m_Pos_y_mm + m_scale_center.y - End Sub + Public Sub SaveClickMsg(numerr As Integer) Dim NomeFile As String - Dim nf As Integer + NomeFile = SaveDir & "click.txt" nf = FreeFile() FileOpen(nf, NomeFile, OpenMode.Output) Print(nf, "Err=" & numerr.ToString) FileClose(nf) - End Sub + ' questa è la correzione inversa a quello che mi serve... Public Function CorreggiPunto(p As Point) As Point Dim po As Point + po.X = MatConvP(p.X, p.Y).X po.Y = MatConvP(p.X, p.Y).Y Return po End Function -#End Region - Public Sub FreeImages() If m_UndistImage IsNot Nothing Then m_UndistImage.Dispose() m_UndistImage = Nothing @@ -1115,7 +976,6 @@ Public Class clsImageMng CalcolaCorrezioniAltezza() ppx.X = (pmm.X - m_Pos_x_mm) * m_mm2PixelProspFinal ppx.Y = m_FinalImage.Height - (pmm.Y - m_Pos_y_mm) * m_mm2PixelProspFinal - End Sub Public Sub Pix2MMOnUndist(ppx As PointF, ByRef pmm As PointF) @@ -1131,30 +991,42 @@ Public Class clsImageMng Try If FinalImage Is Nothing Then Return False - Dim cvimage As New Image(Of Emgu.CV.Structure.Bgr, Byte)(FinalImage) - Dim x1 As Integer = Math.Min(xLeft, xRight) Dim y1 As Integer = Math.Min(yTop, yBottom) Dim w As Integer = Math.Abs(xRight - xLeft) Dim h As Integer = Math.Abs(yBottom - yTop) - Dim rmodel As New Rectangle(x1, y1, w, h) + cvimage.ROI = rmodel cvimage.Save(FileName) - Return True Catch ex As Exception Return False End Try - End Function +#End Region ' Conversioni da mm a pixel e viceversa su Img già raddrizzata -#End Region +#End Region ' Methods End Class +Public Class clPuntoPix + Public X As Single + Public Y As Single +End Class +Public Class clPuntomm + Public x As Double + Public y As Double +End Class + +Public Class clCoppiaPunto + Public XTrg As Double + Public YTrg As Double + Public XSrc As Double + Public YSrc As Double +End Class diff --git a/CameraMng/clsImageMng/clsRicerca.vb b/CameraMng/clsImageMng/clsRicerca.vb index 23c3a40..cc6f2be 100644 --- a/CameraMng/clsImageMng/clsRicerca.vb +++ b/CameraMng/clsImageMng/clsRicerca.vb @@ -1,12 +1,11 @@ -Imports Emgu -Imports Emgu.CV -Imports Emgu.CV.Util -Imports Emgu.CV.Structure +Imports Emgu.CV Imports System.IO Imports System.Globalization Public Class clsRicerca +#Region "FIELDS & PROPERTIES" + Private Structure stStepSearch Public ModelFile() As String Public Name As String ' numero/nome della ventosa @@ -21,27 +20,46 @@ Public Class clsRicerca Public foundPosmm As PointF End Structure - Private _imageMng As clsImageMng = Nothing Private _image1 As Bitmap = Nothing Private _searchList As List(Of stStepSearch) = Nothing - Private _searchImage As Image(Of Emgu.CV.Structure.Bgr, Byte) Public Event LogMessage(msg As String) Private _numVentoseKO As Integer = 0 - Private _writeDate As Boolean = True Private rosso As New Emgu.CV.Structure.MCvScalar(0, 0, 255) Private verde As New Emgu.CV.Structure.MCvScalar(0, 255, 0) Private blu As New Emgu.CV.Structure.MCvScalar(255, 0, 0) Private nero As New Emgu.CV.Structure.MCvScalar(0, 0, 0) + Private _searchImage As Image(Of Emgu.CV.Structure.Bgr, Byte) + Public ReadOnly Property FinalImage As Bitmap + Get + Return If(_searchImage Is Nothing, Nothing, _searchImage.Bitmap) + End Get + End Property + Private _writeDate As Boolean = True + Public Property WriteDate As Boolean + Set(value As Boolean) + _writeDate = value + End Set + Get + Return _writeDate + End Get + End Property + +#End Region ' Fields & Properties + +#Region "CONSTRUCTOR" Public Sub New(imgMng As clsImageMng) _imageMng = imgMng End Sub - Public Sub Ricerca() +#End Region ' Constructor +#Region "METHODS" + + Public Sub Ricerca() Dim searchStep As stStepSearch _numVentoseKO = 0 @@ -59,20 +77,14 @@ Public Class clsRicerca Next SaveRisultatiRicerca(0) - - End Sub Private Sub DebugRisultato(sStep As stStepSearch) - Try - - ' casomai fosse rimasto un ROI _searchImage.ROI = Nothing ' caso in cui non esiste il modello - ' non esiste il file modello If (sStep.ModelFile Is Nothing OrElse sStep.ModelFile.Length = 0) Then ScriviTesto(_searchImage, sStep.Name & "?", sStep.reqPospx.X, sStep.reqPospx.Y, blu, 5, 3) @@ -85,12 +97,11 @@ Public Class clsRicerca Dim x0, y0 As Integer Dim modelImage As Emgu.CV.Image(Of Emgu.CV.Structure.Bgr, Byte) = Nothing Dim TolPix As Integer = CInt(sStep.Toldist * _imageMng.mm2pixelAtZ) - - Dim nmodel As Integer = Math.Max(0, sStep.ifound) ' prendo il primo modello per disegnare il rettangolo modelImage = New Emgu.CV.Image(Of Emgu.CV.Structure.Bgr, Byte)(New Bitmap(sStep.ModelFile(nmodel))) + ' disegno la regione di ricerca del primo modello specificato Dim regWidth As Integer = modelImage.Width Dim regHeight As Integer = modelImage.Height @@ -105,22 +116,18 @@ Public Class clsRicerca y0 = Math.Max(0, y0) regWidth = Math.Min(regWidth, _searchImage.Width - x0) regHeight = Math.Min(regHeight, _searchImage.Height - y0) - regioneRicerca = New System.Drawing.Rectangle(x0, y0, regWidth, regHeight) If sStep.req Then - If sStep.ifound < 0 Then 'non trovato DisegnaRettangoloX(_searchImage, regioneRicerca, rosso, 5) - ScriviTesto(_searchImage, sStep.Name, regioneRicerca.Location.X + regioneRicerca.Width / 2, - regioneRicerca.Location.Y + regioneRicerca.Height / 2, rosso, 5, 3) + ScriviTesto(_searchImage, sStep.Name, regioneRicerca.Location.X + regioneRicerca.Width / 2, regioneRicerca.Location.Y + regioneRicerca.Height / 2, rosso, 5, 3) _numVentoseKO += 1 Else - DisegnaRettangolo(_searchImage, regioneRicerca, blu, 5) - ' la regione modello la posiziono nel punto dove l'ha trovata + ' la regione modello la posiziono nel punto dove l'ha trovata regWidth = modelImage.Width regHeight = modelImage.Height @@ -134,30 +141,21 @@ Public Class clsRicerca regioneVentosa = New System.Drawing.Rectangle(x0, y0, regWidth, regHeight) DisegnaRettangolo(_searchImage, regioneVentosa, verde, 3) - ScriviTesto(_searchImage, sStep.Name, regioneVentosa.Location.X + regioneVentosa.Width / 2, - regioneVentosa.Location.Y + regioneVentosa.Height / 2, verde, 5, 3) - + ScriviTesto(_searchImage, sStep.Name, regioneVentosa.Location.X + regioneVentosa.Width / 2, regioneVentosa.Location.Y + regioneVentosa.Height / 2, verde, 5, 3) End If - ' caso in cui non deve esserci nulla Else - If sStep.ifound < 0 Then - 'non trovato e va bene - DisegnaRettangolo(_searchImage, regioneRicerca, verde, 5) - ScriviTesto(_searchImage, sStep.Name, regioneRicerca.Location.X + regioneRicerca.Width / 2, - regioneRicerca.Location.Y + regioneRicerca.Height / 2, verde, 5, 3) - + ScriviTesto(_searchImage, sStep.Name, regioneRicerca.Location.X + regioneRicerca.Width / 2, regioneRicerca.Location.Y + regioneRicerca.Height / 2, verde, 5, 3) Else - ' ho trovato e non va bene _numVentoseKO += 1 DisegnaRettangolo(_searchImage, regioneRicerca, rosso, 5) - ' la regione modello la posiziono nel punto dove l'ha trovata + ' la regione modello la posiziono nel punto dove l'ha trovata regWidth = modelImage.Width regHeight = modelImage.Height @@ -171,40 +169,25 @@ Public Class clsRicerca regioneVentosa = New System.Drawing.Rectangle(x0, y0, regWidth, regHeight) DisegnaRettangolo(_searchImage, regioneVentosa, rosso, 3) - ScriviTesto(_searchImage, sStep.Name, regioneVentosa.Location.X + regioneVentosa.Width / 2, - regioneVentosa.Location.Y + regioneVentosa.Height / 2, rosso, 5, 3) - + ScriviTesto(_searchImage, sStep.Name, regioneVentosa.Location.X + regioneVentosa.Width / 2, regioneVentosa.Location.Y + regioneVentosa.Height / 2, rosso, 5, 3) End If - - - End If - Catch ex As Exception _numVentoseKO += 1 End Try - - End Sub + Private Sub RicercaStep(ByRef sStep As stStepSearch) - - Try - - Dim resultImage As Emgu.CV.Image(Of Emgu.CV.Structure.Gray, Single) - Dim regioneRicerca As System.Drawing.Rectangle = Nothing Dim regioneVentosa As System.Drawing.Rectangle = Nothing Dim x0, y0 As Integer Dim TolPix As Integer = CInt(sStep.Toldist * _imageMng.mm2pixelAtZ) + Dim modelImage As Emgu.CV.Image(Of Emgu.CV.Structure.Bgr, Byte) = Nothing sStep.ifound = -1 - - - Dim modelImage As Emgu.CV.Image(Of Emgu.CV.Structure.Bgr, Byte) = Nothing - ' se non c'è il modello esco If (sStep.ModelFile Is Nothing OrElse sStep.ModelFile.Length = 0) Then Return @@ -213,9 +196,7 @@ Public Class clsRicerca ReDim sStep.score(sStep.ModelFile.Length) For n As Integer = 0 To sStep.ModelFile.Length - 1 - Try - ' leggo il modello modelImage = New Emgu.CV.Image(Of Emgu.CV.Structure.Bgr, Byte)(New Bitmap(sStep.ModelFile(n))) @@ -228,7 +209,6 @@ Public Class clsRicerca x0 = Math.Max(0, x0) y0 = Math.Max(0, y0) - regioneVentosa = New System.Drawing.Rectangle(x0, y0, regWidth, regHeight) ' fisso la regione Ricerca @@ -262,21 +242,14 @@ Public Class clsRicerca sStep.ifound = n Return End If - Catch ex As Exception _searchImage.ROI = Nothing End Try - Next - Catch ex As Exception - End Try - - End Sub - Public Sub GeneraIstruzioniRicerca(NomeFilePos As String, minscore As Double, toldist As Double) Dim reader As StreamReader = Nothing Dim nfi As NumberFormatInfo = New CultureInfo("en-US", False).NumberFormat @@ -307,8 +280,8 @@ Public Class clsRicerca y = Double.Parse(strLine.Split(",", 3, StringSplitOptions.RemoveEmptyEntries)(1), nfi) vt = CInt(strLine.Split(",", 3, StringSplitOptions.RemoveEmptyEntries)(2)) - Dim vs As stStepSearch - Dim p As PointF + Dim vs As stStepSearch = Nothing + Dim p As PointF = Nothing _imageMng.MM2PixOnUndist(New PointF(x, y), p) vs.reqPospx = New Point(p.X, p.Y) @@ -358,39 +331,20 @@ Public Class clsRicerca End Sub - Public ReadOnly Property FinalImage As Bitmap - Get - Return If(_searchImage Is Nothing, Nothing, _searchImage.Bitmap) - End Get - End Property - - Public Property WriteDate As Boolean - Set(value As Boolean) - _writeDate = value - End Set - Get - Return _writeDate - End Get - End Property - - Private Sub SaveRisultatiRicerca(numerr As Integer) + Dim NomeFile As String + Dim nf As Integer ' per ora faccio questo _imageMng.SaveClickMsg(numerr) - Dim NomeFile As String - - - Dim nf As Integer NomeFile = VacFileEnd nf = FreeFile() FileOpen(nf, NomeFile, OpenMode.Output) PrintLine(nf, "Err=" & _numVentoseKO) FileClose(nf) - - End Sub + #If WinXp Then Private Sub DisegnaRettangolo(img As Image(Of Emgu.CV.Structure.Bgr, Byte), r As Rectangle, colore As Emgu.CV.Structure.MCvScalar, spessore As Integer) @@ -427,35 +381,22 @@ Public Class clsRicerca #Else - Private Sub DisegnaRettangolo(img As Image(Of Emgu.CV.Structure.Bgr, Byte), r As Rectangle, - colore As Emgu.CV.Structure.MCvScalar, spessore As Integer) + Private Sub DisegnaRettangolo(img As Image(Of Emgu.CV.Structure.Bgr, Byte), r As Rectangle, colore As Emgu.CV.Structure.MCvScalar, spessore As Integer) Emgu.CV.CvInvoke.Rectangle(_searchImage, r, colore, spessore) - - End Sub - Private Sub DisegnaRettangoloX(img As Image(Of Emgu.CV.Structure.Bgr, Byte), r As Rectangle, - colore As Emgu.CV.Structure.MCvScalar, spessore As Integer) - Emgu.CV.CvInvoke.Rectangle(_searchImage, r, colore, spessore) - - - Emgu.CV.CvInvoke.Line(_searchImage, r.Location, New Point(r.Location.X + r.Width, r.Location.Y + r.Height), - colore, spessore, Emgu.CV.CvEnum.LineType.FourConnected, 0) - - Emgu.CV.CvInvoke.Line(_searchImage, New Point(r.Location.X, r.Location.Y + r.Height), - New Point(r.Location.X + r.Width, r.Location.Y), - colore, spessore, Emgu.CV.CvEnum.LineType.FourConnected, 0) - End Sub - Public Sub ScriviTesto(img As Image(Of Emgu.CV.Structure.Bgr, Byte), testo As String, x As Integer, y As Integer, - colore As Emgu.CV.Structure.MCvScalar, scala As Double, spessore As Integer) - - Emgu.CV.CvInvoke.PutText(img, testo, New Point(x, y + 30), CvEnum.FontFace.HersheyPlain, - scala, colore, spessore, CvEnum.LineType.AntiAlias) + Private Sub DisegnaRettangoloX(img As Image(Of Emgu.CV.Structure.Bgr, Byte), r As Rectangle, colore As Emgu.CV.Structure.MCvScalar, spessore As Integer) + Emgu.CV.CvInvoke.Rectangle(_searchImage, r, colore, spessore) + Emgu.CV.CvInvoke.Line(_searchImage, r.Location, New Point(r.Location.X + r.Width, r.Location.Y + r.Height), colore, spessore, Emgu.CV.CvEnum.LineType.FourConnected, 0) + Emgu.CV.CvInvoke.Line(_searchImage, New Point(r.Location.X, r.Location.Y + r.Height), New Point(r.Location.X + r.Width, r.Location.Y), colore, spessore, Emgu.CV.CvEnum.LineType.FourConnected, 0) + End Sub + Public Sub ScriviTesto(img As Image(Of Emgu.CV.Structure.Bgr, Byte), testo As String, x As Integer, y As Integer, colore As Emgu.CV.Structure.MCvScalar, scala As Double, spessore As Integer) + Emgu.CV.CvInvoke.PutText(img, testo, New Point(x, y + 30), CvEnum.FontFace.HersheyPlain, scala, colore, spessore, CvEnum.LineType.AntiAlias) End Sub #End If - +#End Region ' Methods End Class diff --git a/CameraMng/clsImageMng/clsVisione.vb b/CameraMng/clsImageMng/clsVisione.vb index bac1c08..279be73 100644 --- a/CameraMng/clsImageMng/clsVisione.vb +++ b/CameraMng/clsImageMng/clsVisione.vb @@ -4,9 +4,10 @@ Imports Emgu.CV.Util Imports Emgu.CV.Structure Imports System.IO - Public Class clsVisione +#Region "FIELDS & PROPERTIES" + Public Enum Errors None = 0 Unknown = 10 @@ -20,20 +21,15 @@ Public Class clsVisione AvgFactor = 4 End Enum - Private _image1 As Bitmap = Nothing - Private _backImage As Bitmap = Nothing Private _convBackImage As Bitmap = Nothing - Private _error As Errors Private _exifValid As Boolean = False Private _aperture As Double Private _focalLength As Double Private _iso As Short Private _exptime As Double Private _imageMng As clsImageMng = Nothing - Private _outimage As Image(Of Emgu.CV.Structure.Rgb, Byte) Private _corImgDiff As Image(Of Emgu.CV.Structure.Gray, Byte) Private _thrImage As Image(Of Emgu.CV.Structure.Gray, Byte) - Private _pdown As Integer = 0 Private _corImgDiff0 As Image(Of Emgu.CV.Structure.Gray, Byte) = Nothing Private _corImgDiff1 As Image(Of Emgu.CV.Structure.Gray, Byte) = Nothing Private _corImgDiff2 As Image(Of Emgu.CV.Structure.Gray, Byte) = Nothing @@ -43,21 +39,18 @@ Public Class clsVisione Private _searchMode As CvEnum.RetrType = CvEnum.RetrType.External #End If Private _rectExp() As Rectangle = Nothing - Private _expCorrection As eExpCorrMode = eExpCorrMode.none Private _mm() As Integer - Private _metodoDiff As Integer = 1 Private _rectLastra As Rectangle = Nothing Private _darkRappLevel As Double = 1 Private _thFactor As Double = 1 - Private _thFactorNero As Double = 0.4 - Private _bnero As Boolean = False #If WinXp Then Private _iterpType As CvEnum.INTER = CvEnum.INTER.CV_INTER_LINEAR #Else - Private _iterpType As CvEnum.INTER = CvEnum.INTER.Linear + Private _iterpType As CvEnum.Inter = CvEnum.Inter.Linear #End If + Private _image1 As Bitmap = Nothing Public Property Image1 As Bitmap Set(value As Bitmap) DisposeImage1() @@ -68,6 +61,7 @@ Public Class clsVisione End Get End Property + Private _backImage As Bitmap = Nothing Public Property BackImage As Bitmap Set(value As Bitmap) DisposeBackImage() @@ -77,15 +71,9 @@ Public Class clsVisione Return _backImage End Get End Property - Public ReadOnly Property FinalImage As Bitmap - Get - Return If(_outimage Is Nothing, Nothing, _outimage.Bitmap) - End Get - End Property Public WriteOnly Property BackImageFile As String Set(FileName As String) - Try BackImage = New Bitmap(FileName) Catch ex As Exception @@ -105,9 +93,17 @@ Public Class clsVisione Catch ex As Exception _exifValid = False End Try - End Set End Property + + Private _outimage As Image(Of Emgu.CV.Structure.Rgb, Byte) + Public ReadOnly Property FinalImage As Bitmap + Get + Return If(_outimage Is Nothing, Nothing, _outimage.Bitmap) + End Get + End Property + + Private _pdown As Integer = 0 Public Property ReduceImage As Integer Get Return _pdown @@ -136,6 +132,7 @@ Public Class clsVisione End Property #End If + Private _expCorrection As eExpCorrMode = eExpCorrMode.none Property ExpCorrType As eExpCorrMode Get Return _expCorrection @@ -144,6 +141,8 @@ Public Class clsVisione _expCorrection = value End Set End Property + + Private _metodoDiff As Integer = 1 Property BorderType As Integer Get Return _metodoDiff @@ -152,6 +151,8 @@ Public Class clsVisione _metodoDiff = value End Set End Property + + Private _thFactorNero As Double = 0.4 Property ThFactorNero As Double Set(value As Double) _thFactorNero = value @@ -160,17 +161,30 @@ Public Class clsVisione Return _thFactorNero End Get End Property + + Private _bnero As Boolean = False Public ReadOnly Property Nero As Boolean Get Return _bnero End Get End Property + + Private _error As Errors + Public ReadOnly Property IsInError As Boolean + Get + Return (_error <> Errors.None) + End Get + End Property + +#End Region ' Fields & Properties + +#Region "METHODS" + ''' ''' Aggiunge una zona rettangolare pe l'analisi ispezione ''' ''' Public Sub AddExpRectangle(xLeft As Integer, yTop As Integer, xRight As Integer, yBottom As Integer) - If _rectExp Is Nothing Then ReDim _rectExp(0) Else @@ -180,12 +194,10 @@ Public Class clsVisione Try _rectExp(_rectExp.Length - 1) = New Rectangle(xLeft, yTop, xRight - xLeft, yBottom - yTop) Catch ex As Exception - End Try - End Sub - Public Sub SetExpRectangle(xLeft As Integer, yTop As Integer, xRight As Integer, yBottom As Integer) + Public Sub SetExpRectangle(xLeft As Integer, yTop As Integer, xRight As Integer, yBottom As Integer) ' lavora solo sul rectangolo 0 If _rectExp Is Nothing Then ReDim _rectExp(0) @@ -196,12 +208,9 @@ Public Class clsVisione Dim y1 As Integer = Math.Min(yTop, yBottom) Dim w As Integer = Math.Abs(xRight - xLeft) Dim h As Integer = Math.Abs(yBottom - yTop) - _rectExp(0) = New Rectangle(x1, y1, w, h) Catch ex As Exception - End Try - End Sub ''' @@ -209,22 +218,17 @@ Public Class clsVisione ''' ''' Public Sub SetStoneRectangle(xLeft As Integer, yTop As Integer, xRight As Integer, yBottom As Integer) - - Try Dim x1 As Integer = Math.Min(xLeft, xRight) Dim y1 As Integer = Math.Min(yTop, yBottom) Dim w As Integer = Math.Abs(xRight - xLeft) Dim h As Integer = Math.Abs(yBottom - yTop) - _rectLastra = New Rectangle(x1, y1, w, h) Catch ex As Exception - End Try - End Sub - Public Sub GetExpRectangle(ByRef xLeft As Integer, ByRef yTop As Integer, ByRef xRight As Integer, ByRef yBottom As Integer) + Public Sub GetExpRectangle(ByRef xLeft As Integer, ByRef yTop As Integer, ByRef xRight As Integer, ByRef yBottom As Integer) ' metto un valore di default xLeft = 100 yTop = 300 @@ -232,7 +236,6 @@ Public Class clsVisione yBottom = yTop + 750 Try - ' lavora solo sul rectangolo 0 If _rectExp IsNot Nothing Then With _rectExp(0) @@ -243,18 +246,12 @@ Public Class clsVisione yBottom = yTop + .Height End If End With - End If - Catch ex As Exception - End Try - - End Sub + Public Sub GetStoneRectangle(ByRef xLeft As Integer, ByRef yTop As Integer, ByRef xRight As Integer, ByRef yBottom As Integer) - - ' lavora solo sul rectangolo 0 If _rectLastra.Height = 0 OrElse _rectLastra.Width = 0 Then ' metto un valore di default @@ -269,10 +266,7 @@ Public Class clsVisione xRight = xLeft + .Width yBottom = yTop + .Height End With - End If - - End Sub ''' @@ -280,8 +274,6 @@ Public Class clsVisione ''' ''' Public Sub TrovaBordiMCh(ByRef trhVal As Integer) - - Select Case _metodoDiff Case 1 ' somma delle differense sui tre canali @@ -308,16 +300,14 @@ Public Class clsVisione ' in test TrovaBordiMCh8() End Select - - End Sub Public Sub ApplicaTreshold(trhVal As Integer) - Dim tm As New Stopwatch - If _imageMng.FinalImage Is Nothing Then Return - Try + If _imageMng.FinalImage Is Nothing Then Return + + Try Dim t1 As Long tm.Start() If _metodoDiff = 7 Then @@ -327,23 +317,17 @@ Public Class clsVisione ApplicaTreshold4(trhVal) End If t1 = tm.ElapsedMilliseconds - Catch ex As Exception - End Try - End Sub ' porta i ciascun pixel alla stessa luminosità e poi fa la differenza dei colori ' lavora su img NON raddrizzata ' non è da utilizzare Private Sub TrovaBordiMCh3(trhVal As Integer) - Try - Dim cvimage1 As New Image(Of Emgu.CV.Structure.Bgr, Byte)(_image1) Dim cvbackImage As New Image(Of Emgu.CV.Structure.Bgr, Byte)(_backImage) - Dim cvimageDiff As Image(Of Emgu.CV.Structure.Gray, Byte) = Nothing For j As Integer = 0 To _pdown @@ -353,16 +337,15 @@ Public Class clsVisione Dim add As Double = 0 Dim factor As Double = 1 + CorreggiEsposizione(_image1, _backImage, add, factor) cvimage1 = cvimage1.Mul(factor) cvimage1 = cvimage1 + add - Dim nMaxByte As Integer = cvimage1.Width * cvimage1.Height Dim maxval As Integer = 0 Dim minval As Integer = 10000 Dim nr, nb As Integer - Dim fattCol As Double = 1.0 Dim fatdif As Double = 1 Dim fr As Double = 1 @@ -372,13 +355,9 @@ Public Class clsVisione ReDim _mm(nMaxByte) Array.Clear(_mm, 0, nMaxByte) - For iy = 0 To cvimage1.Height - 1 - nr = iy * cvimage1.Width - For ix = 0 To cvimage1.Width - 1 - nb = nr + ix Dim ri, gi, bi, smi As Double @@ -392,7 +371,6 @@ Public Class clsVisione gbk = cvbackImage.Data(iy, ix, 1) bbk = cvbackImage.Data(iy, ix, 2) - _mm(nb) = fatdif * (Math.Abs(rbk - ri) * fr + Math.Abs(gbk - gi) * fg + Math.Abs(bbk - bi) * fb) smi = ri + gi + bi @@ -412,19 +390,15 @@ Public Class clsVisione If _mm(nb) < minval Then minval = _mm(nb) Next Next - minval = (CDbl(maxval) - 255) / 3 + Dim fattConv As Double = 300 / (maxval - minval) Dim bvsum As Integer - cvimageDiff = New Image(Of Emgu.CV.Structure.Gray, Byte)(cvimage1.Width, cvimage1.Height) - For iy = 0 To cvimage1.Height - 1 - nr = iy * cvimage1.Width - For ix = 0 To cvimage1.Width - 1 nb = nr + ix bvsum = Convert.ToInt32((_mm(nb) - minval) * fattConv) @@ -434,10 +408,9 @@ Public Class clsVisione Next Next - #If DEBUG Then - Static mostra As Boolean = False + If mostra Then Dim frm2 As FrmImgShow = New FrmImgShow(cvimageDiff) frm2.ShowDialog() @@ -449,11 +422,8 @@ Public Class clsVisione cvimageDiff.Save("C:\temp\diffm3.png") Catch ex As Exception End Try - #End If - - For j As Integer = 0 To _pdown cvimageDiff = cvimageDiff.PyrUp Next @@ -468,7 +438,6 @@ Public Class clsVisione _outimage = New Image(Of Emgu.CV.Structure.Rgb, Byte)(_imageMng.FinalImage) ' _outimage - 'ThresholdBinaryInv --> dst(x,y) = if (src(x,y) > trhVal,0,maxVal) '-> quello che è variato diventa nero, quello che non è variato resta bianco '-> tanto più la variazione sulla lastra è piccola, tanto più posso abbassare trhVal @@ -476,35 +445,22 @@ Public Class clsVisione ApplicaTreshold(trhVal) _imageMng.SaveClickMsg(0) - Catch ex As Exception Debug.Print("errore") _imageMng.SaveClickMsg(1) - Finally - End Try - - - End Sub Private Sub CorreggiEsposizione(Img As Bitmap, imgB As Bitmap, ByRef add As Double, ByRef factor As Double) - ' aggiusto la luminosità Try - add = 0 factor = 1 If (_expCorrection <> eExpCorrMode.none AndAlso _rectExp.Length > 0) Then - - 'Dim cvimageg As New Image(Of Emgu.CV.Structure.Gray, Byte)(_image1) - 'Dim cvbackImageg As New Image(Of Emgu.CV.Structure.Gray, Byte)(_backImage) - Dim cvimageg As New Image(Of Emgu.CV.Structure.Gray, Byte)(Img) Dim cvbackImageg As New Image(Of Emgu.CV.Structure.Gray, Byte)(imgB) - Dim mbk, mi As CV.Structure.Gray Dim bkintensity As Double = 0 Dim imgintensity As Double = 0 @@ -514,16 +470,12 @@ Public Class clsVisione Dim sumrapp As Double = 0 For i As Integer = 0 To _rectExp.Length - 1 - cvbackImageg.ROI = _rectExp(i) cvimageg.ROI = _rectExp(i) - - #If DEBUG Then cvimageg.Save("c:\temp\img" & i.ToString & ".png") cvbackImageg.Save("c:\temp\back" & i & ".png") #End If - mbk = cvbackImageg.GetAverage() mi = cvimageg.GetAverage() cvbackImageg.ROI = Nothing @@ -534,12 +486,10 @@ Public Class clsVisione ResultDiff = ResultDiff + mbk.Intensity - mi.Intensity sumrapp += mbk.Intensity / mi.Intensity End If - #If DEBUG Then ' cvbackImage.Draw(_rectExp(i), New Bgr(255, 255, 0), 5) #End If Next - Dim rapp As Double = 10 Dim rok As Integer = 0 Dim addok As Integer = 0 @@ -562,7 +512,6 @@ Public Class clsVisione addfin = listAdd(i) addok = i End If - Next Select Case _expCorrection Case eExpCorrMode.minFactor @@ -581,36 +530,26 @@ Public Class clsVisione cvimageg.Dispose() cvbackImageg.Dispose() - - End If - Catch ex As Exception - End Try - - - End Sub Private Sub CheckIfStoneDark(Img As Bitmap, imgB As Bitmap, ByRef dark As Boolean) - ' aggiusto la luminosità dark = False - Try + Try Dim cvimageg As New Image(Of Emgu.CV.Structure.Gray, Byte)(Img) Dim cvbackImageg As New Image(Of Emgu.CV.Structure.Gray, Byte)(imgB) Dim mbk, mi As CV.Structure.Gray cvbackImageg.ROI = _rectLastra cvimageg.ROI = _rectLastra - #If DEBUG Then cvimageg.Save("c:\temp\RectEvalBN.png") cvbackImageg.Save("c:\temp\RectEvalBNB.png") #End If - mbk = cvbackImageg.GetAverage() mi = cvimageg.GetAverage() cvbackImageg.ROI = Nothing @@ -620,45 +559,32 @@ Public Class clsVisione Dim rIntensity As Double = mi.Intensity / mbk.Intensity dark = rIntensity < _darkRappLevel - Catch ex As Exception - End Try - - End Sub + Private Sub CheckIfStoneDark(Img As Bitmap, ByRef dark As Boolean) - 'Check senza usare il background - dark = False - Try + Try Dim cvimageg As New Image(Of Emgu.CV.Structure.Gray, Byte)(Img) Dim mi As CV.Structure.Gray cvimageg.ROI = _rectLastra - #If DEBUG Then cvimageg.Save("c:\temp\RectEvalBN.png") #End If - mi = cvimageg.GetAverage() - dark = mi.Intensity < 130 - Catch ex As Exception - End Try - - End Sub + ' differenza sui tre canali ' corregge l'immagine prima di confrontare Private Sub TrovaBordiMCh1(trhVal As Integer) - Try - Dim cvimage1Ch As Image(Of Emgu.CV.Structure.Gray, Byte) Dim cvbackImageCh As Image(Of Emgu.CV.Structure.Gray, Byte) @@ -676,65 +602,45 @@ Public Class clsVisione _imageMng.InputImage = _image1 _imageMng.CorrezioneCompleta() - _outimage = New Image(Of Emgu.CV.Structure.Rgb, Byte)(_imageMng.FinalImage) + Dim cvimage1 As New Image(Of Emgu.CV.Structure.Bgr, Byte)(_imageMng.FinalImage) - - Dim add As Double = 0 Dim factor As Double = 1 + CorreggiEsposizione(_outimage.Bitmap, _convBackImage, add, factor) cvimage1 = cvimage1 * factor cvimage1 = cvimage1 + add - For j As Integer = 0 To _pdown - 1 cvimage1 = cvimage1.Resize(0.5, _iterpType) cvbackImage = cvbackImage.Resize(0.5, _iterpType) Next - cvimage1Ch = cvimage1.Split(0) cvbackImageCh = cvbackImage.Split(0) _corImgDiff = cvbackImageCh.AbsDiff(cvimage1Ch) * 0.33 - #If DEBUG Then cvbackImageCh.AbsDiff(cvimage1Ch).Save("c:\temp\diffch0.png") #End If - cvimage1Ch = cvimage1.Split(1) cvbackImageCh = cvbackImage.Split(1) - _corImgDiff = _corImgDiff + cvbackImageCh.AbsDiff(cvimage1Ch) * 0.33 - - #If DEBUG Then cvbackImageCh.AbsDiff(cvimage1Ch).Save("c:\temp\diffch1.png") #End If - - cvbackImageCh.Dispose() cvimage1Ch.Dispose() GC.Collect() - cvimage1Ch = cvimage1.Split(2) cvbackImageCh = cvbackImage.Split(2) _corImgDiff = _corImgDiff + cvbackImageCh.AbsDiff(cvimage1Ch) * 0.33 - - #If DEBUG Then cvbackImageCh.AbsDiff(cvimage1Ch).Save("c:\temp\diffch2.png") #End If - - - - #If DEBUG Then _corImgDiff.Save("c:\temp\img0.png") #End If - - ' _outimage - 'ThresholdBinaryInv --> dst(x,y) = if (src(x,y) > trhVal,0,maxVal) '-> quello che è variato diventa nero, quello che non è variato resta bianco '-> tanto più la variazione sulla lastra è piccola, tanto più posso abbassare trhVal @@ -746,32 +652,20 @@ Public Class clsVisione ApplicaTreshold(trhVal) _imageMng.SaveClickMsg(0) - Catch ex As Exception Debug.Print("errore") _imageMng.SaveClickMsg(1) - Finally - End Try - - - End Sub - Public ReadOnly Property IsInError As Boolean - Get - Return (_error <> Errors.None) - End Get - End Property - Private Sub DisposeImage1() If _image1 IsNot Nothing Then _image1.Dispose() _image1 = Nothing End If - End Sub + Private Sub DisposeBackImage() If _backImage IsNot Nothing Then _backImage.Dispose() @@ -791,7 +685,6 @@ Public Class clsVisione Next Return po - End Function #If WinXp Then @@ -799,8 +692,6 @@ Public Class clsVisione #Else Private Sub DebugSuDxf(writer As StreamWriter, p As VectorOfPoint) #End If - - Dim ZL As Double = 10 Dim i As Integer #If WinXp Then @@ -808,10 +699,7 @@ Public Class clsVisione #Else Dim lung As Integer = p.Size #End If - - For i = 1 To lung - 1 - writer.WriteLine("LINE") writer.WriteLine("8") writer.WriteLine("0") @@ -847,8 +735,6 @@ Public Class clsVisione writer.WriteLine("31") writer.WriteLine(0) writer.WriteLine("0") - - End Sub Public Sub New(imgMng As clsImageMng) @@ -858,21 +744,15 @@ Public Class clsVisione ' differenza sul blu o sul giallo senza backg ' lavora sull'immagine raddrizzata Private Sub TrovaBordiMCh5(trhVal As Integer) - - Try - Dim cvimage1Ch As Image(Of Emgu.CV.Structure.Gray, Byte) - _imageMng.InputImage = _image1 _imageMng.CorrezioneCompleta() - _outimage = New Image(Of Emgu.CV.Structure.Rgb, Byte)(_imageMng.FinalImage) + Dim cvimage1 As New Image(Of Emgu.CV.Structure.Bgr, Byte)(_imageMng.FinalImage) - - CheckIfStoneDark(cvimage1.Bitmap, _bnero) For j As Integer = 0 To _pdown - 1 @@ -882,42 +762,25 @@ Public Class clsVisione If _bnero Then cvimage1Ch = (255 - cvimage1.Split(1)) ' * 0.5 cvimage1Ch = ScaleGrayTo(127, cvimage1Ch) - _corImgDiff = cvimage1Ch - #If DEBUG Then _corImgDiff.Save("c:\temp\ch1.png") #End If - - 'cvimage1Ch.Dispose() - 'GC.Collect() - ' Canale G cvimage1Ch = (255 - cvimage1.Split(2)) ' * 0.5 cvimage1Ch = ScaleGrayTo(127, cvimage1Ch) - _corImgDiff = _corImgDiff + cvimage1Ch - #If DEBUG Then cvimage1Ch.Save("c:\temp\ch2.png") #End If - - - Else ' Canale b _corImgDiff = ScaleGrayTo(255, cvimage1.Split(0)) End If - - - #If DEBUG Then _corImgDiff.Save("c:\temp\img0.png") #End If - - ' _outimage - 'ThresholdBinaryInv --> dst(x,y) = if (src(x,y) > trhVal,0,maxVal) '-> quello che è variato diventa nero, quello che non è variato resta bianco '-> tanto più la variazione sulla lastra è piccola, tanto più posso abbassare trhVal @@ -929,24 +792,17 @@ Public Class clsVisione ApplicaTreshold(trhVal) _imageMng.SaveClickMsg(0) - Catch ex As Exception Debug.Print("errore") _imageMng.SaveClickMsg(1) - Finally - End Try - - - End Sub + ' differenza distinguendo se lastra bianca o nera ' lavora su immagine raddrizzata Private Sub TrovaBordiMCh6(trhVal As Integer, valutaBiancoNero As Boolean) - Try - Dim cvimage1Ch As Image(Of Emgu.CV.Structure.Gray, Byte) Dim cvbackImageCh As Image(Of Emgu.CV.Structure.Gray, Byte) @@ -964,48 +820,38 @@ Public Class clsVisione _imageMng.InputImage = _image1 _imageMng.CorrezioneCompleta() - _outimage = New Image(Of Emgu.CV.Structure.Rgb, Byte)(_imageMng.FinalImage) + Dim cvimage1 As New Image(Of Emgu.CV.Structure.Bgr, Byte)(_imageMng.FinalImage) - - Dim add As Double = 0 Dim factor As Double = 1 + CorreggiEsposizione(_outimage.Bitmap, _convBackImage, add, factor) cvimage1 = cvimage1 * factor cvimage1 = cvimage1 + add - _thFactor = 1 _bnero = False If valutaBiancoNero Then - CheckIfStoneDark(cvimage1.Bitmap, _convBackImage, _bnero) If _bnero Then _thFactor = _thFactorNero End If - End If For j As Integer = 0 To _pdown - 1 - cvimage1 = cvimage1.Resize(0.5, _iterpType) cvbackImage = cvbackImage.Resize(0.5, _iterpType) Next - If _bnero Then cvimage1Ch = (255 - cvimage1.Split(1)) * 0.5 cvbackImageCh = (255 - cvbackImage.Split(1)) * 0.5 - _corImgDiff = cvbackImageCh.AbsDiff(cvimage1Ch) _corImgDiff = ScaleGrayTo(127, _corImgDiff) - - #If DEBUG Then _corImgDiff.Save("c:\temp\diffch1.png") #End If - cvbackImageCh.Dispose() cvimage1Ch.Dispose() GC.Collect() @@ -1013,30 +859,20 @@ Public Class clsVisione ' Canale G cvimage1Ch = (255 - cvimage1.Split(2)) * 0.5 cvbackImageCh = (255 - cvbackImage.Split(2)) * 0.5 - _corImgDiff = _corImgDiff + ScaleGrayTo(127, cvbackImageCh.AbsDiff(cvimage1Ch)) _corImgDiff = ScaleGrayTo(255, _corImgDiff) - #If DEBUG Then cvbackImageCh.AbsDiff(cvimage1Ch).Save("c:\temp\diffch2.png") #End If - - Else ' Canale b _corImgDiff = cvbackImage.Split(0).AbsDiff(cvimage1.Split(0)) _corImgDiff = ScaleGrayTo(255, _corImgDiff) End If - - - #If DEBUG Then _corImgDiff.Save("c:\temp\img0.png") #End If - - ' _outimage - 'ThresholdBinaryInv --> dst(x,y) = if (src(x,y) > trhVal,0,maxVal) '-> quello che è variato diventa nero, quello che non è variato resta bianco '-> tanto più la variazione sulla lastra è piccola, tanto più posso abbassare trhVal @@ -1048,21 +884,15 @@ Public Class clsVisione ApplicaTreshold(trhVal) _imageMng.SaveClickMsg(0) - Catch ex As Exception Debug.Print("errore") _imageMng.SaveClickMsg(1) - Finally - End Try - End Sub Private Sub TrovaBordiMCh7(trhVal As Integer, valutaBiancoNero As Boolean) - Try - DisposePreviousImages() ' Se non c'è il back raddrizzato, lo raddrizzo @@ -1079,27 +909,23 @@ Public Class clsVisione _imageMng.InputImage = _image1 _imageMng.CorrezioneCompleta() - _outimage = New Image(Of Emgu.CV.Structure.Rgb, Byte)(_imageMng.FinalImage) + Dim cvimage1 As New Image(Of Emgu.CV.Structure.Bgr, Byte)(_imageMng.FinalImage) - - Dim add As Double = 0 Dim factor As Double = 1 + CorreggiEsposizione(_outimage.Bitmap, _convBackImage, add, factor) cvimage1 = cvimage1 * factor cvimage1 = cvimage1 + add - _thFactor = 1 _bnero = False If valutaBiancoNero Then - CheckIfStoneDark(cvimage1.Bitmap, _convBackImage, _bnero) If _bnero Then _thFactor = _thFactorNero End If - End If For j As Integer = 0 To _pdown - 1 @@ -1107,53 +933,34 @@ Public Class clsVisione cvbackImage = cvbackImage.Resize(0.5, _iterpType) Next - _corImgDiff0 = ScaleGrayTo(255, cvbackImage.Split(0).AbsDiff(cvimage1.Split(0))) _corImgDiff1 = ScaleGrayTo(255, cvbackImage.Split(1).AbsDiff(cvimage1.Split(1))) _corImgDiff2 = ScaleGrayTo(255, cvbackImage.Split(2).AbsDiff(cvimage1.Split(2))) - - - #If DEBUG Then _corImgDiff0.Save("c:\temp\diffch0.png") _corImgDiff1.Save("c:\temp\diffch1.png") _corImgDiff2.Save("c:\temp\diffch2.png") #End If - - - 'For j As Integer = 0 To _pdown - 1 - ' _corImgDiff0 = _corImgDiff0.PyrUp - ' _corImgDiff1 = _corImgDiff1.PyrUp - ' _corImgDiff2 = _corImgDiff2.PyrUp - 'Next - ApplicaTreshold7(trhVal) _imageMng.SaveClickMsg(0) - Catch ex As Exception Debug.Print("errore") _imageMng.SaveClickMsg(1) - Finally - End Try - End Sub Private Sub TrovaBordiMCh8() - #If WinXp Then #Else ' in test, basato sui template (non sembra gran che) Try - Dim resultImage As Emgu.CV.Image(Of Emgu.CV.Structure.Gray, Single) Dim regione As System.Drawing.Rectangle = Nothing Dim reg2 As System.Drawing.Rectangle = Nothing Dim x0, y0 As Integer Dim minscore As Double = 0.4 - ' Se non c'è il back raddrizzato, lo raddrizzo If _convBackImage Is Nothing Then ConvertBackImage() @@ -1168,10 +975,9 @@ Public Class clsVisione _imageMng.InputImage = _image1 _imageMng.CorrezioneCompleta() - _outimage = New Image(Of Emgu.CV.Structure.Rgb, Byte)(_imageMng.FinalImage) - Dim cvimage1 As New Image(Of Emgu.CV.Structure.Bgr, Byte)(_imageMng.FinalImage) + Dim cvimage1 As New Image(Of Emgu.CV.Structure.Bgr, Byte)(_imageMng.FinalImage) Dim w As Integer = cvimage1.Width Dim h As Integer = cvimage1.Height Dim lato As Integer = 250 @@ -1182,51 +988,34 @@ Public Class clsVisione cvbackImage.ROI = Nothing regione = New System.Drawing.Rectangle(x0, y0, lato, lato) reg2 = New System.Drawing.Rectangle(x0 + 5, y0 + 5, lato - 5, lato - 5) - cvimage1.ROI = regione cvbackImage.ROI = regione - resultImage = cvimage1.MatchTemplate(cvbackImage, Emgu.CV.CvEnum.TemplateMatchingType.CcoeffNormed) Dim min() As Double = Nothing, max() As Double = Nothing Dim point1() As Point = Nothing, point2() As Point = Nothing resultImage.MinMax(min, max, point1, point2) + If max(0) < minscore Then - Emgu.CV.CvInvoke.Line(_outimage, New Point(x0, y0), New Point(x0 + lato, y0), - New Emgu.CV.Structure.MCvScalar(0, 255, 0), 5, Emgu.CV.CvEnum.LineType.FourConnected, 0) - Emgu.CV.CvInvoke.Line(_outimage, New Point(x0 + lato, y0), New Point(x0 + lato, y0 + lato), - New Emgu.CV.Structure.MCvScalar(0, 255, 0), 5, Emgu.CV.CvEnum.LineType.FourConnected, 0) - Emgu.CV.CvInvoke.Line(_outimage, New Point(x0 + lato, y0 + lato), New Point(x0, y0 + lato), - New Emgu.CV.Structure.MCvScalar(0, 255, 0), 5, Emgu.CV.CvEnum.LineType.FourConnected, 0) - Emgu.CV.CvInvoke.Line(_outimage, New Point(x0, y0 + lato), New Point(x0, y0), - New Emgu.CV.Structure.MCvScalar(0, 255, 0), 5, Emgu.CV.CvEnum.LineType.FourConnected, 0) + Emgu.CV.CvInvoke.Line(_outimage, New Point(x0, y0), New Point(x0 + lato, y0), New Emgu.CV.Structure.MCvScalar(0, 255, 0), 5, Emgu.CV.CvEnum.LineType.FourConnected, 0) + Emgu.CV.CvInvoke.Line(_outimage, New Point(x0 + lato, y0), New Point(x0 + lato, y0 + lato), New Emgu.CV.Structure.MCvScalar(0, 255, 0), 5, Emgu.CV.CvEnum.LineType.FourConnected, 0) + Emgu.CV.CvInvoke.Line(_outimage, New Point(x0 + lato, y0 + lato), New Point(x0, y0 + lato), New Emgu.CV.Structure.MCvScalar(0, 255, 0), 5, Emgu.CV.CvEnum.LineType.FourConnected, 0) + Emgu.CV.CvInvoke.Line(_outimage, New Point(x0, y0 + lato), New Point(x0, y0), New Emgu.CV.Structure.MCvScalar(0, 255, 0), 5, Emgu.CV.CvEnum.LineType.FourConnected, 0) End If - - Next Next - - _imageMng.SaveClickMsg(0) - Catch ex As Exception Debug.Print("errore") _imageMng.SaveClickMsg(1) - Finally - End Try - #End If - End Sub Private Sub ApplicaTreshold4(trhVal As Integer) - - Try - Dim tm As New Stopwatch Dim t1, t2, t3, t4 As Double @@ -1235,29 +1024,16 @@ Public Class clsVisione tm.Start() Dim maxVal As Double = 255 - Dim cvimageTh As Image(Of Emgu.CV.Structure.Gray, Byte) - - - cvimageTh = _corImgDiff.ThresholdBinary(New Emgu.CV.Structure.Gray(trhVal), New Emgu.CV.Structure.Gray(255)) Static fattR As Integer = 15 - cvimageTh = cvimageTh.Dilate(fattR) cvimageTh = cvimageTh.Erode(fattR) - t1 = tm.ElapsedMilliseconds - ' Faccio la canny per didattica, ma non la uso - 'Dim cvimageCanny As Image(Of Emgu.CV.Structure.Gray, Byte) - 'cvimageCanny = cvimageTh.Canny(thr, thr * 2 / 3) - 'Dim frm4 As FrmImgShow = New FrmImgShow(cvimageCanny) - 'frm4.ShowDialog() - Dim areaMax As Double = 0 Dim iareaMax As Integer = 0 - #If WinXp Then Dim contours As Contour(Of Point) contours = cvimageTh.FindContours(CvEnum.CHAIN_APPROX_METHOD.CV_CHAIN_APPROX_TC89_KCOS, CvEnum.RETR_TYPE.CV_RETR_EXTERNAL) @@ -1276,11 +1052,10 @@ Public Class clsVisione End While t2 = tm.ElapsedMilliseconds - - #Else Dim contours As New VectorOfVectorOfPoint - Dim Hierarchy As IOutputArray + Dim Hierarchy As IOutputArray = Nothing + CvInvoke.FindContours(cvimageTh, contours, Hierarchy, _searchMode, CvEnum.ChainApproxMethod.ChainApproxTc89Kcos) t2 = tm.ElapsedMilliseconds @@ -1292,12 +1067,10 @@ Public Class clsVisione iareaMax = i End If Next - #End If - - ' parte iniziale del file DXF Dim writer As New StreamWriter(SaveDir & "FinalImage.dxf") + writer.WriteLine("0") writer.WriteLine("SECTION") writer.WriteLine("2") @@ -1307,28 +1080,20 @@ Public Class clsVisione Dim cntcont As Integer = 0 Dim maxLevel As Integer = 0 Dim thickness As Integer = 2 - #If WinXp Then - - CvInvoke.cvDrawContours(_outimage, ActualContour, New MCvScalar(255, 255, 0), New MCvScalar(255, 255, 0), maxLevel, 5, - CvEnum.LINE_TYPE.FOUR_CONNECTED, New Point(0, 0)) + CvInvoke.cvDrawContours(_outimage, ActualContour, New MCvScalar(255, 255, 0), New MCvScalar(255, 255, 0), maxLevel, 5, CvEnum.LINE_TYPE.FOUR_CONNECTED, New Point(0, 0)) DebugSuDxf(writer, contours.ToArray()) - #Else - If areaMax > 0 Then CvInvoke.DrawContours(_outimage, contours, iareaMax, New MCvScalar(255, 255, 0), 5) DebugSuDxf(writer, New VectorOfPoint(contours(iareaMax).ToArray())) End If #End If - - writer.WriteLine("ENDSEC") writer.WriteLine("0") writer.WriteLine("EOF") t3 = tm.ElapsedMilliseconds - #If WinXp Then contours.Clear() #Else @@ -1340,25 +1105,14 @@ Public Class clsVisione writer.Dispose() writer = Nothing - - 'GC.Collect() - t4 = tm.ElapsedMilliseconds Debug.Print(t3.ToString) - - Catch ex As Exception - End Try - - - End Sub Private Sub ApplicaTreshold7(trhVal As Integer) - - trhVal = trhVal * _thFactor If _corImgDiff1 Is Nothing Then Return @@ -1392,12 +1146,9 @@ Public Class clsVisione Next t2 = tm.ElapsedMilliseconds - - #If DEBUG Then _corImgDiff.Save("c:\temp\sumdiff.png") #End If - _outimage = New Image(Of Emgu.CV.Structure.Rgb, Byte)(_imageMng.FinalImage) ApplicaTreshold4(trhVal) @@ -1405,7 +1156,6 @@ Public Class clsVisione GC.Collect() t4 = tm.ElapsedMilliseconds - End Sub Private Sub ConvertBackImage() @@ -1419,7 +1169,6 @@ Public Class clsVisione _imageMng.InputImage = _backImage _imageMng.CorrezioneCompleta() _convBackImage = _imageMng.FinalImage.Clone() - End Sub Private Function ScaleGrayTo(maxg As Double, img As Image(Of Emgu.CV.Structure.Gray, Byte)) As Image(Of Emgu.CV.Structure.Gray, Byte) @@ -1438,21 +1187,16 @@ Public Class clsVisione img = (img - minv) * (maxg / (maxv - minv)) End If - Return img End Function Private Sub SommaThreshold(trhVal As Integer, nimg As Integer) - - Try - Dim maxVal As Double = 255 - Dim cvimageTh As Image(Of Emgu.CV.Structure.Gray, Byte) - Dim tm As New Stopwatch Dim t1, t2, t3 As Double + tm.Start() cvimageTh = _corImgDiff.ThresholdBinary(New Emgu.CV.Structure.Gray(trhVal), New Emgu.CV.Structure.Gray(255)) @@ -1469,41 +1213,28 @@ Public Class clsVisione Else _thrImage = _thrImage.Add(cvimageTh) End If - t3 = tm.ElapsedMilliseconds - #If DEBUG Then cvimageTh.Save("c:\temp\thImage" & nimg.ToString & ".png") #End If - - - 'GC.Collect() - Catch ex As Exception - End Try - - End Sub Private Sub DisposePreviousImages() - Dim img As Image(Of Emgu.CV.Structure.Gray, Byte) For Each img In {_corImgDiff0, _corImgDiff1, _corImgDiff2, _corImgDiff, _thrImage} - Try - If img IsNot Nothing Then img.Dispose() img = Nothing End If - Catch ex As Exception - End Try Next - - End Sub + +#End Region ' Methods + End Class diff --git a/CameraMng/property/Property.vb b/CameraMng/property/Property.vb index 698e58b..48c3690 100644 --- a/CameraMng/property/Property.vb +++ b/CameraMng/property/Property.vb @@ -19,366 +19,354 @@ '* * '******************************************************************************/ -Imports System -Imports System.Collections Imports System.Runtime.InteropServices Public Structure TPropStrVal - Dim val As Integer - Dim str As String + Dim val As Integer + Dim str As String End Structure - - Public Class CameraProperty - ' Uniting camera properties and express strings table + ' Uniting camera properties and express strings table - Public Shared g_AEMode As Hashtable = New Hashtable - Public Shared g_ISOSpeed As Hashtable = New Hashtable - Public Shared g_Av As Hashtable = New Hashtable - Public Shared g_Tv As Hashtable = New Hashtable - Public Shared g_MeteringMode As Hashtable = New Hashtable - Public Shared g_ExposureComp As Hashtable = New Hashtable - Public Shared g_ImageQuality As Hashtable = New Hashtable +#Region "FIELDS & PROPERTIES" + Public Shared g_AEMode As Hashtable = New Hashtable + Public Shared g_ISOSpeed As Hashtable = New Hashtable + Public Shared g_Av As Hashtable = New Hashtable + Public Shared g_Tv As Hashtable = New Hashtable + Public Shared g_MeteringMode As Hashtable = New Hashtable + Public Shared g_ExposureComp As Hashtable = New Hashtable + Public Shared g_ImageQuality As Hashtable = New Hashtable Public Shared g_PropList As Hashtable = New Hashtable Private Shared init_ok As Boolean = False +#End Region ' Fields & Properties - Public Sub New() +#Region "CONSTRUCTOR" + + Public Sub New() If Not init_ok Then tableInit() init_ok = True - End Sub + End Sub + +#End Region ' Constructor + +#Region "METHODS" + + Private Sub tableInit() + g_MeteringMode.Add(1, "Spot Metering") + g_MeteringMode.Add(3, "Evaluative Metering") + g_MeteringMode.Add(4, "Partial Metering") + g_MeteringMode.Add(5, "Center-Weighted Average Metering") + g_MeteringMode.Add(&HFFFFFFFF, "unkown") + + g_ExposureComp.Add(&H18, "+3") + g_ExposureComp.Add(&H15, "+2 2/3") + g_ExposureComp.Add(&H14, "+2 1/2") + g_ExposureComp.Add(&H13, "+2 1/3") + g_ExposureComp.Add(&H10, "+2") + g_ExposureComp.Add(&HD, "+1 2/3") + g_ExposureComp.Add(&HC, "+1 1/2") + g_ExposureComp.Add(&HB, "+1 1/3") + g_ExposureComp.Add(&H8, "+1") + g_ExposureComp.Add(&H5, "+2/3") + g_ExposureComp.Add(&H4, "+1/2") + g_ExposureComp.Add(&H3, "+1/3") + g_ExposureComp.Add(&H0, "0") + g_ExposureComp.Add(&HFD, "-1/3") + g_ExposureComp.Add(&HFC, "-1/2") + g_ExposureComp.Add(&HFB, "-2/3") + g_ExposureComp.Add(&HF8, "-1") + g_ExposureComp.Add(&HF5, "-1 1/3") + g_ExposureComp.Add(&HF4, "-1 1/2") + g_ExposureComp.Add(&HF3, "-1 2/3") + g_ExposureComp.Add(&HF0, "-2") + g_ExposureComp.Add(&HED, "-2 1/3") + g_ExposureComp.Add(&HEC, "-2 1/2") + g_ExposureComp.Add(&HEB, "-2 2/3") + g_ExposureComp.Add(&HE8, "-3") + g_ExposureComp.Add(&HFFFFFFFF, "unkown") + + g_AEMode.Add(0, "P") + g_AEMode.Add(1, "Tv") + g_AEMode.Add(2, "Av") + g_AEMode.Add(3, "M") + g_AEMode.Add(4, "Bulb") + g_AEMode.Add(5, "A-DEP") + g_AEMode.Add(6, "Depth-of-Field AE") + g_AEMode.Add(7, "Manual") + g_AEMode.Add(8, "Lock") + g_AEMode.Add(9, "GreenMode") + g_AEMode.Add(10, "Night Scene Portrait") + g_AEMode.Add(11, "Sports") + g_AEMode.Add(12, "Portrait") + g_AEMode.Add(13, "Landscape") + g_AEMode.Add(14, "Close Up") + g_AEMode.Add(15, "Flash Off") + g_AEMode.Add(19, "CreativeAuto") + g_AEMode.Add(20, "Movie") + g_AEMode.Add(21, "PhotoInMovie") + g_AEMode.Add(22, "SceneIntelligentAuto") + g_AEMode.Add(25, "SCN") + g_AEMode.Add(&HFFFFFFFF, "unknown") + + g_ISOSpeed.Add(&H0, "Auto") + g_ISOSpeed.Add(&H28, "6") + g_ISOSpeed.Add(&H30, "12") + g_ISOSpeed.Add(&H38, "25") + g_ISOSpeed.Add(&H40, "50") + g_ISOSpeed.Add(&H48, "100") + g_ISOSpeed.Add(&H4B, "125") + g_ISOSpeed.Add(&H4D, "160") + g_ISOSpeed.Add(&H50, "200") + g_ISOSpeed.Add(&H53, "250") + g_ISOSpeed.Add(&H55, "320") + g_ISOSpeed.Add(&H58, "400") + g_ISOSpeed.Add(&H5B, "500") + g_ISOSpeed.Add(&H5D, "640") + g_ISOSpeed.Add(&H60, "800") + g_ISOSpeed.Add(&H63, "1000") + g_ISOSpeed.Add(&H65, "1250") + g_ISOSpeed.Add(&H68, "1600") + g_ISOSpeed.Add(&H6B, "2000") + g_ISOSpeed.Add(&H6D, "2500") + g_ISOSpeed.Add(&H70, "3200") + g_ISOSpeed.Add(&H73, "4000") + g_ISOSpeed.Add(&H75, "5000") + g_ISOSpeed.Add(&H78, "6400") + g_ISOSpeed.Add(&H7B, "8000") + g_ISOSpeed.Add(&H7D, "10000") + g_ISOSpeed.Add(&H80, "12800") + g_ISOSpeed.Add(&H83, "16000") + g_ISOSpeed.Add(&H85, "20000") + g_ISOSpeed.Add(&H88, "25600") + g_ISOSpeed.Add(&H8B, "32000") + g_ISOSpeed.Add(&H8D, "40000") + g_ISOSpeed.Add(&H90, "51200") + g_ISOSpeed.Add(&H98, "102400") + g_ISOSpeed.Add(&HFFFFFFFF, "unknown") + + g_Av.Add(&H8, "1") + g_Av.Add(&HB, "1.1") + g_Av.Add(&HC, "1.2") + g_Av.Add(&HD, "1.2") + g_Av.Add(&H10, "1.4") + g_Av.Add(&H13, "1.6") + g_Av.Add(&H14, "1.8") + g_Av.Add(&H15, "1.8") + g_Av.Add(&H18, "2") + g_Av.Add(&H1B, "2.2") + g_Av.Add(&H1C, "2.5") + g_Av.Add(&H1D, "2.5") + g_Av.Add(&H20, "2.8") + g_Av.Add(&H23, "3.2") + g_Av.Add(&H24, "3.5") + g_Av.Add(&H25, "3.5") + g_Av.Add(&H28, "4") + g_Av.Add(&H2B, "4") + g_Av.Add(&H2C, "4.5") + g_Av.Add(&H2D, "5.6") + g_Av.Add(&H30, "5.6") + g_Av.Add(&H33, "6.3") + g_Av.Add(&H34, "6.7") + g_Av.Add(&H35, "7.1") + g_Av.Add(&H38, "8") + g_Av.Add(&H3B, "9") + g_Av.Add(&H3C, "9.5") + g_Av.Add(&H3D, "10") + g_Av.Add(&H40, "11") + g_Av.Add(&H43, "13") + g_Av.Add(&H44, "13") + g_Av.Add(&H45, "14") + g_Av.Add(&H48, "16") + g_Av.Add(&H4B, "18") + g_Av.Add(&H4C, "19") + g_Av.Add(&H4D, "20") + g_Av.Add(&H50, "22") + g_Av.Add(&H53, "25") + g_Av.Add(&H54, "27") + g_Av.Add(&H55, "29") + g_Av.Add(&H58, "32") + g_Av.Add(&H5B, "36") + g_Av.Add(&H5C, "38") + g_Av.Add(&H5D, "40") + g_Av.Add(&H60, "45") + g_Av.Add(&H63, "51") + g_Av.Add(&H64, "54") + g_Av.Add(&H65, "57") + g_Av.Add(&H68, "64") + g_Av.Add(&H6B, "72") + g_Av.Add(&H6C, "76") + g_Av.Add(&H6D, "80") + g_Av.Add(&H70, "91") + g_Av.Add(&HFFFFFFFF, "unknown") + g_Tv.Add(&H10, "30""") + g_Tv.Add(&H13, "25""") + g_Tv.Add(&H14, "20""") + g_Tv.Add(&H15, "20""") + g_Tv.Add(&H18, "15""") + g_Tv.Add(&H1B, "13""") + g_Tv.Add(&H1C, "10""") + g_Tv.Add(&H1D, "10""") + g_Tv.Add(&H20, "8""") + g_Tv.Add(&H23, "6""") + g_Tv.Add(&H24, "6""") + g_Tv.Add(&H25, "5""") + g_Tv.Add(&H28, "4""") + g_Tv.Add(&H2B, "3""" + "2") + g_Tv.Add(&H2C, "3""") + g_Tv.Add(&H2D, "2""" + "5") + g_Tv.Add(&H30, "2""") + g_Tv.Add(&H33, "1""" + "6") + g_Tv.Add(&H34, "1""" + "5") + g_Tv.Add(&H35, "1""" + "3") + g_Tv.Add(&H38, "1""") + g_Tv.Add(&H3B, "0""" + "8") + g_Tv.Add(&H3C, "0""" + "7") + g_Tv.Add(&H3D, "0""" + "6") + g_Tv.Add(&H40, "0""" + "5") + g_Tv.Add(&H43, "0""" + "4") + g_Tv.Add(&H44, "0""" + "3") + g_Tv.Add(&H45, "0""" + "3") + g_Tv.Add(&H48, "4") + g_Tv.Add(&H4B, "5") + g_Tv.Add(&H4C, "6") + g_Tv.Add(&H4D, "6") + g_Tv.Add(&H50, "8") + g_Tv.Add(&H53, "10") + g_Tv.Add(&H54, "10") + g_Tv.Add(&H55, "13") + g_Tv.Add(&H58, "15") + g_Tv.Add(&H5B, "20") + g_Tv.Add(&H5C, "20") + g_Tv.Add(&H5D, "25") + g_Tv.Add(&H60, "30") + g_Tv.Add(&H63, "40") + g_Tv.Add(&H64, "45") + g_Tv.Add(&H65, "50") + g_Tv.Add(&H68, "60") + g_Tv.Add(&H6B, "80") + g_Tv.Add(&H6C, "90") + g_Tv.Add(&H6D, "100") + g_Tv.Add(&H70, "125") + g_Tv.Add(&H73, "160") + g_Tv.Add(&H74, "180") + g_Tv.Add(&H75, "200") + g_Tv.Add(&H78, "250") + g_Tv.Add(&H7B, "320") + g_Tv.Add(&H7C, "350") + g_Tv.Add(&H7D, "400") + g_Tv.Add(&H80, "500") + g_Tv.Add(&H83, "640") + g_Tv.Add(&H84, "750") + g_Tv.Add(&H85, "800") + g_Tv.Add(&H88, "1000") + g_Tv.Add(&H8B, "1250") + g_Tv.Add(&H8C, "1500") + g_Tv.Add(&H8D, "1600") + g_Tv.Add(&H90, "2000") + g_Tv.Add(&H93, "2500") + g_Tv.Add(&H94, "3000") + g_Tv.Add(&H95, "3200") + g_Tv.Add(&H98, "4000") + g_Tv.Add(&H9B, "5000") + g_Tv.Add(&H9C, "6000") + g_Tv.Add(&H9D, "6400") + g_Tv.Add(&HA0, "8000") + g_Tv.Add(&HFFFFFFFF, "unknown") + ' PTP Camera + g_ImageQuality.Add(&H64FF0F, "RAW") + g_ImageQuality.Add(&H640013, "RAW + Large Fine Jpeg") + g_ImageQuality.Add(&H640113, "RAW + Middle Fine Jpeg") + g_ImageQuality.Add(&H640213, "RAW + Small Fine Jpeg") + g_ImageQuality.Add(&H640012, "RAW + Large Normal Jpeg") + g_ImageQuality.Add(&H640112, "RAW + Middle Normal Jpeg") + g_ImageQuality.Add(&H640212, "RAW + Small Normal Jpeg") + g_ImageQuality.Add(&H640E13, "RAW + Small1 Fine Jpeg") + g_ImageQuality.Add(&H640E12, "RAW + Small1 Normal Jpeg") + g_ImageQuality.Add(&H640F13, "RAW + Small2 Jpeg") + g_ImageQuality.Add(&H641013, "RAW + Small3 Jpeg") + g_ImageQuality.Add(&H640010, "RAW + Large Jpeg") + g_ImageQuality.Add(&H640510, "RAW + Middle1 Jpeg") + g_ImageQuality.Add(&H640610, "RAW + Middle2 Jpeg") + g_ImageQuality.Add(&H640210, "RAW + Small Jpeg") + g_ImageQuality.Add(&H164FF0F, "MRAW") + g_ImageQuality.Add(&H1640013, "MRAW + Large Fine Jpeg") + g_ImageQuality.Add(&H1640012, "MRAW + Large Normal Jpeg") + g_ImageQuality.Add(&H1640113, "MRAW + Middle Fine Jpeg") + g_ImageQuality.Add(&H1640112, "MRAW + Middle Normal Jpeg") + g_ImageQuality.Add(&H1640213, "MRAW + Small Fine Jpeg") + g_ImageQuality.Add(&H1640212, "MRAW + Small Normal Jpeg") + g_ImageQuality.Add(&H1640E13, "MRAW + Small1 Fine Jpeg") + g_ImageQuality.Add(&H1640E12, "MRAW + Small1 Normal Jpeg") + g_ImageQuality.Add(&H1640F13, "MRAW + Small2 Jpeg") + g_ImageQuality.Add(&H1641013, "MRAW + Small3 Jpeg") + g_ImageQuality.Add(&H264FF0F, "SRAW") + g_ImageQuality.Add(&H2640010, "SRAW + Large Jpegg") + g_ImageQuality.Add(&H2640510, "SRAW + Middle1 Jpeg") + g_ImageQuality.Add(&H2640610, "SRAW + Middle2 Jpeg") + g_ImageQuality.Add(&H2640210, "SRAW + Small Jpeg") + g_ImageQuality.Add(&H2640013, "SRAW + Large Fine Jpeg") + g_ImageQuality.Add(&H2640012, "SRAW + Large Normal Jpeg") + g_ImageQuality.Add(&H2640113, "SRAW + Middle Fine Jpeg") + g_ImageQuality.Add(&H2640112, "SRAW + Middle Normal Jpeg") + g_ImageQuality.Add(&H2640213, "SRAW + Small Fine Jpeg") + g_ImageQuality.Add(&H2640212, "SRAW + Small Normal Jpeg") + g_ImageQuality.Add(&H2640E13, "SRAW + Small1 Fine Jpeg") + g_ImageQuality.Add(&H2640E12, "SRAW + Small1 Normal Jpeg") + g_ImageQuality.Add(&H2640F13, "SRAW + Small2 Jpeg") + g_ImageQuality.Add(&H2641013, "SRAW + Small3 Jpeg") + g_ImageQuality.Add(&H13FF0F, "Large Fine Jpeg") + g_ImageQuality.Add(&H12FF0F, "Large Normal Jpeg") + g_ImageQuality.Add(&H113FF0F, "Middle Fine Jpeg") + g_ImageQuality.Add(&H112FF0F, "Middle Normal Jpeg") + g_ImageQuality.Add(&H213FF0F, "Small Fine Jpeg") + g_ImageQuality.Add(&H212FF0F, "Small Normal Jpeg") + g_ImageQuality.Add(&HE13FF0F, "Small1 Fine Jpeg") + g_ImageQuality.Add(&HE12FF0F, "Small1 Normal Jpeg") + g_ImageQuality.Add(&HF13FF0F, "Small2 Jpeg") + g_ImageQuality.Add(&H1013FF0F, "Small3 Jpeg") + g_ImageQuality.Add(&H10FF0F, "Large Jpeg") + g_ImageQuality.Add(&H510FF0F, "Middle1 Jpeg") + g_ImageQuality.Add(&H610FF0F, "Middle2 Jpeg") + g_ImageQuality.Add(&H210FF0F, "Small Jpeg") - Private Sub tableInit() + ' Legacy Camera + g_ImageQuality.Add(&H240000, "RAW") + g_ImageQuality.Add(&H240013, "RAW + Large Fine Jpeg") + g_ImageQuality.Add(&H240113, "RAW + Middle Fine Jpeg") + g_ImageQuality.Add(&H240213, "RAW + Small Fine Jpeg") + g_ImageQuality.Add(&H240012, "RAW + Large Normal Jpeg") + g_ImageQuality.Add(&H240112, "RAW + Middle Normal Jpeg") + g_ImageQuality.Add(&H240212, "RAW + Small Normal Jpeg") + g_ImageQuality.Add(&H130000, "Large Fine Jpeg") + g_ImageQuality.Add(&H1130000, "Middle Fine Jpeg") + g_ImageQuality.Add(&H2130000, "Small Fine Jpeg") + g_ImageQuality.Add(&H120000, "Large Normal Jpeg") + g_ImageQuality.Add(&H1120000, "Middle Normal Jpeg") + g_ImageQuality.Add(&H2120000, "Small Normal Jpeg") + g_ImageQuality.Add(&H2F000F, "RAW") + g_ImageQuality.Add(&H2F001F, "RAW + Large Jpeg") + g_ImageQuality.Add(&H2F051F, "RAW + Middle1 Jpeg") + g_ImageQuality.Add(&H2F061F, "RAW + Middle2 Jpeg") + g_ImageQuality.Add(&H2F021F, "RAW + Small Jpeg") + g_ImageQuality.Add(&H1F000F, "Large Jpeg") + g_ImageQuality.Add(&H51F000F, "Middle1 Jpeg") + g_ImageQuality.Add(&H61F000F, "Middle2 Jpeg") + g_ImageQuality.Add(&H21F000F, "Small Jpeg") - g_MeteringMode.Add(1, "Spot Metering") - g_MeteringMode.Add(3, "Evaluative Metering") - g_MeteringMode.Add(4, "Partial Metering") - g_MeteringMode.Add(5, "Center-Weighted Average Metering") - g_MeteringMode.Add(&HFFFFFFFF, "unkown") - - - g_ExposureComp.Add(&H18, "+3") - g_ExposureComp.Add(&H15, "+2 2/3") - g_ExposureComp.Add(&H14, "+2 1/2") - g_ExposureComp.Add(&H13, "+2 1/3") - g_ExposureComp.Add(&H10, "+2") - g_ExposureComp.Add(&HD, "+1 2/3") - g_ExposureComp.Add(&HC, "+1 1/2") - g_ExposureComp.Add(&HB, "+1 1/3") - g_ExposureComp.Add(&H8, "+1") - g_ExposureComp.Add(&H5, "+2/3") - g_ExposureComp.Add(&H4, "+1/2") - g_ExposureComp.Add(&H3, "+1/3") - g_ExposureComp.Add(&H0, "0") - g_ExposureComp.Add(&HFD, "-1/3") - g_ExposureComp.Add(&HFC, "-1/2") - g_ExposureComp.Add(&HFB, "-2/3") - g_ExposureComp.Add(&HF8, "-1") - g_ExposureComp.Add(&HF5, "-1 1/3") - g_ExposureComp.Add(&HF4, "-1 1/2") - g_ExposureComp.Add(&HF3, "-1 2/3") - g_ExposureComp.Add(&HF0, "-2") - g_ExposureComp.Add(&HED, "-2 1/3") - g_ExposureComp.Add(&HEC, "-2 1/2") - g_ExposureComp.Add(&HEB, "-2 2/3") - g_ExposureComp.Add(&HE8, "-3") - g_ExposureComp.Add(&HFFFFFFFF, "unkown") - - - g_AEMode.Add(0, "P") - g_AEMode.Add(1, "Tv") - g_AEMode.Add(2, "Av") - g_AEMode.Add(3, "M") - g_AEMode.Add(4, "Bulb") - g_AEMode.Add(5, "A-DEP") - g_AEMode.Add(6, "Depth-of-Field AE") - g_AEMode.Add(7, "Manual") - g_AEMode.Add(8, "Lock") - g_AEMode.Add(9, "GreenMode") - g_AEMode.Add(10, "Night Scene Portrait") - g_AEMode.Add(11, "Sports") - g_AEMode.Add(12, "Portrait") - g_AEMode.Add(13, "Landscape") - g_AEMode.Add(14, "Close Up") - g_AEMode.Add(15, "Flash Off") - g_AEMode.Add(19, "CreativeAuto") - g_AEMode.Add(20, "Movie") - g_AEMode.Add(21, "PhotoInMovie") - g_AEMode.Add(22, "SceneIntelligentAuto") - g_AEMode.Add(25, "SCN") - g_AEMode.Add(&HFFFFFFFF, "unknown") - - - g_ISOSpeed.add(&H0, "Auto") - g_ISOSpeed.add(&H28, "6") - g_ISOSpeed.add(&H30, "12") - g_ISOSpeed.add(&H38, "25") - g_ISOSpeed.add(&H40, "50") - g_ISOSpeed.add(&H48, "100") - g_ISOSpeed.add(&H4B, "125") - g_ISOSpeed.add(&H4D, "160") - g_ISOSpeed.add(&H50, "200") - g_ISOSpeed.add(&H53, "250") - g_ISOSpeed.add(&H55, "320") - g_ISOSpeed.add(&H58, "400") - g_ISOSpeed.Add(&H5B, "500") - g_ISOSpeed.Add(&H5D, "640") - g_ISOSpeed.Add(&H60, "800") - g_ISOSpeed.Add(&H63, "1000") - g_ISOSpeed.Add(&H65, "1250") - g_ISOSpeed.Add(&H68, "1600") - g_ISOSpeed.Add(&H6B, "2000") - g_ISOSpeed.Add(&H6D, "2500") - g_ISOSpeed.Add(&H70, "3200") - g_ISOSpeed.Add(&H73, "4000") - g_ISOSpeed.Add(&H75, "5000") - g_ISOSpeed.Add(&H78, "6400") - g_ISOSpeed.Add(&H7B, "8000") - g_ISOSpeed.Add(&H7D, "10000") - g_ISOSpeed.Add(&H80, "12800") - g_ISOSpeed.Add(&H83, "16000") - g_ISOSpeed.Add(&H85, "20000") - g_ISOSpeed.Add(&H88, "25600") - g_ISOSpeed.Add(&H8B, "32000") - g_ISOSpeed.Add(&H8D, "40000") - g_ISOSpeed.Add(&H90, "51200") - g_ISOSpeed.Add(&H98, "102400") - g_ISOSpeed.Add(&HFFFFFFFF, "unknown") - - - g_Av.Add(&H8, "1") - g_Av.Add(&HB, "1.1") - g_Av.Add(&HC, "1.2") - g_Av.Add(&HD, "1.2") - g_Av.Add(&H10, "1.4") - g_Av.Add(&H13, "1.6") - g_Av.Add(&H14, "1.8") - g_Av.Add(&H15, "1.8") - g_Av.Add(&H18, "2") - g_Av.Add(&H1B, "2.2") - g_Av.Add(&H1C, "2.5") - g_Av.Add(&H1D, "2.5") - g_Av.Add(&H20, "2.8") - g_Av.Add(&H23, "3.2") - g_Av.Add(&H24, "3.5") - g_Av.Add(&H25, "3.5") - g_Av.Add(&H28, "4") - g_Av.Add(&H2B, "4") - g_Av.Add(&H2C, "4.5") - g_Av.Add(&H2D, "5.6") - g_Av.Add(&H30, "5.6") - g_Av.Add(&H33, "6.3") - g_Av.Add(&H34, "6.7") - g_Av.Add(&H35, "7.1") - g_Av.Add(&H38, "8") - g_Av.Add(&H3B, "9") - g_Av.Add(&H3C, "9.5") - g_Av.Add(&H3D, "10") - g_Av.Add(&H40, "11") - g_Av.Add(&H43, "13") - g_Av.Add(&H44, "13") - g_Av.Add(&H45, "14") - g_Av.Add(&H48, "16") - g_Av.Add(&H4B, "18") - g_Av.Add(&H4C, "19") - g_Av.Add(&H4D, "20") - g_Av.Add(&H50, "22") - g_Av.Add(&H53, "25") - g_Av.Add(&H54, "27") - g_Av.Add(&H55, "29") - g_Av.Add(&H58, "32") - g_Av.Add(&H5B, "36") - g_Av.Add(&H5C, "38") - g_Av.Add(&H5D, "40") - g_Av.Add(&H60, "45") - g_Av.Add(&H63, "51") - g_Av.Add(&H64, "54") - g_Av.Add(&H65, "57") - g_Av.Add(&H68, "64") - g_Av.Add(&H6B, "72") - g_Av.Add(&H6C, "76") - g_Av.Add(&H6D, "80") - g_Av.Add(&H70, "91") - g_Av.Add(&HFFFFFFFF, "unknown") - - - g_Tv.Add(&H10, "30""") - g_Tv.Add(&H13, "25""") - g_Tv.Add(&H14, "20""") - g_Tv.Add(&H15, "20""") - g_Tv.Add(&H18, "15""") - g_Tv.Add(&H1B, "13""") - g_Tv.Add(&H1C, "10""") - g_Tv.Add(&H1D, "10""") - g_Tv.Add(&H20, "8""") - g_Tv.Add(&H23, "6""") - g_Tv.Add(&H24, "6""") - g_Tv.Add(&H25, "5""") - g_Tv.Add(&H28, "4""") - g_Tv.Add(&H2B, "3""" + "2") - g_Tv.Add(&H2C, "3""") - g_Tv.Add(&H2D, "2""" + "5") - g_Tv.Add(&H30, "2""") - g_Tv.Add(&H33, "1""" + "6") - g_Tv.Add(&H34, "1""" + "5") - g_Tv.Add(&H35, "1""" + "3") - g_Tv.Add(&H38, "1""") - g_Tv.Add(&H3B, "0""" + "8") - g_Tv.Add(&H3C, "0""" + "7") - g_Tv.Add(&H3D, "0""" + "6") - g_Tv.Add(&H40, "0""" + "5") - g_Tv.Add(&H43, "0""" + "4") - g_Tv.Add(&H44, "0""" + "3") - g_Tv.Add(&H45, "0""" + "3") - g_Tv.Add(&H48, "4") - g_Tv.Add(&H4B, "5") - g_Tv.Add(&H4C, "6") - g_Tv.Add(&H4D, "6") - g_Tv.Add(&H50, "8") - g_Tv.Add(&H53, "10") - g_Tv.Add(&H54, "10") - g_Tv.Add(&H55, "13") - g_Tv.Add(&H58, "15") - g_Tv.Add(&H5B, "20") - g_Tv.Add(&H5C, "20") - g_Tv.Add(&H5D, "25") - g_Tv.Add(&H60, "30") - g_Tv.Add(&H63, "40") - g_Tv.Add(&H64, "45") - g_Tv.Add(&H65, "50") - g_Tv.Add(&H68, "60") - g_Tv.Add(&H6B, "80") - g_Tv.Add(&H6C, "90") - g_Tv.Add(&H6D, "100") - g_Tv.Add(&H70, "125") - g_Tv.Add(&H73, "160") - g_Tv.Add(&H74, "180") - g_Tv.Add(&H75, "200") - g_Tv.Add(&H78, "250") - g_Tv.Add(&H7B, "320") - g_Tv.Add(&H7C, "350") - g_Tv.Add(&H7D, "400") - g_Tv.Add(&H80, "500") - g_Tv.Add(&H83, "640") - g_Tv.Add(&H84, "750") - g_Tv.Add(&H85, "800") - g_Tv.Add(&H88, "1000") - g_Tv.Add(&H8B, "1250") - g_Tv.Add(&H8C, "1500") - g_Tv.Add(&H8D, "1600") - g_Tv.Add(&H90, "2000") - g_Tv.Add(&H93, "2500") - g_Tv.Add(&H94, "3000") - g_Tv.Add(&H95, "3200") - g_Tv.Add(&H98, "4000") - g_Tv.Add(&H9B, "5000") - g_Tv.Add(&H9C, "6000") - g_Tv.Add(&H9D, "6400") - g_Tv.Add(&HA0, "8000") - g_Tv.Add(&HFFFFFFFF, "unknown") - - - ' PTP Camera - g_ImageQuality.Add(&H64FF0F, "RAW") - g_ImageQuality.Add(&H640013, "RAW + Large Fine Jpeg") - g_ImageQuality.Add(&H640113, "RAW + Middle Fine Jpeg") - g_ImageQuality.Add(&H640213, "RAW + Small Fine Jpeg") - g_ImageQuality.Add(&H640012, "RAW + Large Normal Jpeg") - g_ImageQuality.Add(&H640112, "RAW + Middle Normal Jpeg") - g_ImageQuality.Add(&H640212, "RAW + Small Normal Jpeg") - g_ImageQuality.Add(&H640E13, "RAW + Small1 Fine Jpeg") - g_ImageQuality.Add(&H640E12, "RAW + Small1 Normal Jpeg") - g_ImageQuality.Add(&H640F13, "RAW + Small2 Jpeg") - g_ImageQuality.Add(&H641013, "RAW + Small3 Jpeg") - - g_ImageQuality.Add(&H640010, "RAW + Large Jpeg") - g_ImageQuality.Add(&H640510, "RAW + Middle1 Jpeg") - g_ImageQuality.Add(&H640610, "RAW + Middle2 Jpeg") - g_ImageQuality.Add(&H640210, "RAW + Small Jpeg") - - g_ImageQuality.Add(&H164FF0F, "MRAW") - g_ImageQuality.Add(&H1640013, "MRAW + Large Fine Jpeg") - g_ImageQuality.Add(&H1640012, "MRAW + Large Normal Jpeg") - g_ImageQuality.Add(&H1640113, "MRAW + Middle Fine Jpeg") - g_ImageQuality.Add(&H1640112, "MRAW + Middle Normal Jpeg") - g_ImageQuality.Add(&H1640213, "MRAW + Small Fine Jpeg") - g_ImageQuality.Add(&H1640212, "MRAW + Small Normal Jpeg") - g_ImageQuality.Add(&H1640E13, "MRAW + Small1 Fine Jpeg") - g_ImageQuality.Add(&H1640E12, "MRAW + Small1 Normal Jpeg") - g_ImageQuality.Add(&H1640F13, "MRAW + Small2 Jpeg") - g_ImageQuality.Add(&H1641013, "MRAW + Small3 Jpeg") - - g_ImageQuality.Add(&H264FF0F, "SRAW") - g_ImageQuality.Add(&H2640010, "SRAW + Large Jpegg") - g_ImageQuality.Add(&H2640510, "SRAW + Middle1 Jpeg") - g_ImageQuality.Add(&H2640610, "SRAW + Middle2 Jpeg") - g_ImageQuality.Add(&H2640210, "SRAW + Small Jpeg") - - g_ImageQuality.Add(&H2640013, "SRAW + Large Fine Jpeg") - g_ImageQuality.Add(&H2640012, "SRAW + Large Normal Jpeg") - g_ImageQuality.Add(&H2640113, "SRAW + Middle Fine Jpeg") - g_ImageQuality.Add(&H2640112, "SRAW + Middle Normal Jpeg") - g_ImageQuality.Add(&H2640213, "SRAW + Small Fine Jpeg") - g_ImageQuality.Add(&H2640212, "SRAW + Small Normal Jpeg") - g_ImageQuality.Add(&H2640E13, "SRAW + Small1 Fine Jpeg") - g_ImageQuality.Add(&H2640E12, "SRAW + Small1 Normal Jpeg") - g_ImageQuality.Add(&H2640F13, "SRAW + Small2 Jpeg") - g_ImageQuality.Add(&H2641013, "SRAW + Small3 Jpeg") - - g_ImageQuality.Add(&H13FF0F, "Large Fine Jpeg") - g_ImageQuality.Add(&H12FF0F, "Large Normal Jpeg") - g_ImageQuality.Add(&H113FF0F, "Middle Fine Jpeg") - g_ImageQuality.Add(&H112FF0F, "Middle Normal Jpeg") - g_ImageQuality.Add(&H213FF0F, "Small Fine Jpeg") - g_ImageQuality.Add(&H212FF0F, "Small Normal Jpeg") - g_ImageQuality.Add(&HE13FF0F, "Small1 Fine Jpeg") - g_ImageQuality.Add(&HE12FF0F, "Small1 Normal Jpeg") - g_ImageQuality.Add(&HF13FF0F, "Small2 Jpeg") - g_ImageQuality.Add(&H1013FF0F, "Small3 Jpeg") - - g_ImageQuality.Add(&H10FF0F, "Large Jpeg") - g_ImageQuality.Add(&H510FF0F, "Middle1 Jpeg") - g_ImageQuality.Add(&H610FF0F, "Middle2 Jpeg") - g_ImageQuality.Add(&H210FF0F, "Small Jpeg") - - ' Legacy Camera - g_ImageQuality.Add(&H240000, "RAW") - g_ImageQuality.Add(&H240013, "RAW + Large Fine Jpeg") - g_ImageQuality.Add(&H240113, "RAW + Middle Fine Jpeg") - g_ImageQuality.Add(&H240213, "RAW + Small Fine Jpeg") - g_ImageQuality.Add(&H240012, "RAW + Large Normal Jpeg") - g_ImageQuality.Add(&H240112, "RAW + Middle Normal Jpeg") - g_ImageQuality.Add(&H240212, "RAW + Small Normal Jpeg") - g_ImageQuality.Add(&H130000, "Large Fine Jpeg") - g_ImageQuality.Add(&H1130000, "Middle Fine Jpeg") - g_ImageQuality.Add(&H2130000, "Small Fine Jpeg") - g_ImageQuality.Add(&H120000, "Large Normal Jpeg") - g_ImageQuality.Add(&H1120000, "Middle Normal Jpeg") - g_ImageQuality.Add(&H2120000, "Small Normal Jpeg") - - g_ImageQuality.Add(&H2F000F, "RAW") - g_ImageQuality.Add(&H2F001F, "RAW + Large Jpeg") - g_ImageQuality.Add(&H2F051F, "RAW + Middle1 Jpeg") - g_ImageQuality.Add(&H2F061F, "RAW + Middle2 Jpeg") - g_ImageQuality.Add(&H2F021F, "RAW + Small Jpeg") - g_ImageQuality.Add(&H1F000F, "Large Jpeg") - g_ImageQuality.Add(&H51F000F, "Middle1 Jpeg") - g_ImageQuality.Add(&H61F000F, "Middle2 Jpeg") - g_ImageQuality.Add(&H21F000F, "Small Jpeg") - - g_PropList.Add(kEdsPropID_AEModeSelect, g_AEMode) - g_PropList.Add(kEdsPropID_ISOSpeed, g_ISOSpeed) - g_PropList.Add(kEdsPropID_Av, g_Av) - g_PropList.Add(kEdsPropID_Tv, g_Tv) - g_PropList.Add(kEdsPropID_MeteringMode, g_MeteringMode) - g_PropList.Add(kEdsPropID_ExposureCompensation, g_ExposureComp) - g_PropList.Add(kEdsPropID_ImageQuality, g_ImageQuality) - - End Sub + g_PropList.Add(kEdsPropID_AEModeSelect, g_AEMode) + g_PropList.Add(kEdsPropID_ISOSpeed, g_ISOSpeed) + g_PropList.Add(kEdsPropID_Av, g_Av) + g_PropList.Add(kEdsPropID_Tv, g_Tv) + g_PropList.Add(kEdsPropID_MeteringMode, g_MeteringMode) + g_PropList.Add(kEdsPropID_ExposureCompensation, g_ExposureComp) + g_PropList.Add(kEdsPropID_ImageQuality, g_ImageQuality) + End Sub +#End Region ' Methods End Class