Imports System.IO Imports EgtUILib Public Class OpenPageUC 'Riferimento alla MainWindow Private m_MainWindow As MainWindow = Application.Current.MainWindow 'Dichiarazione dello UserControl SceneButtons Private m_SceneButtons As SceneButtonsUC ' Properties Private m_sCurrDir As String = String.Empty Private m_sCurrFile As String = String.Empty Private m_bFirst As Boolean = True Private m_bFileOk As Boolean = False ' Dichiarazione Scene Friend WithEvents OpenScene As New Scene Dim OpenSceneHost As New System.Windows.Forms.Integration.WindowsFormsHost Private Sub OpenPage_Initialized(sender As Object, e As EventArgs) ' Creazione dello UserControl SceneButtons m_SceneButtons = New SceneButtonsUC ' Posizionemento nella griglia del UserControl SceneButtons m_SceneButtons.SetValue(Grid.ColumnProperty, 1) UpperButtonsGrid.Children.Add(m_SceneButtons) ' Assegnazione scena all'host e posizionamento nella OpenPageGrid OpenSceneHost.Child = OpenScene OpenSceneHost.SetValue(Grid.ColumnProperty, 1) OpenSceneHost.SetValue(Grid.RowProperty, 2) ' OpenSceneHost.SetValue(Grid.RowSpanProperty, 1) Me.OpenPageGrid.Children.Add(OpenSceneHost) ' Definizione del collegamento tra ItemList e ListBox1 FileListBox.ItemsSource = m_MainWindow.m_OpenItemList End Sub Private Sub OpenPage_Loaded(sender As Object, e As RoutedEventArgs) If m_bFirst Then ' imposto colore di default Dim DefColor As New Color3d(0, 0, 0) GetPrivateProfileColor(S_GEOMDB, K_DEFAULTCOLOR, DefColor, m_MainWindow.GetIniFile()) OpenScene.SetDefaultMaterial(DefColor) ' imposto colori sfondo Dim BackTopColor As New Color3d(192, 192, 192) GetPrivateProfileColor(S_SCENE, K_BACKTOP, BackTopColor, m_MainWindow.GetIniFile()) Dim BackBotColor As New Color3d(BackTopColor) GetPrivateProfileColor(S_SCENE, K_BACKBOTTOM, BackBotColor, m_MainWindow.GetIniFile()) OpenScene.SetViewBackground(BackTopColor, BackBotColor) ' imposto colore di evidenziazione Dim MarkColor As New Color3d(255, 255, 0) GetPrivateProfileColor(S_SCENE, K_MARK, MarkColor, m_MainWindow.GetIniFile()) OpenScene.SetMarkMaterial(MarkColor) ' imposto colore per superfici selezionate Dim SelSurfColor As New Color3d(255, 255, 192) GetPrivateProfileColor(S_SCENE, K_SELSURF, SelSurfColor, m_MainWindow.GetIniFile()) OpenScene.SetSelSurfMaterial(SelSurfColor) ' imposto tipo e colore del rettangolo di zoom Dim bOutline As Boolean = True Dim ZwColor As New Color3d(0, 0, 0) GetPrivateProfileZoomWin(S_SCENE, K_ZOOMWIN, bOutline, ZwColor, m_MainWindow.GetIniFile()) OpenScene.SetZoomWinAttribs(bOutline, ZwColor) ' imposto colore della linea di distanza Dim DstLnColor As New Color3d(255, 0, 0) GetPrivateProfileColor(S_SCENE, K_DISTLINE, DstLnColor, m_MainWindow.GetIniFile()) OpenScene.SetDistLineMaterial(DstLnColor) ' imposto parametri OpenGL Dim nDriver As Integer = GetPrivateProfileInt(S_OPENGL, K_DRIVER, 3, m_MainWindow.GetIniFile()) Dim b2Buff As Boolean = (GetPrivateProfileInt(S_OPENGL, K_DOUBLEBUFFER, 1, m_MainWindow.GetIniFile()) <> 0) Dim nColorBits As Integer = GetPrivateProfileInt(S_OPENGL, K_COLORBITS, 32, m_MainWindow.GetIniFile()) Dim nDepthBits As Integer = GetPrivateProfileInt(S_OPENGL, K_DEPTHBITS, 32, m_MainWindow.GetIniFile()) OpenScene.SetViewAttributes(nDriver, b2Buff, nColorBits, nDepthBits) ' Inizializzazione delle viste OpenScene.Init() ' inizializzo gestore lavorazioni EgtInitMachMgr(m_MainWindow.GetMachinesRootDir()) ' leggo direttorio corrente GetPrivateProfileString(S_GENERAL, K_SAVENAMEDIR, "", m_sCurrDir, m_MainWindow.GetIniFile()) ' lo carico LoadCurrDir() m_bFirst = False Else EgtSetCurrentContext(OpenScene.GetCtx()) End If ' Pulisco tutto ClearView() ' inibisco selezione diretta da Scene OpenScene.SetStatusNull() End Sub Private Function LoadCurrDir() As Boolean ' se direttorio corrente non valido, carico l'elenco dei dischi If String.IsNullOrWhiteSpace(m_sCurrDir) OrElse Not IO.Directory.Exists(m_sCurrDir) Then Return LoadDisks() End If Dim TempPath As New Text.StringBuilder(260) PathCompactPathEx(TempPath, m_sCurrDir, 28, 0) ' lo visualizzo FilePathTxBl.Content = TempPath.ToString ' pulisco la lista m_MainWindow.m_OpenItemList.Clear() ' per risalire al direttorio padre m_MainWindow.m_OpenItemList.Add(New IconListBoxItem("..", 0)) ' elenco dei sottodirettori Dim DirInfo As New DirectoryInfo(m_sCurrDir) Dim vDirI As DirectoryInfo() = DirInfo.GetDirectories("*") Dim DirI As DirectoryInfo For Each DirI In vDirI ' per saltare i link, troppo complessi da gestire If (DirI.Attributes And FileAttributes.Hidden) <> FileAttributes.Hidden Or (DirI.Attributes And FileAttributes.System) <> FileAttributes.System Then m_MainWindow.m_OpenItemList.Add(New IconListBoxItem(DirI.Name, 2)) End If Next ' elenco dei file Dim vFileI As FileInfo() = DirInfo.GetFiles() Dim FileI As FileInfo For Each FileI In vFileI Dim sExt As String = Path.GetExtension(FileI.Name).ToUpper() If sExt = ".NGE" Then m_MainWindow.m_OpenItemList.Add(New IconListBoxItem(FileI.Name, 3)) End If Next ' pulisco la vista ClearView() Return True End Function Private Function LoadDisks() As Boolean ' dir corrente vuoto m_sCurrDir = "" ' lo visualizzo FilePathTxBl.Content = m_sCurrDir ' pulisco la lista m_MainWindow.m_OpenItemList.Clear() ' elenco dei dischi Dim vDriI As DriveInfo() = DriveInfo.GetDrives() Dim DriI As DriveInfo For Each DriI In vDriI m_MainWindow.m_OpenItemList.Add(New IconListBoxItem(DriI.Name, 1)) Next ' pulisco la vista ClearView() Return True End Function Private Sub FileListBox_PreviewMouseUp(sender As Object, e As MouseButtonEventArgs) Handles FileListBox.PreviewMouseUp ' Recupero item selezionato If FileListBox.SelectedItems.Count() = 0 Then Return End If Dim vItems As IconListBoxItem = FileListBox.SelectedItems(0) ' A seconda del tipo Select Case vItems.PictureID Case 0 ' Vai nel direttorio padre m_sCurrDir = IO.Path.GetDirectoryName(m_sCurrDir) m_sCurrFile = "" LoadCurrDir() Case 1 ' Vai nella radice del disco m_sCurrDir = vItems.Name m_sCurrFile = "" LoadCurrDir() Case 2 ' Vai nel sottodirettorio m_sCurrDir = IO.Path.Combine(m_sCurrDir, vItems.Name) m_sCurrFile = "" LoadCurrDir() Case 3 ' File m_sCurrFile = vItems.Name LoadCurrFile() End Select End Sub Private Sub FileListBox_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles FileListBox.SelectionChanged ' Recupero item selezionato If FileListBox.SelectedItems.Count() = 0 Then Return End If Dim vItems As IconListBoxItem = FileListBox.SelectedItems(0) ' Gestisco solo aggiornamento visualizzazione file If vItems.PictureID = 3 Then m_sCurrFile = vItems.Name LoadCurrFile() End If End Sub Private Function ClearView() As Boolean ' Pulisco il DB geometrico locale EgtNewFile() ' Eseguo zoom OpenScene.ZoomAll() ' Cancello messaggio MessageTxBx.Text = "" MessageBrd.Background = Brushes.Transparent OkBtn.IsEnabled = False m_bFileOk = False Return True End Function Private Function LoadCurrFile() As Boolean ' Pulisco il DB geometrico locale Dim bOk As Boolean = EgtNewFile() ' Costruisco path completa del file Dim sPath = IO.Path.Combine(m_sCurrDir, m_sCurrFile) ' Riconoscimento tipo Dim nFileType As Integer = EgtGetFileType(sPath) If nFileType = FT.NGE Then ' Carico Nge bOk = bOk AndAlso EgtOpenFile(sPath) ' attivo il gruppo di lavoro corrente Dim nMachGrpId As Integer = EgtGetFirstMachGroup() EgtSetCurrMachGroup(nMachGrpId) EgtShowOnlyTable(True) Else ' Formato sconosciuto bOk = False End If ' Cerco contrassegno di progetto OmagCut e flag di tagli ridotti Dim nMarkId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_PROJMARK) Dim bMarkOk = (nMarkId <> GDB_ID.NULL) Dim nFileReducedCut As Integer = 1 EgtGetInfo(nMarkId, INFO_REDUCEDCUT, nFileReducedCut) Dim nReducedCut As Integer = GetPrivateProfileInt(S_MACH_NEST, K_MACH_REDUCEDCUT, 0, m_MainWindow.GetMachIniFile()) Dim bReducedCutOk = (nFileReducedCut = 0) OrElse (nFileReducedCut <> 0 And nReducedCut <> 0) OrElse VerifyPartsNesting(False) m_bFileOk = bOk And bMarkOk And bReducedCutOk If m_bFileOk Then MessageTxBx.Text = "" MessageBrd.Background = Brushes.Transparent OkBtn.IsEnabled = True ElseIf Not bMarkOk Then MessageTxBx.Text = EgtMsg(MSG_OPENPAGEUC + 1) 'Progetto non valido MessageBrd.Background = Brushes.Tomato OkBtn.IsEnabled = False Else MessageTxBx.Text = EgtMsg(MSG_OPENPAGEUC + 2) 'Progetto con interferenze. Per caricarlo disabilita rispetto tagli completi. MessageBrd.Background = Brushes.Tomato OkBtn.IsEnabled = False End If ' Eseguo zoom OpenScene.ZoomAll() Return bOk End Function Private Function VerifyPartsNesting(bReducedCut As Boolean) As Boolean ' Recupero il grezzo Dim nRawId As Integer = EgtGetFirstRawPart() ' Ciclo su tutti i pezzi in tavola Dim nPartId As Integer = EgtGetFirstGroupInGroup(nRawId) While nPartId <> GDB_ID.NULL If Not EgtVerifyPart(nPartId, bReducedCut, -10000, -10000, 10000, 10000) Then Return False End If nPartId = EgtGetNextGroup(nPartId) End While Return True End Function Private Sub OnMouseDownScene(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles OpenScene.OnMouseDownScene End Sub Private Sub ConfirmBtn_Click(sender As Object, e As RoutedEventArgs) Handles OkBtn.Click ' Lancio caricamento nuovo progetto corrente If m_bFileOk Then m_MainWindow.m_CadCutPageUC.PostLoad(m_sCurrDir, m_sCurrFile) End If ' Istruzioni per chiudere OpenPageUC e aprire currentproject e cadcut page m_MainWindow.MainWindowGrid.Children.Remove(m_MainWindow.m_OpenPage) m_MainWindow.MainWindowGrid.Children.Add(m_MainWindow.m_CurrentProjectPageUC) m_MainWindow.m_ActivePage = MainWindow.Pages.CadCut End Sub Private Sub ExitBtn_Click(sender As Object, e As RoutedEventArgs) Handles ExitBtn.Click ' Istruzioni per chiudere OpenPageUC e aprire currentproject e cadcut page m_MainWindow.MainWindowGrid.Children.Remove(m_MainWindow.m_OpenPage) m_MainWindow.MainWindowGrid.Children.Add(m_MainWindow.m_CurrentProjectPageUC) m_MainWindow.m_ActivePage = MainWindow.Pages.CadCut ' Non modifico progetto corrente End Sub Private Sub OpenPage_Unloaded(sender As Object, e As RoutedEventArgs) End Sub End Class