Files
TestEIn/FlatParts.vb
Dario Sassi 8a30fdd7c8 TestEIn 1.6l7 :
- aggiornamento per pezzi piatti.
2016-01-08 17:18:17 +00:00

335 lines
13 KiB
VB.net

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