Egalware/TestEIn
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
3bf44d444dd39b451a760277b6d62cd5afa425c8
TestEIn/Form1.vb
T
Dario Sassi 3bf44d444d TestEIn 1.6a4 : 
- sistemata gestione multi istanze (per log e registrazione comandi lua)
- aggiornamento comandi per modifiche a EgtInterface.
2015-01-26 07:55:00 +00:00

1365 lines
54 KiB
VB.net
Raw Blame History

'----------------------------------------------------------------------------
' EgalTech 2014-2015
'----------------------------------------------------------------------------
' File : Form1.vb Data : 18.01.15 Versione : 1.6a3
' Contenuto : Classe Form1 (dialogo principale dell'applicazione).
'
'
'
' Modifiche : 25.08.14 DS Creazione modulo.
'
'
'----------------------------------------------------------------------------
Imports System.Runtime.InteropServices
Imports System.Threading
Imports System.Text
Imports System.Math
Imports System.IO
Imports System.Globalization
Imports TestEIn.EgtInterface
Imports TestEIn.GenInterface
Imports TestEIn.Controller
Public Class Form1
Private m_objMutex As Mutex
Private m_nInstance As Integer = 0
Private m_sDataRoot As String = String.Empty
Private m_sIniFile As String = String.Empty
Private WithEvents m_Controller As New Controller
Private m_bShowGrid As Boolean
Private m_bShowGridFrame As Boolean
Private m_bCPlaneTypePos As Boolean
Public Function GetInstance() As Integer
Return m_nInstance
End Function
Public Function GetExeRoot() As String
Return Application.StartupPath
End Function
Public Function GetDataRoot() As String
Return m_sDataRoot
End Function
'-------------------------------- Form ------------------------------------------------------------
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
' Installo aggiornamento interfaccia
AddHandler System.Windows.Forms.Application.Idle, AddressOf Application_Idle
' Title
EmitTitle()
' Impostazione path radice per i dati
m_sDataRoot = Application.StartupPath
If GetPrivateProfileString("Data", "DataRoot", "", m_sDataRoot, m_sDataRoot & "\DataRoot.Ini") = 0 Then
m_sDataRoot = Application.StartupPath
End If
' Impostazione path Ini file
m_sIniFile = m_sDataRoot & "\TestEIn.ini"
' Verifico indice di istanza
m_objMutex = New Mutex(False, "Global\TestEIn")
If m_objMutex.WaitOne(0, False) Then
' Prima istanza
m_nInstance = 1
' Aggiorno stato istanze attive
WritePrivateProfileString("General", "Instances", m_nInstance, m_sIniFile)
Else
' Cerco il primo indice di istanza libero (max 32)
Dim nTmp As Integer = GetPrivateProfileInt("General", "Instances", 0, m_sIniFile)
m_nInstance = 1
Dim nMask As Integer = 1
While (nTmp And nMask) <> 0 And m_nInstance < 32
m_nInstance += 1
nMask *= 2
End While
' Aggiorno stato istanze attive
nTmp += (1 << (m_nInstance - 1))
WritePrivateProfileString("General", "Instances", nTmp, m_sIniFile)
End If
' Inizializzazione generale di EgtInterface
Dim sIniFile As String = m_sDataRoot & "\EInGenlog" & m_nInstance.ToString() & ".txt"
EgtInit(0, sIniFile)
' imposto chiave di protezione
Dim sKey As String = String.Empty
GetPrivateProfileString("General", "Key", "", sKey, m_sIniFile)
EgtSetKey(sKey)
' imposto dir font Nfe e font default
Dim sNfeDir As String = String.Empty
GetPrivateProfileString("GeomDB", "NfeFontDir", "", sNfeDir, m_sIniFile)
Dim sDefFont As String = String.Empty
GetPrivateProfileString("GeomDB", "DefaultFont", "", sDefFont, m_sIniFile)
EgtSetFont(sNfeDir, sDefFont)
' imposto dir di default per libreria Lua e lancio libreria di base
Dim sLuaLibsDir As String = String.Empty
GetPrivateProfileString("Lua", "LibsDir", "", sLuaLibsDir, m_sIniFile)
EgtSetLuaLibs(sLuaLibsDir)
Dim sLuaBaseLib As String = String.Empty
GetPrivateProfileString("Lua", "BaseLib", "EgtBase", sLuaBaseLib, m_sIniFile)
EgtLuaRequire(sLuaBaseLib)
' imposto colore di default
Dim DefColor As New Color3d(0, 0, 0)
GetPrivateProfileColor("GeomDB", "DefaultColor", DefColor, m_sIniFile)
Scene1.SetDefaultMaterial(DefColor)
' imposto colori sfondo
Dim BackTopColor As New Color3d(192, 192, 192)
GetPrivateProfileColor("Scene", "BackTop", BackTopColor, m_sIniFile)
Dim BackBotColor As New Color3d(192, 192, 192)
GetPrivateProfileColor("Scene", "BackBottom", BackBotColor, m_sIniFile)
Scene1.SetViewBackground(BackTopColor, BackBotColor)
' imposto colore di evidenziazione
Dim MarkColor As New Color3d(255, 255, 0)
GetPrivateProfileColor("Scene", "Mark", MarkColor, m_sIniFile)
Scene1.SetMarkMaterial(MarkColor)
' imposto colore per superfici selezionate
Dim SelSurfColor As New Color3d(255, 255, 192)
GetPrivateProfileColor("Scene", "SelSurf", SelSurfColor, m_sIniFile)
Scene1.SetSelSurfMaterial(SelSurfColor)
' imposto tipo e colore del rettangolo di zoom
Dim bOutline As Boolean = True
Dim ZwColor As New Color3d(0, 0, 0)
GetPrivateProfileZoomWin("Scene", "ZoomWin", bOutline, ZwColor, m_sIniFile)
Scene1.SetZoomWinAttribs(bOutline, ZwColor)
' imposto colore della linea di distanza
Dim DstLnColor As New Color3d(255, 0, 0)
GetPrivateProfileColor("Scene", "DistLine", DstLnColor, m_sIniFile)
Scene1.SetDistLineMaterial(DstLnColor)
' imposto parametri OpenGL
Dim nDriver As Integer = GetPrivateProfileInt("OpenGL", "Driver", 3, m_sIniFile)
Dim b2Buff As Boolean = (GetPrivateProfileInt("OpenGL", "DoubleBuffer", 1, m_sIniFile) <> 0)
Dim nColorBits As Integer = GetPrivateProfileInt("OpenGL", "ColorBits", 32, m_sIniFile)
Dim nDepthBits As Integer = GetPrivateProfileInt("OpenGL", "DepthBits", 32, m_sIniFile)
Scene1.SetViewAttributes(nDriver, b2Buff, nColorBits, nDepthBits)
' inizializzo scena
Scene1.Init()
' imposto visualizzazione riferimento globale
Dim bShowGlobFrame As Boolean = (GetPrivateProfileInt("Scene", "ShowGFrame", 1, m_sIniFile) <> 0)
EgtSetGlobFrameShow(bShowGlobFrame)
' imposto i dati della griglia
m_bShowGrid = (GetPrivateProfileInt("Grid", "ShowGrid", 1, m_sIniFile) <> 0)
m_bShowGridFrame = (GetPrivateProfileInt("Grid", "ShowFrame", 1, m_sIniFile) <> 0)
Dim dSnapStep As Double = GetPrivateProfileDouble("Grid", "SnapStep", 10, m_sIniFile)
Dim nMinLineSStep As Integer = GetPrivateProfileInt("Grid", "MinLineSStep", 1, m_sIniFile)
Dim nMajLineSStep As Integer = GetPrivateProfileInt("Grid", "MajLineSStep", 10, m_sIniFile)
Dim nExtSStep As Integer = GetPrivateProfileInt("Grid", "ExtSStep", 50, m_sIniFile)
Dim MinLnColor As New Color3d(160, 160, 160)
GetPrivateProfileColor("Grid", "MinLnColor", MinLnColor, m_sIniFile)
Dim MajLnColor As New Color3d(160, 160, 160)
GetPrivateProfileColor("Grid", "MajLnColor", MajLnColor, m_sIniFile)
EgtSetGridShow(m_bShowGrid, m_bShowGridFrame)
EgtSetGridFrame(Frame3d.GLOB)
EgtSetGridGeo(dSnapStep, nMinLineSStep, nMajLineSStep, nExtSStep)
EgtSetGridColor(MinLnColor, MajLnColor)
' imposto tipo coordinate
m_bCPlaneTypePos = True
Scene1.SetGridCursorPos(m_bCPlaneTypePos)
' modo di visualizzazione
Dim nShowMode As Integer = GetPrivateProfileInt("Scene", "ShowMode", SM.SHADING, m_sIniFile)
If nShowMode = SM.WIREFRAME Then
rbtWireFrame.Checked = True
ElseIf nShowMode = SM.HIDDENLINE Then
rbtHiddenLine.Checked = True
Else
rbtShading.Checked = True
End If
' visualizzazione direzione curve
Dim nShowCurveDir As Integer = GetPrivateProfileInt("Scene", "CurveDir", 0, m_sIniFile)
chkCurveDir.Checked = (nShowCurveDir <> 0)
' ObjTree non selezionato
m_nObjTreeOldId = GDB_ID.NULL
' nascondo input box
ResetInputBox()
' aggiungo voce per about box nel menù di sistema
Dim hSysMenu As IntPtr = GetSystemMenu(Handle, False)
If hSysMenu <> IntPtr.Zero Then
AppendMenu(hSysMenu, MF_SEPARATOR, 0, "")
AppendMenu(hSysMenu, MF_STRING, IDM_ABOUTBOX, "About TestEIn...")
End If
' Nascondo TabTest
TabControl2.TabPages.Remove(TabTest)
' Posizione e dimensioni del Form
If ModifierKeys <> Keys.Shift Then
Dim nFlag As Integer
Dim nLeft As Integer
Dim nTop As Integer
Dim nWidth As Integer
Dim nHeight As Integer
GetPrivateProfileWinPos("General", "WinPlace", nFlag, nLeft, nTop, nWidth, nHeight, m_sIniFile)
Me.StartPosition = System.Windows.Forms.FormStartPosition.Manual
Me.Location = New Point(nLeft, nTop)
Me.Size = New Size(nWidth, nHeight)
WindowState = IIf(nFlag = 1, FormWindowState.Maximized, FormWindowState.Normal)
End If
' Impostazioni controller
m_Controller.SetScene(Scene1)
Dim bLuaReg As Boolean = (GetPrivateProfileInt("General", "CommandLog", 0, m_sIniFile) <> 0)
If Not m_Controller.SetCommandLog(bLuaReg, m_sDataRoot, m_nInstance) Then
EgtOutLog("Command log not started")
If My.Application.CommandLineArgs.Count() = 0 Then
MessageBox.Show("Command log not started", "TestEIn Warning",
MessageBoxButtons.OK, MessageBoxIcon.Warning)
End If
End If
If m_Controller.GetCommandLog() Then
tsStatusReg.BackColor = Color.Lime
ElseIf bLuaReg Then
tsStatusReg.BackColor = Color.Red
End If
' Apro progetto vuoto
Scene1.NewProject(True)
End Sub
Private Sub Form1_Shown(sender As System.Object, e As EventArgs) Handles MyBase.Shown
FormTimer.Start()
End Sub
Private Sub FormTickEvent(source As Object, e As EventArgs) Handles FormTimer.Tick
FormTimer.Stop()
' Recupero eventuali parametri da linea di comando
Dim bOpen As Boolean = False
For Each s As String In My.Application.CommandLineArgs
If Not String.IsNullOrWhiteSpace(s) Then
Dim nFileType As Integer = EgtGetFileType(s)
Select Case nFileType
Case FT.NGE, FT.NFE
Scene1.OpenProject(s, False)
bOpen = True
Case FT.DXF, FT.STL, FT.CNC
Scene1.ImportProject(s, False)
bOpen = True
Case FT.TSC, FT.LUA
Scene1.Exec(s, False)
bOpen = True
End Select
Exit For
End If
Next
End Sub
Private Sub Form1_FormClosing(sender As System.Object, e As FormClosingEventArgs) Handles MyBase.FormClosing
' gestisco eventuale file corrente modificato
If Not m_Controller.ManageModified() Then
e.Cancel = True
Return
End If
' Salvo modo di visualizzazione
WritePrivateProfileString("Scene", "ShowMode", EgtGetShowMode(), m_sIniFile)
' Salvo stato visualizzazione direzione curve
WritePrivateProfileString("Scene", "CurveDir", IIf(EgtGetShowCurveDirection(), 1, 0), m_sIniFile)
' Salvo posizione Form
Dim nFlag As Integer = IIf(Me.WindowState = FormWindowState.Maximized, 1, 0)
WritePrivateProfileWinPos("General", "WinPlace", nFlag, Me.Left, Me.Top, Me.Width, Me.Height, m_sIniFile)
' Terminazione generale di EgtInterface
EgtExit()
' Rilascio mutex
m_objMutex.Close()
' Disabilito gestore Idle
RemoveHandler Application.Idle, AddressOf Application_Idle
End Sub
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
MyBase.WndProc(m)
If m.Msg = WM_SYSCOMMAND Then
If m.WParam.ToInt32 = IDM_ABOUTBOX Then
AboutBox1.ShowDialog()
End If
End If
End Sub
'-------------------------------- Events management ----------------------------------------------
Private Sub OnCursorPos(ByVal sender As Object, ByVal sCursorPos As String) Handles Scene1.OnCursorPos
tsStatusCursorPos.Text = sCursorPos
End Sub
Private Sub OnMouseSelectedObj(ByVal sender As Object, ByVal nId As Integer, ByVal bLast As Boolean) Handles Scene1.OnMouseSelectedObj
m_Controller.MouseSelectedObj(nId, bLast)
End Sub
Private Sub OnMouseSelectedPart(ByVal sender As Object, ByVal nId As Integer) Handles Scene1.OnMouseSelectedPart
m_Controller.MouseSelectedPart(nId)
End Sub
Private Sub OnMouseSelectedLayer(ByVal sender As Object, ByVal nId As Integer) Handles Scene1.OnMouseSelectedLayer
m_Controller.MouseSelectedLayer(nId)
End Sub
Private Sub OnMousePointFromSelection(ByVal sender As Object, ByVal PtP As Point3d) Handles Scene1.OnMousePointFromSelection
m_Controller.SetLastPoint3d(PtP)
End Sub
Private Sub OnMouseDone(ByVal sender As Object) Handles Scene1.OnMouseDone
m_Controller.Done(InputText.Text)
End Sub
Private Sub OnMouseSelectedPoint(ByVal sender As Object, ByVal PtP As Point3d, ByVal nSep As SEP, ByVal nId As Integer) Handles Scene1.OnMouseSelectedPoint
Dim bDone As Boolean = (ModifierKeys And Keys.Control) <> Keys.Control
m_Controller.MouseSelectedPoint(PtP, nSep, nId, bDone)
End Sub
Private Sub OnMouseSelectedDir(ByVal sender As Object, ByVal VtDir As Vector3d) Handles Scene1.OnMouseSelectedDir
m_Controller.SetLastVector3d(VtDir)
End Sub
Private Sub OnMouseMoveSelPoint(ByVal sender As Object, ByVal PtP As Point3d) Handles Scene1.OnMouseMoveSelPoint
m_Controller.MouseMoveInSelectionPoint(PtP)
End Sub
Private Sub OnMouseAnalyzed(ByVal sender As Object, ByVal nId As Integer) Handles Scene1.OnMouseAnalyzed
UpdateObjInObjTree(nId)
SelectIdInObjTree(nId)
End Sub
Private Sub OnShowDistance(ByVal sender As Object, ByVal sDistance As String) Handles Scene1.OnShowDistance
tsStatusOutput.Text = sDistance
End Sub
Private Sub OnNewProject(ByVal sender As Object, ByVal bOk As Boolean) Handles Scene1.OnNewProject
m_Controller.ResetCurrFile()
m_Controller.ExecuteCommand(CMD.RESETCURRPARTLAYER)
m_Controller.ResetModified()
If Not bOk Then
MessageBox.Show("Error on new file", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End If
End Sub
Private Sub OnOpeningProject(ByVal sender As Object) Handles Scene1.OnOpeningProject
ClearObjTree()
End Sub
Private Sub OnOpenProject(ByVal sender As Object, ByVal sFile As String, ByVal bOk As Boolean) Handles Scene1.OnOpenProject
m_Controller.SetCurrFile(sFile)
m_Controller.ExecuteCommand(CMD.RESETCURRPARTLAYER)
m_Controller.ResetModified()
WritePrivateProfileString("General", "LastNgeDir", Path.GetDirectoryName(sFile), m_sIniFile)
If Not bOk Then
MessageBox.Show("Error opening file", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End If
End Sub
Private Sub OnSavingProject(ByVal sender As Object, ByVal sFile As String) Handles Scene1.OnSavingProject
m_Controller.SetCurrFile(sFile)
EmitTitle()
WritePrivateProfileString("General", "LastNgeDir", Path.GetDirectoryName(sFile), m_sIniFile)
End Sub
Private Sub OnSavedProject(ByVal sender As Object, ByVal bOk As Boolean) Handles Scene1.OnSavedProject
If bOk Then
m_Controller.ResetModified()
Else
MessageBox.Show("Error saving file", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End If
End Sub
Private Sub OnImportingProject(ByVal sender As Object, ByVal bOkType As Boolean) Handles Scene1.OnImportingProject
If bOkType Then
ClearObjTree()
Else
MessageBox.Show("File type unknown", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End If
End Sub
Private Sub OnImportedProject(ByVal sender As Object, ByVal sFile As String, ByVal bOk As Boolean) Handles Scene1.OnImportedProject
m_Controller.SetCurrFile(sFile)
m_Controller.ExecuteCommand(CMD.RESETCURRPARTLAYER)
m_Controller.SetModified()
WritePrivateProfileString("General", "LastImpDir", Path.GetDirectoryName(sFile), m_sIniFile)
If Not bOk Then
MessageBox.Show("Error importing file", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End If
End Sub
Private Sub OnExportingProject(ByVal sender As Object, ByVal sFile As String) Handles Scene1.OnExportingProject
WritePrivateProfileString("General", "LastExpDir", Path.GetDirectoryName(sFile), m_sIniFile)
End Sub
Private Sub OnExportedProject(ByVal sender As Object, ByVal bOk As Boolean) Handles Scene1.OnExportedProject
If Not bOk Then
MessageBox.Show("Error exporting file", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End If
End Sub
Private Sub OnExecutingScript(ByVal sender As Object, ByVal sFile As String) Handles Scene1.OnExecutingScript
WritePrivateProfileString("General", "LastLuaDir", Path.GetDirectoryName(sFile), m_sIniFile)
ClearObjTree()
End Sub
Private Sub OnExecutedScript(ByVal sender As Object, ByVal bOk As Boolean, ByVal sError As String) Handles Scene1.OnExecutedScript
m_Controller.SetModified()
If Not bOk Then
MessageBox.Show(sError, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End If
End Sub
Private Sub OnPrepareInputBox(ByVal sTitle As String, ByVal sLabel As String, ByRef sCheckLabel As String,
ByVal bShowCombo As Boolean, ByVal bShowBtn As Boolean) Handles m_Controller.PrepareInputBox
PrepareInputBox(sTitle, sLabel, sCheckLabel, bShowCombo, bShowBtn)
End Sub
Private Sub OnSetInputBoxText(ByVal sText As String) Handles m_Controller.SetInputBoxText
SetInputBoxText(sText)
End Sub
Private Sub OnSetInputBoxCheck(ByVal bCheck As Boolean) Handles m_Controller.SetInputBoxCheck
SetInputBoxCheck(bCheck)
End Sub
Private Sub OnAddInputBoxCombo(ByVal sText As String, ByVal bSelected As Boolean) Handles m_Controller.AddInputBoxCombo
AddInputBoxCombo(sText, bSelected)
End Sub
Private Sub OnUpdateUI(ByVal sender As Object, ByVal bReloadUI As Boolean) Handles m_Controller.UpdateUI
' pulisco input e relativi messaggi
ResetInputBox()
tsStatusOutput.Text = ""
' aggiorno dati correnti
EmitTitle()
EmitCurrPartLayer()
If bReloadUI Then
LoadObjTree()
Else
UpdateObjTree()
End If
End Sub
' --------------------- Update UI -------------------------------
Private Sub Application_Idle(ByVal sender As Object, ByVal e As EventArgs)
' Gestione abilitazione bottoni
Dim bLayerOk As Boolean = (m_Controller.GetCurrLayer() <> GDB_ID.NULL)
Dim bSelOk As Boolean = (EgtGetFirstSelectedObj() <> GDB_ID.NULL)
' Grid
btnCplaneElevation.Enabled = m_bShowGrid
btnCplaneOrigin.Enabled = m_bShowGrid
btnCplaneRotate.Enabled = m_bShowGrid
btnCplane3P.Enabled = m_bShowGrid
btnCPlanePerpCurve.Enabled = m_bShowGrid
btnCPlaneObj.Enabled = m_bShowGrid And bSelOk
' Draw
btnPoint.Enabled = bLayerOk
btnLine2P.Enabled = bLayerOk
btnLinePDL.Enabled = bLayerOk
btnCircleCP.Enabled = bLayerOk
btnCircleCD.Enabled = bLayerOk
btnArcCSE.Enabled = bLayerOk
btnArc3P.Enabled = bLayerOk
btnArcPDP.Enabled = bLayerOk
btnRectangle2P.Enabled = bLayerOk
btnPolygonSide.Enabled = bLayerOk
btnText.Enabled = bLayerOk
' Construct
btnPlane.Enabled = bLayerOk And bSelOk
btnExtrude.Enabled = bLayerOk And bSelOk
btnRevolve.Enabled = bLayerOk And bSelOk
btnRuled.Enabled = bLayerOk And bSelOk
' Edit
btnDelete.Enabled = bSelOk
btnChangeLayer.Enabled = bSelOk
btnChangeColor.Enabled = bSelOk
btnInvertCurve.Enabled = bSelOk
btnExtendCurve.Enabled = bSelOk
btnBreakCurve.Enabled = bSelOk
btnJoinCurve.Enabled = bLayerOk And bSelOk
btnExplodeCurve.Enabled = bSelOk
btnSetCurveTh.Enabled = bSelOk
btnInvertSurf.Enabled = bSelOk
' Transform
btnMove.Enabled = bSelOk
btnRotate.Enabled = bSelOk
btnMirror.Enabled = bSelOk
btnScale.Enabled = bSelOk
btnOffset.Enabled = bSelOk
End Sub
'-------------------------------- Buttons --------------------------------------------------------
Private Sub btnNew_Click(sender As System.Object, e As System.EventArgs) Handles btnNew.Click
' gestisco eventuale file corrente modificato
If Not m_Controller.ManageModified() Then
Return
End If
' eseguo
Scene1.NewProject(True)
End Sub
Private Sub btnOpen_Click(sender As System.Object, e As System.EventArgs) Handles btnOpen.Click
' gestisco eventuale file corrente modificato
If Not m_Controller.ManageModified() Then
Return
End If
' eseguo
Dim sDir As String = String.Empty
GetPrivateProfileString("General", "LastNgeDir", "", sDir, m_sIniFile)
Scene1.OpenProject(sDir)
End Sub
Private Sub btnSave_Click(sender As System.Object, e As System.EventArgs) Handles btnSave.Click
Dim nType As NGE = GetPrivateProfileInt("GeomDB", "SaveType", NGE.CMPTEXT, m_sIniFile)
If Not String.IsNullOrWhiteSpace(m_Controller.GetCurrFile()) Then
Scene1.SaveProject(m_Controller.GetCurrFile(), nType)
Else
Dim sFile As String = String.Empty
GetPrivateProfileString("General", "LastNgeDir", "", sFile, m_sIniFile)
sFile.TrimEnd("\"c)
sFile += "\New.nge"
Scene1.SaveAsProject(sFile, nType)
End If
End Sub
Private Sub btnSaveAs_Click(sender As System.Object, e As System.EventArgs) Handles btnSaveAs.Click
Dim nType As NGE = GetPrivateProfileInt("GeomDB", "SaveType", NGE.CMPTEXT, m_sIniFile)
Scene1.SaveAsProject(m_Controller.GetCurrFile(), nType)
End Sub
Private Sub btnImport_Click(sender As System.Object, e As System.EventArgs) Handles btnImport.Click
' gestisco eventuale file corrente modificato
If Not m_Controller.ManageModified() Then
Return
End If
' eseguo
Dim sDir As String = String.Empty
GetPrivateProfileString("General", "LastImpDir", "", sDir, m_sIniFile)
Scene1.ImportProject(sDir)
End Sub
Private Sub btnExport_Click(sender As System.Object, e As System.EventArgs) Handles btnExport.Click
Scene1.ExportProject(Path.ChangeExtension(m_Controller.GetCurrFile(), "dxf"))
End Sub
Private Sub btnInsert_Click(sender As System.Object, e As System.EventArgs) Handles btnInsert.Click
' eseguo
Dim sDir As String = String.Empty
GetPrivateProfileString("General", "LastNgeDir", "", sDir, m_sIniFile)
Scene1.InsertProject(sDir)
m_Controller.SetModified()
End Sub
Private Sub btnExec_Click(sender As System.Object, e As System.EventArgs) Handles btnExec.Click
Dim sDir As String = String.Empty
GetPrivateProfileString("General", "LastLuaDir", "", sDir, m_sIniFile)
Scene1.Exec(sDir)
End Sub
Private Sub rbtWireFrame_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles rbtWireFrame.CheckedChanged
Scene1.WireFrame()
End Sub
Private Sub rbtHiddenLine_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles rbtHiddenLine.CheckedChanged
Scene1.HiddenLine()
End Sub
Private Sub rbtShading_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles rbtShading.CheckedChanged
Scene1.Shading()
End Sub
Private Sub chkCurveDir_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles chkCurveDir.CheckedChanged
EgtSetShowCurveDirection(chkCurveDir.Checked)
End Sub
Private Sub chkAnalyze_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles chkAnalyze.CheckedChanged
If chkAnalyze.Checked Then
chkGetDist.Checked = False
Scene1.SetStatusAnalyze()
Else
Scene1.ResetStatusAnalyze()
SelectIdInObjTree(GDB_ID.NULL)
End If
End Sub
Private Sub chkGetDist_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles chkGetDist.CheckedChanged
If chkGetDist.Checked Then
chkAnalyze.Checked = False
Scene1.SetStatusGetDistance()
tsStatusOutput.Text = " "
Else
Scene1.ResetStatusGetDistance()
tsStatusOutput.Text = " "
End If
End Sub
Private Sub btnZoomAll_Click(sender As System.Object, e As System.EventArgs) Handles btnZoomAll.Click
Scene1.ZoomAll()
End Sub
Private Sub btnZoomIn_Click(sender As System.Object, e As System.EventArgs) Handles btnZoomIn.Click
Scene1.ZoomIn()
End Sub
Private Sub btnZoomOut_Click(sender As System.Object, e As System.EventArgs) Handles btnZoomOut.Click
Scene1.ZoomOut()
End Sub
Private Sub btnTop_Click(sender As System.Object, e As System.EventArgs) Handles btnTop.Click
Scene1.TopView()
End Sub
Private Sub btnFront_Click(sender As System.Object, e As System.EventArgs) Handles btnFront.Click
Scene1.FrontView()
End Sub
Private Sub btnLeft_Click(sender As System.Object, e As System.EventArgs) Handles btnLeft.Click
Scene1.LeftView()
End Sub
Private Sub btnBack_Click(sender As System.Object, e As System.EventArgs) Handles btnBack.Click
Scene1.BackView()
End Sub
Private Sub btnRight_Click(sender As System.Object, e As System.EventArgs) Handles btnRight.Click
Scene1.RightView()
End Sub
Private Sub btnCPlane_Click(sender As System.Object, e As System.EventArgs) Handles btnCPlane.Click
Scene1.CPlaneView()
End Sub
Private Sub btnIsoSW_Click(sender As System.Object, e As System.EventArgs) Handles btnIsoSW.Click
Scene1.IsoViewSW()
End Sub
Private Sub btnIsoSE_Click(sender As System.Object, e As System.EventArgs) Handles btnIsoSE.Click
Scene1.IsoViewSE()
End Sub
Private Sub btnIsoNE_Click(sender As System.Object, e As System.EventArgs) Handles btnIsoNE.Click
Scene1.IsoViewNE()
End Sub
Private Sub btnIsoNW_Click(sender As System.Object, e As System.EventArgs) Handles btnIsoNW.Click
Scene1.IsoViewNW()
End Sub
Private Sub btnCplaneTop_Click(sender As System.Object, e As System.EventArgs) Handles btnCplaneTop.Click
m_Controller.SetLastInteger(GRID_TYPE.TOP)
m_Controller.ExecuteCommand(CMD.GRID)
End Sub
Private Sub btnCplaneFront_Click(sender As System.Object, e As System.EventArgs) Handles btnCplaneFront.Click
m_Controller.SetLastInteger(GRID_TYPE.FRONT)
m_Controller.ExecuteCommand(CMD.GRID)
End Sub
Private Sub btnCplaneRight_Click(sender As System.Object, e As System.EventArgs) Handles btnCplaneRight.Click
m_Controller.SetLastInteger(GRID_TYPE.RIGHT)
m_Controller.ExecuteCommand(CMD.GRID)
End Sub
Private Sub btnCplaneBack_Click(sender As System.Object, e As System.EventArgs) Handles btnCplaneBack.Click
m_Controller.SetLastInteger(GRID_TYPE.BACK)
m_Controller.ExecuteCommand(CMD.GRID)
End Sub
Private Sub btnCplaneLeft_Click(sender As System.Object, e As System.EventArgs) Handles btnCplaneLeft.Click
m_Controller.SetLastInteger(GRID_TYPE.LEFT)
m_Controller.ExecuteCommand(CMD.GRID)
End Sub
Private Sub btnCplaneBottom_Click(sender As System.Object, e As System.EventArgs) Handles btnCplaneBottom.Click
m_Controller.SetLastInteger(GRID_TYPE.BOTTOM)
m_Controller.ExecuteCommand(CMD.GRID)
End Sub
Private Sub btnCplaneElevation_Click(sender As System.Object, e As System.EventArgs) Handles btnCplaneElevation.Click
m_Controller.ExecuteCommand(CMD.GRID_ELEVATION)
End Sub
Private Sub btnCplaneOrigin_Click(sender As System.Object, e As System.EventArgs) Handles btnCplaneOrigin.Click
m_Controller.ExecuteCommand(CMD.GRID_ORIGIN)
End Sub
Private Sub btnCplaneRotate_Click(sender As System.Object, e As System.EventArgs) Handles btnCplaneRotate.Click
If (ModifierKeys And Keys.Shift) <> Keys.Shift Then
m_Controller.ExecuteCommand(CMD.GRID_ROTATE)
Else
m_Controller.ExecuteCommand(CMD.GRID_ROTATE3D)
End If
End Sub
Private Sub btnCplane3Points_Click(sender As System.Object, e As System.EventArgs) Handles btnCplane3P.Click
m_Controller.ExecuteCommand(CMD.GRID_3P)
End Sub
Private Sub btnCplanePerpCurve_Click(sender As System.Object, e As System.EventArgs) Handles btnCPlanePerpCurve.Click
m_Controller.ExecuteCommand(CMD.GRID_PERPCURVE)
End Sub
Private Sub btnCplaneObject_Click(sender As System.Object, e As System.EventArgs) Handles btnCPlaneObj.Click
m_Controller.ExecuteCommand(CMD.GRID_OBJ)
End Sub
' --------------------- Commands --------------------------------
Private Sub btnPoint_Click(sender As System.Object, e As System.EventArgs) Handles btnPoint.Click
m_Controller.ExecuteCommand(CMD.POINT)
End Sub
Private Sub btnLine2P_Click(sender As System.Object, e As System.EventArgs) Handles btnLine2P.Click
m_Controller.ExecuteCommand(CMD.LINE2P)
End Sub
Private Sub btnLinePDL_Click(sender As System.Object, e As System.EventArgs) Handles btnLinePDL.Click
m_Controller.ExecuteCommand(CMD.LINEPDL)
End Sub
Private Sub btnCircleCP_Click(sender As System.Object, e As System.EventArgs) Handles btnCircleCP.Click
m_Controller.ExecuteCommand(CMD.CIRCLECP)
End Sub
Private Sub btnCircleCD_Click(sender As System.Object, e As System.EventArgs) Handles btnCircleCD.Click
m_Controller.ExecuteCommand(CMD.CIRCLECD)
End Sub
Private Sub btnArcCSE_Click(sender As System.Object, e As System.EventArgs) Handles btnArcCSE.Click
m_Controller.ExecuteCommand(CMD.ARCCSE)
End Sub
Private Sub btnArc3P_Click(sender As System.Object, e As System.EventArgs) Handles btnArc3P.Click
m_Controller.ExecuteCommand(CMD.ARC3P)
End Sub
Private Sub btnArcPDP_Click(sender As System.Object, e As System.EventArgs) Handles btnArcPDP.Click
m_Controller.ExecuteCommand(CMD.ARCPDP)
End Sub
Private Sub btnRectangle2P_Click(sender As System.Object, e As System.EventArgs) Handles btnRectangle2P.Click
m_Controller.ExecuteCommand(CMD.RECTANGLE2P)
End Sub
Private Sub btnPolygonSide_Click(sender As System.Object, e As System.EventArgs) Handles btnPolygonSide.Click
m_Controller.ExecuteCommand(CMD.POLYGONSIDE)
End Sub
Private Sub btnText_Click(sender As System.Object, e As System.EventArgs) Handles btnText.Click
If (ModifierKeys And Keys.Shift) <> Keys.Shift Then
m_Controller.ExecuteCommand(CMD.TEXT)
Else
m_Controller.ExecuteCommand(CMD.TEXTPLUS)
End If
End Sub
Private Sub btnPlane_Click(sender As System.Object, e As System.EventArgs) Handles btnPlane.Click
m_Controller.ExecuteCommand(CMD.PLANE)
End Sub
Private Sub btnExtrude_Click(sender As System.Object, e As System.EventArgs) Handles btnExtrude.Click
m_Controller.ExecuteCommand(CMD.EXTRUDE)
End Sub
Private Sub btnRevolve_Click(sender As System.Object, e As System.EventArgs) Handles btnRevolve.Click
If (ModifierKeys And Keys.Shift) <> Keys.Shift Then
m_Controller.ExecuteCommand(CMD.REVOLVE)
Else
m_Controller.ExecuteCommand(CMD.REVOLVEPLUS)
End If
End Sub
Private Sub btnRuled_Click(sender As System.Object, e As System.EventArgs) Handles btnRuled.Click
m_Controller.ExecuteCommand(CMD.RULED)
End Sub
Private Sub btnDelete_Click(sender As System.Object, e As System.EventArgs) Handles btnDelete.Click
m_Controller.SetLastInteger(GDB_ID.SEL)
m_Controller.ExecuteCommand(CMD.DELETE)
End Sub
Private Sub btnChangeLayer_Click(sender As System.Object, e As System.EventArgs) Handles btnChangeLayer.Click
m_Controller.ExecuteCommand(CMD.CHANGELAYER)
End Sub
Private Sub btnChangeColor_Click(sender As System.Object, e As System.EventArgs) Handles btnChangeColor.Click
If (ModifierKeys And Keys.Shift) <> Keys.Shift Then
m_Controller.ExecuteCommand(CMD.CHANGECOLOR)
Else
m_Controller.ExecuteCommand(CMD.RESETCOLOR)
End If
End Sub
Private Sub btnInvertCurve_Click(sender As System.Object, e As System.EventArgs) Handles btnInvertCurve.Click
m_Controller.ExecuteCommand(CMD.INVERTCURVE)
End Sub
Private Sub btnExtendCurve_Click(sender As System.Object, e As System.EventArgs) Handles btnExtendCurve.Click
m_Controller.ExecuteCommand(CMD.TRIMEXTENDCURVE)
End Sub
Private Sub btnBreakCurve_Click(sender As System.Object, e As System.EventArgs) Handles btnBreakCurve.Click
m_Controller.ExecuteCommand(CMD.BREAKCURVE)
End Sub
Private Sub btnJoinCurve_Click(sender As System.Object, e As System.EventArgs) Handles btnJoinCurve.Click
m_Controller.ExecuteCommand(CMD.JOINCURVE)
End Sub
Private Sub btnExplodeCurve_Click(sender As System.Object, e As System.EventArgs) Handles btnExplodeCurve.Click
m_Controller.ExecuteCommand(CMD.EXPLODECURVE)
End Sub
Private Sub btnSetCurveTh_Click(sender As System.Object, e As System.EventArgs) Handles btnSetCurveTh.Click
m_Controller.ExecuteCommand(CMD.SETCURVETHICKNESS)
End Sub
Private Sub btnInvertSurf_Click(sender As System.Object, e As System.EventArgs) Handles btnInvertSurf.Click
m_Controller.ExecuteCommand(CMD.INVERTSURF)
End Sub
Private Sub btnMove_Click(sender As System.Object, e As System.EventArgs) Handles btnMove.Click
m_Controller.ExecuteCommand(CMD.MOVE)
End Sub
Private Sub btnRotate_Click(sender As System.Object, e As System.EventArgs) Handles btnRotate.Click
If (ModifierKeys And Keys.Shift) <> Keys.Shift Then
m_Controller.ExecuteCommand(CMD.ROTATE)
Else
m_Controller.ExecuteCommand(CMD.ROTATE3D)
End If
End Sub
Private Sub btnMirror_Click(sender As System.Object, e As System.EventArgs) Handles btnMirror.Click
If (ModifierKeys And Keys.Shift) <> Keys.Shift Then
m_Controller.ExecuteCommand(CMD.MIRROR)
Else
m_Controller.ExecuteCommand(CMD.MIRROR3D)
End If
End Sub
Private Sub btnScale_Click(sender As System.Object, e As System.EventArgs) Handles btnScale.Click
If (ModifierKeys And Keys.Shift) <> Keys.Shift Then
m_Controller.ExecuteCommand(CMD.SCALE)
Else
m_Controller.ExecuteCommand(CMD.SCALE3D)
End If
End Sub
Private Sub btnOffset_Click(sender As System.Object, e As System.EventArgs) Handles btnOffset.Click
m_Controller.ExecuteCommand(CMD.OFFSET)
End Sub
'-------------------------------- KeyDown --------------------------------------------------------
Private Sub Form1_KeyDown(ByVal sender As System.Object, ByVal e As KeyEventArgs) Handles MyBase.KeyDown
' Con ESC esco dall'azione corrente
If e.KeyData = Keys.Escape Then
' reset Azione corrente
m_Controller.ResetStatus()
' reset Analisi e Distanza
chkAnalyze.Checked = False
chkGetDist.Checked = False
' pulisco output
tsStatusOutput.Text = ""
ResetInputBox()
End If
End Sub
Private Sub Scene1_KeyDown(ByVal sender As System.Object, ByVal e As KeyEventArgs) Handles Scene1.KeyDown
' Con DEL eseguo cancellazione delle entità selezionate
If e.KeyData = Keys.Delete Then
m_Controller.SetLastInteger(GDB_ID.SEL)
m_Controller.ExecuteCommand(CMD.DELETE)
' con SPAZIO ripeto l'ultimo comando
ElseIf e.KeyData = Keys.Space Then
m_Controller.RepeatLastCommand()
End If
End Sub
' --------------------- Input Box -------------------------------
Private Sub PrepareInputBox(ByRef sTitle As String, ByRef sLabel As String, ByRef sCheckLabel As String,
ByVal bShowCombo As Boolean, ByVal bShowBtn As Boolean)
InputBox.Text = sTitle
InputBox.Show()
InputLabel.Text = sLabel
InputLabel.Show()
InputText.Text = ""
InputText.Show()
If sCheckLabel <> "" Then
InputCheck.Text = sCheckLabel
InputCheck.Show()
End If
If bShowCombo Then
InputCombo.Items.Clear()
InputCombo.Show()
End If
If bShowBtn Then
btnShow.Show()
End If
InputText.Focus()
End Sub
Private Sub ResetInputBox()
InputBox.Hide()
InputCheck.Hide()
InputCombo.Hide()
btnShow.Hide()
End Sub
Private Function SetInputBoxText(ByVal sVal As String) As Boolean
InputText.Text = sVal
Return True
End Function
Private Function SetInputBoxCheck(ByVal bCheck As Boolean) As Boolean
InputCheck.Checked = bCheck
m_Controller.SetLastBoolean(InputCheck.Checked)
Return True
End Function
Private Function AddInputBoxCombo(ByVal sText As String, ByVal bSelected As Boolean) As Boolean
Dim nId As Integer = InputCombo.Items.Add(sText)
If bSelected Then
InputCombo.SelectedIndex = nId
End If
Return True
End Function
Private Sub InputText_KeyDown(ByVal sender As System.Object, ByVal e As KeyEventArgs) Handles InputText.KeyDown
' Con RETURN avanzo di un passo
If e.KeyData = Keys.Return Then
m_Controller.Done(InputText.Text)
End If
End Sub
Private Sub InputCheck_CheckedChanged(ByVal sender As Object, ByVal e As EventArgs) Handles InputCheck.CheckedChanged
m_Controller.SetLastBoolean(InputCheck.Checked)
End Sub
Private Sub InputCombo_SelectionChanged(ByVal sender As Object, ByVal e As EventArgs) Handles InputCombo.SelectedIndexChanged
m_Controller.SetLastInteger(InputCombo.SelectedIndex)
End Sub
Private Sub btnShow_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnShow.Click
m_Controller.Show(InputText.Text)
End Sub
Private Sub btnDone_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnDone.Click
m_Controller.Done(InputText.Text)
End Sub
'-------------------------------- Command Box ----------------------------------------------------
Private Sub tboxCmd_KeyDown(sender As System.Object, e As System.Windows.Forms.KeyEventArgs) Handles tboxCmd.KeyDown
If (e.KeyCode = Keys.Enter) Then
Dim nLine As Integer = tboxCmd.GetLineFromCharIndex(tboxCmd.GetFirstCharIndexOfCurrentLine)
Dim sCmd As String = tboxCmd.Lines(nLine).ToString
If Not String.IsNullOrEmpty(sCmd) Then
' ripristino stato oggetto marcato
Dim nIdOld As Integer = RevertOldIdInObjTree()
' eseguo comando
m_Controller.SetLastString(sCmd)
If m_Controller.ExecuteCommand(CMD.EXECLINE) Then
tsStatusOnR.Text = " "
Else
tsStatusOnR.Text = "Error executing command"
End If
SelectIdInObjTree(nIdOld)
End If
End If
End Sub
'-------------------------------- Current Piece/Layer --------------------------------------------
Private Sub btnNewPart_Click(sender As Object, e As EventArgs) Handles btnNewPart.Click
m_Controller.ExecuteCommand(CMD.NEWPART)
End Sub
Private Sub btnNewLayer_Click(sender As Object, e As EventArgs) Handles btnNewLayer.Click
m_Controller.ExecuteCommand(CMD.NEWLAYER)
End Sub
Private Sub btnColor_Click(sender As Object, e As EventArgs) Handles btnColor.Click
m_Controller.ExecuteCommand(CMD.LAYERCOLOR)
End Sub
Private Sub EmitCurrPartLayer()
Dim sText As String = " "
Dim sName As String = String.Empty
Dim colObj As Color3d
EgtGetColor(GDB_ID.ROOT, colObj)
Dim nCurrPart As Integer = m_Controller.GetCurrPart()
If nCurrPart <> GDB_ID.NULL Then
If EgtGetName(nCurrPart, sName) Then
sText = sName
Else
sText = "Part " + nCurrPart.ToString()
End If
EgtGetCalcColor(nCurrPart, colObj)
Dim nCurrLayer As Integer = m_Controller.GetCurrLayer()
If nCurrLayer <> GDB_ID.NULL And EgtExistsObj(nCurrLayer) Then
If EgtGetName(nCurrLayer, sName) Then
sText += " --> " + sName
Else
sText += " --> Layer " + nCurrLayer.ToString()
End If
EgtGetCalcColor(nCurrLayer, colObj)
End If
End If
txtPartLay.Text = sText
colObj.A = 100
txtColor.BackColor = colObj.ToColor()
End Sub
'-------------------------------- Tree View ------------------------------------------------------
Private m_nObjTreeOldId As Integer = GDB_ID.NULL
Private m_nObjTreeMenuId As Integer = GDB_ID.NULL
Private Sub ObjTreeTickEvent(source As Object, e As EventArgs) Handles ObjTreeTimer.Tick
If m_nObjTreeOldId <> GDB_ID.NULL Then
EgtResetMark(m_nObjTreeOldId)
EgtDraw()
End If
ObjTreeTimer.Stop()
End Sub
Public Sub LoadObjTree()
Dim nOldId As Integer = ClearObjTree()
TreeView1.BeginUpdate()
AddGroupInObjTree(GDB_ID.ROOT, 0, TreeView1.Nodes)
TreeView1.EndUpdate()
If nOldId <> GDB_ID.NULL Then
SelectIdInObjTree(nOldId)
UpdateObjDataInObjTree(m_nObjTreeOldId)
End If
End Sub
Private Function ClearObjTree() As Integer
Dim nOldId As Integer = RevertOldIdInObjTree()
TreeView1.Nodes.Clear()
Return nOldId
End Function
Private Sub AddGroupInObjTree(ByVal nGroupId As Integer, ByVal nLev As Integer, ByRef PrevNodColl As TreeNodeCollection)
Dim CurrNodColl As TreeNodeCollection
If nGroupId = GDB_ID.ROOT Then
CurrNodColl = PrevNodColl
Else
Dim sName As String = String.Empty
Dim sText As String = String.Empty
If EgtGetName(nGroupId, sName) Then
If nLev = 1 Then
sText = sName + " (Part " + nGroupId.ToString + ")"
ElseIf nLev = 2 Then
sText = sName + " (Layer " + nGroupId.ToString + ")"
Else
sText = sName + " (Group " + nGroupId.ToString + ")"
End If
Else
If nLev = 1 Then
sText = "Part " + nGroupId.ToString
ElseIf nLev = 2 Then
sText = "Layer " + nGroupId.ToString
Else
sText = "Group " + nGroupId.ToString
End If
End If
Dim nImage As Integer = TypeToImageInObjTree(GDB_TY.GROUP, nLev)
Dim CurrNod As TreeNode = PrevNodColl.Add(nGroupId.ToString(), sText, nImage, nImage)
CurrNodColl = CurrNod.Nodes
Dim nStat As GDB_ST = GDB_ST.ON_
EgtGetStatus(nGroupId, nStat)
CurrNod.Checked = (nStat <> GDB_ST.OFF)
End If
Dim nObjs As Integer = EgtGetGroupObjs(nGroupId)
If (nObjs > 20000) Then
Dim sText As String = "Too many entities (" + nObjs.ToString() + ")"
CurrNodColl.Add(GDB_ID.NULL.ToString(), sText)
Return
End If
Dim nId As Integer = EgtGetFirstInGroup(nGroupId)
While nId <> GDB_ID.NULL
'recupero il tipo di nodo
Dim nType As Integer = EgtGetType(nId)
'se gruppo
If nType = GDB_TY.GROUP Then
AddGroupInObjTree(nId, nLev + 1, CurrNodColl)
'se oggetto geometrico
ElseIf nType >= GDB_TY.GEO_VECTOR Then
Dim sTitle As String = String.Empty
EgtGetTitle(nId, sTitle)
Dim sName As String = String.Empty
Dim sText As String = String.Empty
If EgtGetName(nId, sName) Then
sText = sName + " (" + sTitle + " " + nId.ToString + ")"
Else
sText = sTitle + " " + nId.ToString
End If
Dim nImage As Integer = TypeToImageInObjTree(nType, nLev)
Dim CurrNod As TreeNode = CurrNodColl.Add(nId.ToString, sText, nImage, nImage)
Dim nStat As GDB_ST = GDB_ST.ON_
EgtGetStatus(nId, nStat)
CurrNod.Checked = (nStat <> GDB_ST.OFF)
End If
'passo al successivo
nId = EgtGetNext(nId)
End While
End Sub
Private Sub UpdateObjTree()
' per aggiornare l'albero senza ricostruirlo da capo
' se c'è una entità corrente, ne aggiorno i dati
If m_nObjTreeOldId <> GDB_ID.NULL Then
UpdateObjDataInObjTree(m_nObjTreeOldId)
End If
End Sub
Private Function TypeToImageInObjTree(ByVal nType As Integer, ByVal nLev As Integer) As Integer
Select Case nType
Case GDB_TY.GROUP
If nLev = 1 Then
Return 3
ElseIf nLev = 2 Then
Return 4
Else
Return 2
End If
Case GDB_TY.GEO_VECTOR
Return 5
Case GDB_TY.GEO_POINT
Return 6
Case GDB_TY.GEO_FRAME
Return 7
Case GDB_TY.CRV_LINE
Return 8
Case GDB_TY.CRV_ARC
Return 9
Case GDB_TY.CRV_BEZ
Return 10
Case GDB_TY.CRV_COMPO
Return 11
Case GDB_TY.SRF_MESH
Return 12
Case GDB_TY.EXT_TEXT
Return 13
End Select
Return 1
End Function
Private Sub ObjTree_AfterCheck(ByVal sender As Object, ByVal e As TreeViewEventArgs) Handles TreeView1.AfterCheck
' verifico che il check derivi da azione utente
If e.Action = TreeViewAction.Unknown Then
Return
End If
' recupero l'Id del nuovo oggetto
Dim nId As Integer
If Not Int32.TryParse(e.Node.Name, nId) Then
Return
End If
' eseguo operazione
m_Controller.SetLastInteger(nId)
If e.Node.Checked Then
m_Controller.ExecuteCommand(CMD.SHOW)
Else
m_Controller.ExecuteCommand(CMD.HIDE)
End If
End Sub
Private Sub ObjTree_AfterSelect(ByVal sender As Object, ByVal e As TreeViewEventArgs) Handles TreeView1.AfterSelect
' verifico che il select derivi da azione utente
If e.Action = TreeViewAction.Unknown Then
Return
End If
' recupero l'Id del nuovo oggetto selezionato
Dim nId As Integer
If Not Int32.TryParse(e.Node.Name, nId) Then
Return
End If
UpdateObjInObjTree(nId)
End Sub
Private Sub ObjTree_MouseUp(ByVal sender As Object, e As MouseEventArgs) Handles TreeView1.MouseUp
' determino Id di eventuale item sotto il mouse
Dim nId As Integer = GDB_ID.NULL
Dim TNode As TreeNode = TreeView1.GetNodeAt(e.Location)
If TNode IsNot Nothing Then
Int32.TryParse(TNode.Name, nId)
End If
' se Id coincide con il corrente
If nId <> GDB_ID.NULL And nId = m_nObjTreeOldId Then
' evidenzio
EgtSetMark(m_nObjTreeOldId)
EgtDraw()
' lancio timer per successiva de-evidenziazione
ObjTreeTimer.Stop()
ObjTreeTimer.Start()
End If
' se rilascio tasto destro
If e.Button = Windows.Forms.MouseButtons.Right Then
' Id pezzo sotto il mouse
m_nObjTreeMenuId = nId
' verifico stato visualizzazione per abilitare voci menù
Dim nStat As GDB_ST = GDB_ST.ON_
Dim bOn As Boolean = EgtGetCalcStatus(m_nObjTreeMenuId, nStat) And nStat <> GDB_ST.OFF
For Each i As ToolStripItem In ContextMenuTreeView1.Items
i.Enabled = bOn
Next
ContextMenuTreeView1.Show(TreeView1, e.Location)
End If
End Sub
Private Sub ObjTree_MouseDoubleClick(ByVal sender As Object, e As MouseEventArgs) Handles TreeView1.MouseDoubleClick
If m_nObjTreeOldId <> GDB_ID.NULL Then
m_Controller.SetLastInteger(m_nObjTreeOldId)
m_Controller.ExecuteCommand(CMD.SETCURRPARTLAYER)
End If
End Sub
Private Sub UpdateObjInObjTree(ByVal nId As Integer)
' ripristino eventuale vecchio oggetto selezionato
RevertOldIdInObjTree()
' stampa dei dati del nuovo oggetto
UpdateObjDataInObjTree(nId)
' evidenzio l'oggetto
EgtSetMark(nId)
m_nObjTreeOldId = nId
' imposto il ridisegno della scena
EgtDraw()
' lancio timer per successiva de-evidenziazione
ObjTreeTimer.Stop()
ObjTreeTimer.Start()
End Sub
Private Sub UpdateObjDataInObjTree(ByVal nId As Integer)
' recupero il tipo del nuovo oggetto
Dim nType As Integer = EgtGetType(nId)
' stampa dei dati dell'oggetto
Dim sDump As String = String.Empty
If nType = GDB_TY.NONE Then
tBoxInfo.Text = String.Empty
ElseIf nType = GDB_TY.GROUP Then
If EgtGroupDump(nId, sDump) Then
tBoxInfo.Text = sDump
Else
tBoxInfo.Text = String.Empty
End If
Else
If EgtGeoObjDump(nId, sDump) Then
tBoxInfo.Text = sDump
Else
tBoxInfo.Text = String.Empty
End If
End If
End Sub
Private Function RevertOldIdInObjTree() As Integer
' salvo il vecchio Id
Dim nOldId As Integer = m_nObjTreeOldId
' se non nullo...
If EgtExistsObj(m_nObjTreeOldId) Then
' smarco l'oggetto
EgtResetMark(m_nObjTreeOldId)
' annullo oggetto da ripristinare
m_nObjTreeOldId = GDB_ID.NULL
End If
Return nOldId
End Function
Private Function SelectIdInObjTree(ByVal nId As Integer) As Boolean
Dim tNode() As TreeNode = TreeView1.Nodes.Find(nId.ToString, True)
If tNode.Length > 0 Then
TreeView1.SelectedNode = tNode(0)
TreeView1.SelectedNode.Expand()
m_nObjTreeOldId = nId
Return True
Else
m_nObjTreeOldId = GDB_ID.NULL
Return False
End If
End Function
Private Sub MenuObjTree_ItemClicked(sender As Object, e As ToolStripItemClickedEventArgs) Handles ContextMenuTreeView1.ItemClicked
If e.ClickedItem.Name = "cmdSelectPartLayObj" Then
m_Controller.SetLastInteger(m_nObjTreeMenuId)
m_Controller.ExecuteCommand(CMD.SELECTPARTLAYEROBJ)
ElseIf e.ClickedItem.Name = "cmdDeselectPartLayObj" Then
m_Controller.SetLastInteger(m_nObjTreeMenuId)
m_Controller.ExecuteCommand(CMD.DESELECTPARTLAYEROBJ)
ElseIf e.ClickedItem.Name = "cmdSetName" Then
m_Controller.SetLastInteger(m_nObjTreeMenuId)
m_Controller.ExecuteCommand(CMD.SETNAME)
ElseIf e.ClickedItem.Name = "cmdSetInfo" Then
m_Controller.SetLastInteger(m_nObjTreeMenuId)
m_Controller.ExecuteCommand(CMD.SETINFO)
ElseIf e.ClickedItem.Name = "cmdRelocatePartLayObj" Then
m_Controller.SetLastInteger(m_nObjTreeMenuId)
m_Controller.ExecuteCommand(CMD.RELOCATEPARTLAYEROBJ)
ElseIf e.ClickedItem.Name = "cmdCopyPartLayObj" Then
m_Controller.SetLastInteger(m_nObjTreeMenuId)
m_Controller.ExecuteCommand(CMD.COPYPARTLAYEROBJ)
ElseIf e.ClickedItem.Name = "cmdDeletePartLayObj" Then
m_Controller.SetLastInteger(m_nObjTreeMenuId)
m_Controller.ExecuteCommand(CMD.DELETE)
End If
End Sub
'-------------------------------- Program Title --------------------------------------------------
Private Sub EmitTitle()
' nome file
Dim sTitle As String = m_Controller.GetCurrFile()
If String.IsNullOrEmpty(sTitle) Then
sTitle = "New"
End If
' indicazione di modificato
If m_Controller.GetModified() Then
sTitle += "*"
End If
' dati del prodotto
sTitle += " - EgalTech TestEIn"
' emissione del titolo
Me.Text = sTitle
End Sub
'-------------------------------- Status Bar -----------------------------------------------------
Private Sub ToolStripStatusSnapPointType_Changed(ByVal sender As Object, ByVal nSpType As SP) Handles Scene1.OnChangedSnapPointType
Select Case nSpType
Case SP.PT_SKETCH
tsStatusSnapPointType.Text = "Sketch Point"
Case SP.PT_GRID
tsStatusSnapPointType.Text = "Grid Point"
Case SP.PT_END
tsStatusSnapPointType.Text = "End Point"
Case SP.PT_MID
tsStatusSnapPointType.Text = "Mid Point"
Case SP.CENTER
tsStatusSnapPointType.Text = "Center"
Case SP.PT_NEAR
tsStatusSnapPointType.Text = "Near Point"
Case SP.PT_INTERS
tsStatusSnapPointType.Text = "Inters Point"
Case SP.PT_TANGENT
tsStatusSnapPointType.Text = "Tang Point"
Case SP.PT_PERPENDICULAR
tsStatusSnapPointType.Text = "Perp Point"
Case SP.PT_MINDIST
tsStatusSnapPointType.Text = "MinDist Point"
Case Else
tsStatusSnapPointType.Text = "---"
End Select
End Sub
Private Sub ToolStripStatusGrid_Click() Handles tsStatusGrid.Click
m_bShowGrid = Not m_bShowGrid
If m_bShowGrid Then
tsStatusGrid.ForeColor = Color.Black
tsStatusGrid.Text = "GRID ON "
Else
tsStatusGrid.ForeColor = Color.LightGray
tsStatusGrid.Text = "GRID OFF"
End If
EgtSetGridShow(m_bShowGrid, m_bShowGrid And m_bShowGridFrame)
EgtDraw()
End Sub
Private Sub ToolStripStatusTypePos_Click() Handles tsStatusCurPosType.Click
m_bCPlaneTypePos = Not m_bCPlaneTypePos
If m_bCPlaneTypePos Then
tsStatusCurPosType.Text = "CPLANE"
Else
tsStatusCurPosType.Text = "WORLD "
End If
Scene1.SetGridCursorPos(m_bCPlaneTypePos)
End Sub
End Class
Reference in New Issue View Git Blame Copy Permalink