Dario Sassi
6758ab821c
- ricompilazione con nuove librerie (Sqlite per .NET ver 1.0.112.0 equivalente a Sqlite nativa 3.30.1) - aggiunta indicazione numero chiave in dialogo richiesta licenza se mancante.
298 lines
14 KiB
VB.net
298 lines
14 KiB
VB.net
Imports System.Windows.Interop
|
|
Imports System.IO
|
|
Imports EgtUILib
|
|
Imports EgtWPFLib5
|
|
|
|
Public Class MySceneHostVM
|
|
Inherits EgtWPFLib5.SceneHostVM
|
|
|
|
#Region "CONSTRUCTOR"
|
|
|
|
Sub New()
|
|
MyBase.New()
|
|
AddHandler MainController.OnNewProject, AddressOf OnNewProject
|
|
AddHandler MainController.OnOpenProject, AddressOf OnOpenProject
|
|
AddHandler MainController.OnSavingProject, AddressOf OnSavingProject
|
|
AddHandler MainController.OnSavedProject, AddressOf OnSavedProject
|
|
End Sub
|
|
|
|
#End Region ' CONSTRUCTOR
|
|
|
|
#Region "METHODS"
|
|
|
|
Overrides Sub InitScene()
|
|
InitSceneEvents()
|
|
' Inizializzazione Scena
|
|
PreInitializeScene()
|
|
If MainScene.Init() And Map.refMainWindowVM.MainWindowM.GetKeyOption(KEY_OPT.PHOTO_BASE) Then
|
|
PostInitializeScene()
|
|
' Imposto stato gestione mouse diretto della scena a nessuno
|
|
MainScene.SetStatusNull()
|
|
' Recupero e imposto handle finestra principale
|
|
Dim hMainWnd As IntPtr = New WindowInteropHelper(Application.Current.MainWindow).Handle
|
|
EgtSetMainWindowHandle(hMainWnd)
|
|
Return
|
|
End If
|
|
' Se manca la chiave
|
|
If Map.refMainWindowVM.MainWindowM.nKeyLevel = -1 Or Map.refMainWindowVM.MainWindowM.nKeyLevel = -2 Then
|
|
EgtOutLog("Missing Dongle")
|
|
' Box di avviso chiave mancante : "Chiave non presente. \n Inserirla e riavviare il programma." "Errore"
|
|
Dim sText As String = EgtMsg(MSG_MISSINGKEYWD + 2) & vbCrLf & EgtMsg(MSG_MISSINGKEYWD + 3)
|
|
Dim sTitle As String = EgtMsg(MSG_MISSINGKEYWD + 1)
|
|
MessageBox.Show(sText, sTitle, MessageBoxButton.OK, MessageBoxImage.Error)
|
|
' Chiudo il programma
|
|
End
|
|
' Altrimenti manca la licenza
|
|
Else
|
|
EgtOutLog("Problems with Licence")
|
|
' Box di avviso licenza con problemi : "Programma senza licenza. \n Caricala e riavvia il programma." "Errore"
|
|
Dim sKeyInfo As String = "" : EgtGetKeyInfo( sKeyInfo)
|
|
Dim sText As String = sKeyInfo & vbCrLf & EgtMsg(MSG_MISSINGKEYWD + 5) & vbCrLf & EgtMsg(MSG_MISSINGKEYWD + 6)
|
|
Dim sTitle As String = EgtMsg(MSG_MISSINGKEYWD + 1)
|
|
If MessageBox.Show( sText, sTitle, MessageBoxButton.OKCancel, MessageBoxImage.Error) = MessageBoxResult.OK Then
|
|
' Apro dialogo per richiesta file licenza
|
|
Dim LicDlg As New Microsoft.Win32.OpenFileDialog() With {
|
|
.DefaultExt = ".lic",
|
|
.Filter = "Licences (.lic)|*.lic",
|
|
.CheckFileExists = True,
|
|
.ValidateNames = True
|
|
}
|
|
If LicDlg.ShowDialog() = True Then
|
|
' Recupero il direttorio del file
|
|
Dim sDir As String = Path.GetDirectoryName(LicDlg.FileName)
|
|
' Se il file non è già nel direttorio di configurazione lo copio
|
|
If Not String.Equals(Path.GetFullPath(sDir), Path.GetFullPath(Map.refMainWindowVM.MainWindowM.sConfigDir), StringComparison.OrdinalIgnoreCase) Then
|
|
Try
|
|
File.Copy(LicDlg.FileName, Path.Combine(Map.refMainWindowVM.MainWindowM.sConfigDir, LicDlg.SafeFileName), True)
|
|
Catch ex As Exception
|
|
End Try
|
|
End If
|
|
' Imposto il nome del nuovo file di licenza nell'Ini
|
|
WriteMainPrivateProfileString(S_GENERAL, K_LICENCE, LicDlg.SafeFileName)
|
|
End If
|
|
End If
|
|
End If
|
|
' Chiudo il programma
|
|
End
|
|
End Sub
|
|
|
|
Public Overrides Sub InitSceneEvents()
|
|
AddHandler MainScene.OnMouseDownScene, AddressOf OnMouseDownScene
|
|
AddHandler MainScene.OnMouseMoveScene, AddressOf OnMouseMoveScene
|
|
AddHandler MainScene.OnMouseUpScene, AddressOf OnMouseUpScene
|
|
AddHandler MainScene.KeyDown, AddressOf OnKeyDownScene
|
|
AddHandler MainScene.OnCursorPos, AddressOf OnCursorPos
|
|
AddHandler MainScene.OnShowDistance, AddressOf OnShowDistance
|
|
AddHandler MainScene.OnChangedSnapPointType, AddressOf OnChangedSnapPointType
|
|
End Sub
|
|
|
|
Private Sub PreInitializeScene()
|
|
' imposto colore di default
|
|
Dim DefColor As New Color3d(0, 0, 0)
|
|
GetMainPrivateProfileColor(S_GEOMDB, K_DEFAULTCOLOR, DefColor)
|
|
MainScene.SetDefaultMaterial(DefColor)
|
|
' imposto colori sfondo
|
|
Dim BackTopColor As New Color3d(192, 192, 192)
|
|
GetMainPrivateProfileColor(S_SCENE, K_BACKTOP, BackTopColor)
|
|
Dim BackBotColor As New Color3d(BackTopColor)
|
|
GetMainPrivateProfileColor(S_SCENE, K_BACKBOTTOM, BackBotColor)
|
|
MainScene.SetViewBackground(BackTopColor, BackBotColor)
|
|
' imposto colore di evidenziazione
|
|
Dim MarkColor As New Color3d(255, 255, 0)
|
|
GetMainPrivateProfileColor(S_SCENE, K_MARK, MarkColor)
|
|
MainScene.SetMarkMaterial(MarkColor)
|
|
' imposto colore per superfici selezionate
|
|
Dim SelSurfColor As New Color3d(255, 255, 192)
|
|
GetMainPrivateProfileColor(S_SCENE, K_SELSURF, SelSurfColor)
|
|
MainScene.SetSelSurfMaterial(SelSurfColor)
|
|
' imposto tipo e colore del rettangolo di zoom
|
|
Dim bOutline As Boolean = True
|
|
Dim ZwColor As New Color3d(0, 0, 0)
|
|
GetMainPrivateProfileZoomWin(S_SCENE, K_ZOOMWIN, bOutline, ZwColor)
|
|
MainScene.SetZoomWinAttribs(bOutline, ZwColor)
|
|
' imposto colore della linea di distanza
|
|
Dim DstLnColor As New Color3d(255, 0, 0)
|
|
GetMainPrivateProfileColor(S_SCENE, K_DISTLINE, DstLnColor)
|
|
MainScene.SetDistLineMaterial(DstLnColor)
|
|
' imposto parametri OpenGL
|
|
Dim nDriver As Integer = GetMainPrivateProfileInt(S_OPENGL, K_DRIVER, 3)
|
|
Dim b2Buff As Boolean = (GetMainPrivateProfileInt(S_OPENGL, K_DOUBLEBUFFER, 1) <> 0)
|
|
Dim nColorBits As Integer = GetMainPrivateProfileInt(S_OPENGL, K_COLORBITS, 32)
|
|
Dim nDepthBits As Integer = GetMainPrivateProfileInt(S_OPENGL, K_DEPTHBITS, 32)
|
|
MainScene.SetViewAttributes(nDriver, b2Buff, nColorBits, nDepthBits)
|
|
End Sub
|
|
|
|
Private Sub PostInitializeScene()
|
|
' Impostazioni Controller
|
|
MainController.SetScene(MainScene)
|
|
' imposto tipo coordinate
|
|
MainScene.SetGridCursorPos(True)
|
|
' modo di visualizzazione
|
|
'Dim nShowMode As Integer = GetMainPrivateProfileInt(S_SCENE, K_SHOWMODE, SM.SHADING) 'KK?
|
|
'Map.refShowPanelVM.SetShowMode(DirectCast(nShowMode, SM))
|
|
' visualizzazione avanzata dei triangoli costituenti le superfici
|
|
Dim bShowTriaAdv As Boolean = (GetMainPrivateProfileInt(S_SCENE, K_SHOWTRIAADV, 1) <> 0)
|
|
EgtSetShowTriaAdv(bShowTriaAdv)
|
|
' tipo visualizzazione per Zmap
|
|
Dim nShowZmap As Integer = GetMainPrivateProfileInt(S_SCENE, K_SHOWZMAP, 1)
|
|
EgtSetShowZmap(DirectCast(nShowZmap, ZSM), False)
|
|
' dimensione lineare max in pixel delle textures
|
|
Dim nTxrMaxLinPix As Integer = GetMainPrivateProfileInt(S_SCENE, K_TEXMAXLINPIX, 4096)
|
|
EgtSetTextureMaxLinPixels(nTxrMaxLinPix)
|
|
' tipo snap point
|
|
MainScene.SetSnapPointType(SP.PT_SKETCH)
|
|
End Sub
|
|
|
|
#End Region ' METHODS
|
|
|
|
#Region "EVENTS"
|
|
|
|
Private Sub OnNewProject(sender As Object, bOk As Boolean)
|
|
Map.refMainWindowVM.Title = " New - OmagOFFICE"
|
|
End Sub
|
|
|
|
Private Sub OnOpenProject(sender As Object, sFile As String, bOk As Boolean)
|
|
' Verifico la validità del file appena aperto (deve contenere almeno un gruppo di lavoro)
|
|
If EgtGetMachGroupCount() = 0 Then bOk = False
|
|
' Procedo a seconda del risultato
|
|
If bOk Then
|
|
Map.refMainWindowVM.Title = sFile & " - OmagOFFICE"
|
|
WriteMainPrivateProfileString(S_GENERAL, K_LASTPROJ, sFile)
|
|
Map.refTopCommandBarVM.m_MruFiles.Add(sFile)
|
|
Else
|
|
EgtNewFile()
|
|
Map.refMainWindowVM.Title = " New - OmagOFFICE"
|
|
Map.refTopCommandBarVM.m_MruFiles.Remove(sFile)
|
|
Dim sMsg As String = EgtMsg(10003) & " '" & sFile & "'" 'Error opening file
|
|
MessageBox.Show(sMsg, EgtMsg(10001), MessageBoxButton.OK, MessageBoxImage.Error) 'Error
|
|
End If
|
|
MainScene.SetStatusNull()
|
|
End Sub
|
|
|
|
Private Sub OnSavingProject(ByVal sender As Object, sFile As String)
|
|
'' Recupero tutti i file di texture associabili ai gruppi di lavoro del progetto
|
|
'Dim sDirToSearch As String = Path.GetDirectoryName(sFile)
|
|
'Dim sFileToSearch As String = Path.GetFileNameWithoutExtension(sFile) & "." & PHOTO_NAME & "*"
|
|
'Dim vsTxrFile As New List(Of String)
|
|
'For Each sTxrFile In My.Computer.FileSystem.GetFiles(sDirToSearch, FileIO.SearchOption.SearchTopLevelOnly, sFileToSearch)
|
|
' vsTxrFile.Add(sTxrFile)
|
|
'Next
|
|
'' Rinomino path di eventuali fotografie
|
|
'Dim nPhotoId As Integer = EgtGetFirstInGroup(EgtGetFirstNameInGroup(GDB_ID.ROOT, PHOTO_GRP))
|
|
'While nPhotoId <> GDB_ID.NULL
|
|
' ' Path originale
|
|
' Dim sPhoto As String = String.Empty
|
|
' If EgtGetPhotoPath(nPhotoId, sPhoto) Then
|
|
' ' Nome della foto
|
|
' Dim sName As String = String.Empty
|
|
' EgtGetName(nPhotoId, sName)
|
|
' ' Nuova path
|
|
' Dim sNewPhoto As String = Path.GetDirectoryName(sFile) & "\" &
|
|
' Path.GetFileNameWithoutExtension(sFile) & "." & sName &
|
|
' Path.GetExtension(sPhoto)
|
|
' ' Se diverse, eseguo copia
|
|
' If String.Compare(sPhoto, sNewPhoto, True) <> 0 Then
|
|
' Try
|
|
' ' Eseguo copia
|
|
' File.Copy(sPhoto, sNewPhoto, True)
|
|
' ' Notifico a foto il cambio di path
|
|
' EgtChangePhotoPath(nPhotoId, sNewPhoto)
|
|
' Catch ex As Exception
|
|
' End Try
|
|
' End If
|
|
' ' Tolgo da lista file texture associabili, se presente
|
|
' vsTxrFile.Remove(sNewPhoto)
|
|
' End If
|
|
' ' passo alla successiva
|
|
' nPhotoId = EgtGetNext(nPhotoId)
|
|
'End While
|
|
'' Se rimasti file associabili, li cancello
|
|
'For Each sTxrFile In vsTxrFile
|
|
' Try
|
|
' My.Computer.FileSystem.DeleteFile(sTxrFile)
|
|
' Catch
|
|
' End Try
|
|
'Next
|
|
End Sub
|
|
|
|
Private Sub OnSavedProject(ByVal sender As Object, ByVal sFile As String, ByVal bOk As Boolean)
|
|
' Se salvataggio non riuscito, esco subito
|
|
If Not bOk Then
|
|
Map.refTopCommandBarVM.m_MruFiles.Remove(sFile)
|
|
Dim sMsg As String = EgtMsg(10004) & " '" & sFile & "'" 'Error saving file
|
|
MessageBox.Show(sMsg, EgtMsg(10001), MessageBoxButton.OK, MessageBoxImage.Error) ' Error
|
|
Return
|
|
End If
|
|
' Aggiornamento titolo
|
|
Map.refMainWindowVM.Title = sFile & " - OmagOFFICE"
|
|
' Inserisco nome in MRU
|
|
Map.refTopCommandBarVM.m_MruFiles.Add(sFile)
|
|
' Salvo nome ultimo file
|
|
WriteMainPrivateProfileString(S_GENERAL, K_LASTPROJ, sFile)
|
|
End Sub
|
|
|
|
Private Sub OnMouseDownScene(sender As Object, e As Windows.Forms.MouseEventArgs)
|
|
' Si può selezionare solo con il tasto sinistro e se stato NULL
|
|
If e.Button <> Windows.Forms.MouseButtons.Left Or Not MainScene.IsStatusNull() Then Return
|
|
' Chiamo l'opportuno gestore
|
|
End Sub
|
|
|
|
Private Sub OnMouseMoveScene(sender As Object, e As Windows.Forms.MouseEventArgs)
|
|
' Chiamo l'opportuno gestore
|
|
End Sub
|
|
|
|
Private Sub OnMouseUpScene(sender As Object, e As Windows.Forms.MouseEventArgs)
|
|
' Chiamo l'opportuno gestore
|
|
End Sub
|
|
|
|
Private Sub OnKeyDownScene(sender As Object, e As System.Windows.Forms.KeyEventArgs)
|
|
' Chiamo l'opportuno gestore
|
|
End Sub
|
|
|
|
Private Sub OnCursorPos(ByVal sender As Object, ByVal sCursorPos As String)
|
|
Map.refStatusBarVM.SetCurrPos(sCursorPos)
|
|
End Sub
|
|
|
|
Private Sub OnShowDistance(ByVal sender As Object, ByVal sDistance As String)
|
|
Map.refStatusBarVM.SetOutputMessage(sDistance)
|
|
End Sub
|
|
|
|
Private Sub OnChangedSnapPointType(ByVal sender As Object, ByVal nSpType As SP, ByVal bUser As Boolean)
|
|
Dim BtnColor As Brush
|
|
If bUser Then
|
|
BtnColor = New SolidColorBrush(SystemColors.ControlColor)
|
|
Else
|
|
BtnColor = Brushes.Bisque
|
|
End If
|
|
Select Case nSpType
|
|
Case SP.PT_SKETCH
|
|
Map.refStatusBarVM.SetSnapPointType(EgtMsg(1102), BtnColor) 'Sketch Point
|
|
Case SP.PT_GRID
|
|
Map.refStatusBarVM.SetSnapPointType(EgtMsg(1104), BtnColor) 'Grid Point
|
|
Case SP.PT_END
|
|
Map.refStatusBarVM.SetSnapPointType(EgtMsg(1106), BtnColor) 'End Point
|
|
Case SP.PT_MID
|
|
Map.refStatusBarVM.SetSnapPointType(EgtMsg(1108), BtnColor) 'Mid Point
|
|
Case SP.CENTER
|
|
Map.refStatusBarVM.SetSnapPointType(EgtMsg(1110), BtnColor) 'Center
|
|
Case SP.CENTROID
|
|
Map.refStatusBarVM.SetSnapPointType(EgtMsg(1112), BtnColor) 'Centroid
|
|
Case SP.PT_NEAR
|
|
Map.refStatusBarVM.SetSnapPointType(EgtMsg(1114), BtnColor) 'Near Point
|
|
Case SP.PT_INTERS
|
|
Map.refStatusBarVM.SetSnapPointType(EgtMsg(1116), BtnColor) 'Inters Point
|
|
Case SP.PT_TANGENT
|
|
Map.refStatusBarVM.SetSnapPointType(EgtMsg(1118), BtnColor) 'Tang Point
|
|
Case SP.PT_PERPENDICULAR
|
|
Map.refStatusBarVM.SetSnapPointType(EgtMsg(1120), BtnColor) 'Perp Point
|
|
Case SP.PT_MINDIST
|
|
Map.refStatusBarVM.SetSnapPointType(EgtMsg(1122), BtnColor) 'MinDist Point
|
|
Case Else
|
|
Map.refStatusBarVM.SetSnapPointType("---", BtnColor)
|
|
End Select
|
|
End Sub
|
|
|
|
#End Region ' EVENTS
|
|
|
|
End Class
|