Imports System.IO Imports TestEIn.EgtInterface Imports TestEIn.Scene Public Class FlatParts ' Properties Private m_sCurrDir As String = String.Empty Private m_sCurrFile As String = String.Empty Private m_nFileType As Integer = FT.NULL Private Sub FlatParts_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load ' imposto colore di default Dim DefColor As New Color3d(0, 0, 0) GetPrivateProfileColor(S_GEOMDB, K_DEFAULTCOLOR, DefColor, Form1.GetIniFile()) Scene2.SetDefaultMaterial(DefColor) ' imposto colori sfondo Dim BackTopColor As New Color3d(192, 192, 192) GetPrivateProfileColor(S_SCENE, K_BACKTOP, BackTopColor, Form1.GetIniFile()) Dim BackBotColor As New Color3d(BackTopColor) GetPrivateProfileColor(S_SCENE, K_BACKBOTTOM, BackBotColor, Form1.GetIniFile()) Scene2.SetViewBackground(BackTopColor, BackBotColor) ' imposto colore di evidenziazione Dim MarkColor As New Color3d(255, 255, 0) GetPrivateProfileColor(S_SCENE, K_MARK, MarkColor, Form1.GetIniFile()) Scene2.SetMarkMaterial(MarkColor) ' imposto colore per superfici selezionate Dim SelSurfColor As New Color3d(255, 255, 192) GetPrivateProfileColor(S_SCENE, K_SELSURF, SelSurfColor, Form1.GetIniFile()) Scene2.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, Form1.GetIniFile()) Scene2.SetZoomWinAttribs(bOutline, ZwColor) ' imposto colore della linea di distanza Dim DstLnColor As New Color3d(255, 0, 0) GetPrivateProfileColor(S_SCENE, K_DISTLINE, DstLnColor, Form1.GetIniFile()) Scene2.SetDistLineMaterial(DstLnColor) ' imposto parametri OpenGL Dim nDriver As Integer = GetPrivateProfileInt(S_OPENGL, K_DRIVER, 3, Form1.GetIniFile()) Dim b2Buff As Boolean = (GetPrivateProfileInt(S_OPENGL, K_DOUBLEBUFFER, 1, Form1.GetIniFile()) <> 0) Dim nColorBits As Integer = GetPrivateProfileInt(S_OPENGL, K_COLORBITS, 32, Form1.GetIniFile()) Dim nDepthBits As Integer = GetPrivateProfileInt(S_OPENGL, K_DEPTHBITS, 32, Form1.GetIniFile()) Scene2.SetViewAttributes(nDriver, b2Buff, nColorBits, nDepthBits) ' inizializzo la scena (DB geometrico + visualizzazione) Scene2.Init() ' assegno posizione e dimensioni finestra Dim nFlag As Integer Dim nLeft As Integer Dim nTop As Integer Dim nWidth As Integer Dim nHeight As Integer GetPrivateProfileWinPos(S_FLATPARTS, K_FLPWINPLACE, nFlag, nLeft, nTop, nWidth, nHeight, Form1.GetIniFile()) Dim PtTL = New Point(nLeft, nTop) Dim s As Screen = Screen.FromPoint(PtTL) If s.Bounds.Contains(PtTL) Then Me.StartPosition = System.Windows.Forms.FormStartPosition.Manual Me.Location = New Point(nLeft, nTop) Me.Size = New Size(nWidth, nHeight) WindowState = If(nFlag = 1, FormWindowState.Maximized, FormWindowState.Normal) End If ' leggo direttorio corrente GetPrivateProfileString(S_FLATPARTS, K_FLPCURRDIR, "", m_sCurrDir, Form1.GetIniFile()) ' lo carico LoadCurrDir() ' imposto misura If EgtUiUnitsAreMM() Then rbMm.Select() Else rbInch.Select() End If End Sub Private Sub FlatParts_FormClosing(sender As System.Object, e As FormClosingEventArgs) Handles MyBase.FormClosing ' Salvo posizione finestra Dim nFlag As Integer = If(Me.WindowState = FormWindowState.Maximized, 1, 0) WritePrivateProfileWinPos(S_FLATPARTS, K_FLPWINPLACE, nFlag, Me.Left, Me.Top, Me.Width, Me.Height, Form1.GetIniFile()) ' Salvo direttorio corrente WritePrivateProfileString(S_FLATPARTS, K_FLPCURRDIR, m_sCurrDir, Form1.GetIniFile()) ' Termino la scena (DB geometrico + visualizzazione) Scene2.Terminate() End Sub Private Sub FlatParts_KeyDown(ByVal sender As System.Object, ByVal e As KeyEventArgs) Handles Me.KeyDown If e.KeyData = Keys.Escape Then Me.DialogResult = System.Windows.Forms.DialogResult.Cancel Me.Close() End If End Sub Private Sub ListView1_SelectedIndexChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles ListView1.SelectedIndexChanged ' Recupero item selezionato Dim vItems As ListView.SelectedListViewItemCollection = ListView1.SelectedItems If vItems.Count() = 0 Then Return End If ' Gestisco solo aggiornamento visualizzazione file If vItems(0).ImageIndex = 3 Then m_sCurrFile = vItems(0).Text LoadCurrFile() End If End Sub Private Sub ListView1_ItemActivate(ByVal sender As Object, ByVal e As System.EventArgs) Handles ListView1.ItemActivate ' Recupero item selezionato Dim vItems As ListView.SelectedListViewItemCollection = ListView1.SelectedItems If vItems.Count() = 0 Then Return End If ' A seconda del tipo Select Case vItems(0).ImageIndex Case 0 ' Vai nel direttorio padre m_sCurrDir = IO.Path.GetDirectoryName(m_sCurrDir) m_sCurrFile = "" LoadCurrDir() ListView1.Items(0).Selected = True ListView1.Items(0).Focused = True Case 1 ' Vai nella radice del disco m_sCurrDir = vItems(0).Text m_sCurrFile = "" LoadCurrDir() ListView1.Items(0).Selected = True ListView1.Items(0).Focused = True Case 2 ' Vai nel sottodirettorio m_sCurrDir = IO.Path.Combine(m_sCurrDir, vItems(0).Text) m_sCurrFile = "" LoadCurrDir() ListView1.Items(0).Selected = True ListView1.Items(0).Focused = True Case 3 ' File ' Viene gestito dalla SelectedIndexChanged End Select End Sub Private Sub rbMm_CheckedChanged(sender As Object, e As EventArgs) Handles rbMm.CheckedChanged If Not String.IsNullOrWhiteSpace(m_sCurrFile) Then LoadCurrFile() End If 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 ' lo visualizzo tbCurrDir.Text = m_sCurrDir ' Inizio aggiornamento lista ListView1.BeginUpdate() ' pulisco la lista ListView1.Clear() ' per risalire al direttorio padre ListView1.Items.Add("..", 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 If (DirI.Attributes And FileAttributes.Hidden) <> FileAttributes.Hidden Then ListView1.Items.Add(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 = ".DXF" Or sExt = ".NGE" Then ListView1.Items.Add(FileI.Name, 3) End If Next ' Fine aggiornamento lista ListView1.EndUpdate() ' pulisco la vista ClearView() Return True End Function Private Function LoadDisks() As Boolean ' dir corrente vuoto m_sCurrDir = "" ' lo visualizzo tbCurrDir.Text = m_sCurrDir ' Inizio aggiornamento lista ListView1.BeginUpdate() ' pulisco la lista ListView1.Clear() ' elenco dei dischi Dim vDriI As DriveInfo() = DriveInfo.GetDrives() Dim DriI As DriveInfo For Each DriI In vDriI ListView1.Items.Add(DriI.Name, 1) Next ' Fine aggiornamento lista ListView1.EndUpdate() ' pulisco la vista ClearView() Return True End Function Private Function ClearView() As Boolean ' Pulisco il DB geometrico locale EgtNewFile() ' Eseguo zoom Scene2.ZoomAll() ' disabilito bottoni Process e Insert btnUseLayer.Enabled = False btnUseClosedCurve.Enabled = False btnUseRegion.Enabled = False btnReset.Enabled = False btnInsert.Enabled = False Return True End Function Private Function LoadCurrFile() As Boolean ' Pulisco il DB geometrico locale Dim bOk As Boolean = EgtNewFile() ' Costruisco path completa del componente Dim sPath = IO.Path.Combine(m_sCurrDir, m_sCurrFile) ' Riconoscimento tipo m_nFileType = EgtGetFileType(sPath) If m_nFileType = FT.DXF Then ' recupero unità di misura del file Dim dScale As Double = If(rbMm.Checked(), ONEMM, ONEINCH) ' Importo file DXF bOk = bOk AndAlso EgtImportDxf(sPath, dScale) ElseIf m_nFileType = FT.NGE Then ' Carico Nge bOk = bOk AndAlso EgtOpenFile(sPath) Else ' Formato sconosciuto EgtNewFile() bOk = False End If ' Eseguo zoom Scene2.ZoomAll() ' abilito bottoni UseLayer e UseRegion, disabilito Reset e Insert btnUseLayer.Enabled = True btnUseClosedCurve.Enabled = True btnUseRegion.Enabled = True btnReset.Enabled = False btnInsert.Enabled = False Return bOk End Function Private Sub btnUseLayer_Click(sender As Object, e As EventArgs) Handles btnUseLayer.Click ' Creo i pezzi Dim nType As Integer = If(m_nFileType = FT.NGE, FPC_TYPE.NGE, FPC_TYPE.LAYER) EgtCreateFlatParts(nType) ' Eseguo zoom Scene2.ZoomAll() ' disabilito bottoni UseLayer e UseRegion, abilito bottoni Reset e Insert btnUseLayer.Enabled = False btnUseClosedCurve.Enabled = False btnUseRegion.Enabled = False btnReset.Enabled = True btnInsert.Enabled = True End Sub Private Sub btnUseClosedCurve_Click(sender As Object, e As EventArgs) Handles btnUseClosedCurve.Click ' Creo i pezzi Dim nType As Integer = If(m_nFileType = FT.NGE, FPC_TYPE.NGE, FPC_TYPE.CLOSEDCURVE) EgtCreateFlatParts(nType) ' Eseguo zoom Scene2.ZoomAll() ' disabilito bottoni UseLayer e UseRegion, abilito bottoni Reset e Insert btnUseLayer.Enabled = False btnUseClosedCurve.Enabled = False btnUseRegion.Enabled = False btnReset.Enabled = True btnInsert.Enabled = True End Sub Private Sub btnUseRegion_Click(sender As Object, e As EventArgs) Handles btnUseRegion.Click ' Creo i pezzi Dim nType As Integer = If(m_nFileType = FT.NGE, FPC_TYPE.NGE, FPC_TYPE.REGION) EgtCreateFlatParts(nType) ' Eseguo zoom Scene2.ZoomAll() ' disabilito bottoni UseLayer e UseRegion, abilito bottoni Reset e Insert btnUseLayer.Enabled = False btnUseClosedCurve.Enabled = False btnUseRegion.Enabled = False btnReset.Enabled = True btnInsert.Enabled = True End Sub Private Sub btnReset_Click(sender As Object, e As EventArgs) Handles btnReset.Click ' Ricarico file corrente LoadCurrFile() End Sub Private Sub btnInsert_Click(sender As Object, e As EventArgs) Handles btnInsert.Click ' Vettore nomi file temporanei Dim sTmpFiles As New ArrayList() ' Ciclo di salvataggio dei pezzi Dim nId As Integer = EgtGetFirstPart() While nId <> GDB_ID.NULL ' Esporto il pezzo in un file temporaneo Dim sTmpFile As String = Form1.GetTempDir() & "\FlatPart" & nId & ".Nge" sTmpFiles.Add(sTmpFile) If Not EgtSaveObjToFile(nId, sTmpFile, NGE.BIN) Then Return End If ' Passo al pezzo successivo nId = EgtGetNextPart(nId) End While ' Passo al contesto principale EgtSetCurrentContext(Form1.GetCtx()) ' Elimino eventuali precedenti pezzi vuoti EgtEraseEmptyParts() ' Ciclo di caricamento dei pezzi For Each sTmpfile As String In sTmpFiles If My.Computer.FileSystem.FileExists(sTmpfile) Then ' Inserisco il pezzo EgtInsertFile(sTmpfile) ' Ne recupero l'Id Dim nId2 As Integer = EgtGetLastPart() ' Lo posiziono in ordine EgtPackBox(nId2, 0, 0, PACK_MAX_X, PACK_MAX_Y, PACK_OFFS, True) ' Cancello il file My.Computer.FileSystem.DeleteFile(sTmpfile) End If Next ' Aggiorno ambiente principale EgtZoom(ZM.ALL) Form1.LoadObjTree() ' Chiudo il dialogo Me.DialogResult = System.Windows.Forms.DialogResult.OK Me.Close() End Sub End Class