EgtPHOTOLib/SceneHostSlab/MySceneHostSlabVM.vb

Imports System.Collections.ObjectModel
Imports System.Windows.Interop
Imports System.IO
Imports EgtUILib
Imports EgtWPFLib5

Public Class MySceneHostSlabVM
   Inherits EgtWPFLib5.SceneHostVM

   Friend m_MruFiles As New MruList
   Public ReadOnly Property MruFileNames As ObservableCollection(Of String)
      Get
         Return m_MruFiles.FileNames
      End Get
   End Property

   ' Titolo
   Private m_Title As String
   Public Property Title As String
      Get
         Return m_Title
      End Get
      Set(value As String)
         m_Title = value
         NotifyPropertyChanged("Title")
      End Set
   End Property

#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 MainData.GetKeyOption(KEY_OPT.MAN_PHOTO) 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)
         SetContextSTONELib(EgtGetCurrentContext())
         PhotoMap.m_ContinueApplication = True
         Return
      End If
      ' Se manca la chiave
      If MainData.nKeyLevel = -1 Or MainData.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)
         PhotoMap.m_ContinueApplication = False
         ' 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(MainData.sConfigDir), StringComparison.OrdinalIgnoreCase) Then
                  Try
                     File.Copy(LicDlg.FileName, Path.Combine(MainData.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
      PhotoMap.m_ContinueApplication = False
   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)
      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
         Title = sFile & " - OmagOFFICE"
         WriteMainPrivateProfileString(S_GENERAL, K_LASTPROJ, sFile)
         m_MruFiles.Add(sFile)
      Else
         EgtNewFile()
         Title = " New - OmagOFFICE"
         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
         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
      Title = sFile & " - OmagOFFICE"
      ' Inserisco nome in MRU
      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)
      PhotoMap.refStatusBarVM.SetCurrPos(sCursorPos)
   End Sub

   Private Sub OnShowDistance(ByVal sender As Object, ByVal sDistance As String)
      PhotoMap.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
            PhotoMap.refStatusBarVM.SetSnapPointType(EgtMsg(1102), BtnColor)             'Sketch Point
         Case SP.PT_GRID
            PhotoMap.refStatusBarVM.SetSnapPointType(EgtMsg(1104), BtnColor)             'Grid Point
         Case SP.PT_END
            PhotoMap.refStatusBarVM.SetSnapPointType(EgtMsg(1106), BtnColor)             'End Point
         Case SP.PT_MID
            PhotoMap.refStatusBarVM.SetSnapPointType(EgtMsg(1108), BtnColor)             'Mid Point
         Case SP.CENTER
            PhotoMap.refStatusBarVM.SetSnapPointType(EgtMsg(1110), BtnColor)             'Center
         Case SP.CENTROID
            PhotoMap.refStatusBarVM.SetSnapPointType(EgtMsg(1112), BtnColor)             'Centroid
         Case SP.PT_NEAR
            PhotoMap.refStatusBarVM.SetSnapPointType(EgtMsg(1114), BtnColor)             'Near Point
         Case SP.PT_INTERS
            PhotoMap.refStatusBarVM.SetSnapPointType(EgtMsg(1116), BtnColor)             'Inters Point
         Case SP.PT_TANGENT
            PhotoMap.refStatusBarVM.SetSnapPointType(EgtMsg(1118), BtnColor)             'Tang Point
         Case SP.PT_PERPENDICULAR
            PhotoMap.refStatusBarVM.SetSnapPointType(EgtMsg(1120), BtnColor)             'Perp Point
         Case SP.PT_MINDIST
            PhotoMap.refStatusBarVM.SetSnapPointType(EgtMsg(1122), BtnColor)             'MinDist Point
         Case Else
            PhotoMap.refStatusBarVM.SetSnapPointType("---", BtnColor)
      End Select
   End Sub

#End Region    ' EVENTS

End Class