Imports System.Runtime.InteropServices Imports System.Text Imports System.Math Imports System.IO Imports TestEIn.EgtInterface Imports TestEIn.GenInterface Public Class Form1 Private m_sIniFile As String = String.Empty Private m_sCurrFile As String = String.Empty Private m_bModified As Boolean = False Private m_nMarkObj As Integer = GDB_ID_NULL '-------------------------------- Form ------------------------------------------------------------ Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load 'Title EmitTitle() 'Impostazione path Ini file m_sIniFile = Application.StartupPath & "\TestEIn.ini" 'Inizializzazione generale di EgtInterface EgtInit(0, Application.StartupPath & "\TestEngine.log") '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 colore di default Dim DefColor As New Color(0, 0, 0) GetPrivateProfileColor("GeomDB", "DefaultColor", DefColor, m_sIniFile) Scene1.SetDefaultMaterial(DefColor) ' imposto colori sfondo Dim BackTopColor As New Color(192, 192, 192) GetPrivateProfileColor("Scene", "BackTop", BackTopColor, m_sIniFile) Dim BackBotColor As New Color(192, 192, 192) GetPrivateProfileColor("Scene", "BackBottom", BackBotColor, m_sIniFile) Scene1.SetViewBackground(BackTopColor, BackBotColor) ' imposto colore di evidenziazione Dim MarkColor As New Color(255, 255, 0) GetPrivateProfileColor("Scene", "Mark", MarkColor, m_sIniFile) Scene1.SetMarkMaterial(MarkColor) ' imposto tipo e colore del rettangolo di zoom Dim bOutline As Boolean = True Dim ZwColor As Color ZwColor.Setup(0, 0, 0) GetPrivateProfileZoomWin("Scene", "ZoomWin", bOutline, ZwColor, m_sIniFile) Scene1.SetZoomWinAttribs(bOutline, ZwColor) ' imposto colore della linea di distanza Dim DstLnColor As Color DstLnColor.Setup(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() ' 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_nOldIdTree = GDB_ID_NULL ' 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 '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 ' Recupero eventuali parametri da linea di comando 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) Case FT_DXF, FT_STL, FT_CNC Scene1.ImportProject(s, False) Case FT_TSC, FT_LUA Scene1.Exec(s, False) 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 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() 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 ToolStripStatusCursorPos.Text = sCursorPos End Sub Private Sub OnMouseSelected(ByVal sender As Object, ByVal nId As Integer) Handles Scene1.OnMouseSelected If EgtIsSelectedObj(nId) Then EgtDeselectObj(nId) Else EgtSelectObj(nId) End If EgtDraw() End Sub Private Sub OnMouseAnalyzed(ByVal sender As Object, ByVal nId As Integer) Handles Scene1.OnMouseAnalyzed SelectIdInObjTree(nId) End Sub Private Sub OnShowDistance(ByVal sender As Object, ByVal sDistance As String) Handles Scene1.OnShowDistance ToolStripStatusOutput.Text = sDistance End Sub Private Sub OnNewProject(ByVal sender As Object) Handles Scene1.OnNewProject m_sCurrFile = String.Empty m_bModified = False EmitTitle() ClearObjTree() 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) Handles Scene1.OnOpenProject m_sCurrFile = sFile m_bModified = False EmitTitle() WritePrivateProfileString("General", "LastNgeDir", Path.GetDirectoryName(m_sCurrFile), m_sIniFile) LoadObjTree() End Sub Private Sub OnSavingProject(ByVal sender As Object, ByVal sFile As String) Handles Scene1.OnSavingProject m_sCurrFile = sFile EmitTitle() WritePrivateProfileString("General", "LastNgeDir", Path.GetDirectoryName(m_sCurrFile), m_sIniFile) ' ripristino stato eventuale oggetto marcato m_nMarkObj = RevertOldIdInObjTree() End Sub Private Sub OnSavedProject(ByVal sender As Object) Handles Scene1.OnSavedProject m_bModified = False ' rimarco eventuale oggetto smarcato SelectIdInObjTree(m_nMarkObj) End Sub Private Sub OnImportingProject(ByVal sender As Object) Handles Scene1.OnImportingProject ClearObjTree() End Sub Private Sub OnImportedProject(ByVal sender As Object, ByVal sFile As String) Handles Scene1.OnImportedProject WritePrivateProfileString("General", "LastImpDir", Path.GetDirectoryName(sFile), m_sIniFile) m_sCurrFile = sFile m_bModified = True EmitTitle() LoadObjTree() End Sub Private Sub OnExportingProject(ByVal sender As Object, ByVal sFile As String) Handles Scene1.OnExportingProject WritePrivateProfileString("General", "LastExpDir", Path.GetDirectoryName(sFile), m_sIniFile) ' ripristino stato eventuale oggetto marcato m_nMarkObj = RevertOldIdInObjTree() End Sub Private Sub OnExportedProject(ByVal sender As Object) Handles Scene1.OnExportedProject ' rimarco eventuale oggetto smarcato SelectIdInObjTree(m_nMarkObj) 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) Handles Scene1.OnExecutedScript m_bModified = True LoadObjTree() 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 ManageModified() Then Return End If ' eseguo Scene1.NewProject() End Sub Private Sub btnOpen_Click(sender As System.Object, e As System.EventArgs) Handles btnOpen.Click ' gestisco eventuale file corrente modificato If Not 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 Scene1.SaveProject(m_sCurrFile) End Sub Private Sub btnSaveAs_Click(sender As System.Object, e As System.EventArgs) Handles btnSaveAs.Click Scene1.SaveAsProject(m_sCurrFile) End Sub Private Sub btnImport_Click(sender As System.Object, e As System.EventArgs) Handles btnImport.Click ' gestisco eventuale file corrente modificato If Not 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_sCurrFile, "dxf")) 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 EgtSetShowMode(SM_WIREFRAME) End Sub Private Sub rbtHiddenLine_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles rbtHiddenLine.CheckedChanged EgtSetShowMode(SM_HIDDENLINE) End Sub Private Sub rbtShading_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles rbtShading.CheckedChanged EgtSetShowMode(SM_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() ToolStripStatusOutput.Text = " " Else Scene1.ResetStatusGetDistance() EgtResetGeoLine() ToolStripStatusOutput.Text = " " End If End Sub Private Sub btnZoomAll_Click(sender As System.Object, e As System.EventArgs) Handles btnZoomAll.Click EgtZoom(ZM_ALL) End Sub Private Sub btnZoomIn_Click(sender As System.Object, e As System.EventArgs) Handles btnZoomIn.Click EgtZoom(ZM_IN) End Sub Private Sub btnZoomOut_Click(sender As System.Object, e As System.EventArgs) Handles btnZoomOut.Click EgtZoom(ZM_OUT) End Sub Private Sub btnTop_Click(sender As System.Object, e As System.EventArgs) Handles btnTop.Click EgtSetView(CT_TOP) End Sub Private Sub btnFront_Click(sender As System.Object, e As System.EventArgs) Handles btnFront.Click EgtSetView(CT_FRONT) End Sub Private Sub btnLeft_Click(sender As System.Object, e As System.EventArgs) Handles btnLeft.Click EgtSetView(CT_LEFT) End Sub Private Sub btnBack_Click(sender As System.Object, e As System.EventArgs) Handles btnBack.Click EgtSetView(CT_BACK) End Sub Private Sub btnRight_Click(sender As System.Object, e As System.EventArgs) Handles btnRight.Click EgtSetView(CT_RIGHT) 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 btnRotP90_Click(sender As System.Object, e As System.EventArgs) Handles btnRotP90.Click Rotate(90) ' aggiorno visualizzazione EgtZoom(ZM_ALL) UpdateObjInObjTree(m_nOldIdTree) End Sub Private Sub btnRotM90_Click(sender As System.Object, e As System.EventArgs) Handles btnRotM90.Click Rotate(-90) ' aggiorno visualizzazione EgtZoom(ZM_ALL) UpdateObjInObjTree(m_nOldIdTree) End Sub Private Sub Rotate(ByVal dAngRotDeg As Double) ' indice del primo gruppo sotto la radice Dim nId As Integer = EgtGetFirstInGroup(GDB_ID_ROOT) ' recupero il box del gruppo in globale Dim PtMinPre As New Point3d Dim PtMaxPre As New Point3d EgtGetBBoxGlob(nId, BBF_IGNORE_TEXT + BBF_EXACT, PtMinPre, PtMaxPre) ' ruoto attorno al punto minimo EgtRotateGlob(nId, PtMinPre, Vector3d.Z_AX, dAngRotDeg) ' calcolo nuovo box in globale Dim PtMinPost As New Point3d Dim PtMaxPost As New Point3d EgtGetBBoxGlob(nId, BBF_IGNORE_TEXT + BBF_EXACT, PtMinPost, PtMaxPost) ' eseguo traslazione per riavere lo stesso punto minimo Dim VtMove As Vector3d = PtMinPre - PtMinPost EgtMoveGlob(nId, VtMove) End Sub Private Sub btnMirror_Click(sender As System.Object, e As System.EventArgs) Handles btnMirror.Click ' indice del primo gruppo sotto la radice Dim nId As Integer = EgtGetFirstInGroup(GDB_ID_ROOT) ' recupero il box del gruppo in globale Dim PtMin As New Point3d Dim PtMax As New Point3d EgtGetBBoxGlob(nId, BBF_IGNORE_TEXT + BBF_EXACT, PtMin, PtMax) Dim PtCen As Point3d = Point3d.Media(PtMin, PtMax) ' mirror rispetto a Y centrato nel box EgtMirrorGlob(nId, PtCen, Vector3d.X_AX) ' sistemo gli eventuali testi UnMirrorTexts(nId) ' aggiorno visualizzazione EgtZoom(ZM_ALL) UpdateObjInObjTree(m_nOldIdTree) End Sub Private Sub UnMirrorTexts(ByVal nGroupId As Integer) Dim nId As Integer = EgtGetFirstInGroup(nGroupId) While nId <> GDB_ID_NULL 'recupero il tipo di oggetto Dim nType As Integer = EgtGetType(nId) 'se gruppo If nType = TY_GROUP Then UnMirrorTexts(nId) ' se testo ElseIf nType = TY_EXT_TEXT Then EgtMirrorText(nId, True) End If ' passo al successivo nId = EgtGetNext(nId) End While End Sub Private Const EI_ST_NULL As Integer = 0 Private Const EI_ST_MOVE1 As Integer = 1 Private Const EI_ST_MOVE2 As Integer = 2 Private m_nStatus As Integer = EI_ST_NULL Private m_ptStart As Point3d Private m_ptCurr As Point3d Private Sub btnMove_Click(sender As System.Object, e As System.EventArgs) Handles btnMove.Click ' posso partire solo da stato libero If m_nStatus <> EI_ST_NULL Then Return End If ' verifico ci sia qualcosa di selezionato If EgtGetFirstSelectedObj() = GDB_ID_NULL Then Return End If ' creo il gruppo di drag e vi copio le entità selezionate If Not Scene1.CreateDragGroup() Then Return End If Dim nId As Integer = EgtGetFirstSelectedObj() While nId <> GDB_ID_NULL If Not Scene1.AddToDragGroup(nId) Then Scene1.EraseDragGroup() Return End If nId = EgtGetNextSelectedObj() End While ' imposto stato di scena a selezione punto Scene1.SetStatusSelPoint() ' imposto stato a primo punto per move m_nStatus = EI_ST_MOVE1 ToolStripStatusOutput.Text = "Select Start Point" End Sub Private Sub OnMouseSelectedPoint(ByVal sender As Object, ByVal PtP As Point3d) Handles Scene1.OnMouseSelectedPoint If m_nStatus = EI_ST_MOVE1 Then m_ptStart = PtP m_ptCurr = PtP m_nStatus = EI_ST_MOVE2 ToolStripStatusOutput.Text = "Select End Point" ElseIf m_nStatus = EI_ST_MOVE2 Then ' cancello gruppo di drag e linea temporanea Scene1.EraseDragGroup() EgtResetGeoLine(False) ' eseguo movimento Dim VtMove As Vector3d = PtP - m_ptStart EgtMoveGlob(GDB_ID_SEL, VtMove) EgtDeselectAll() EgtDraw() ' reset stato di scena Scene1.ResetStatusSelPoint() ' reset stato m_nStatus = EI_ST_NULL ToolStripStatusOutput.Text = "" End If End Sub Private Sub OnMouseMoveSelPoint(ByVal sender As Object, ByVal PtP As Point3d) Handles Scene1.OnMouseMoveSelPoint If m_nStatus = EI_ST_MOVE2 Then Dim VtMove As Vector3d = PtP - m_ptCurr EgtMoveGlob(Scene1.GetDragGroup(), VtMove) EgtSetGeoLine(m_ptStart, PtP) EgtDraw() m_ptCurr = PtP End If 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 Scene1.EraseDragGroup() EgtResetGeoLine(False) m_nStatus = EI_ST_NULL Scene1.ResetStatusSelPoint() ' reset Analisi e Distanza chkAnalyze.Checked = False chkGetDist.Checked = False ' pulisco output ToolStripStatusOutput.Text = "" ' aggiorno disegno EgtDraw() End If 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 If EgtTscExecLine(sCmd) Then Scene1.Invalidate() ToolStripStatusOnR.Text = " " Else ToolStripStatusOnR.Text = "Error executing command" End If ' ricarico albero degli oggetti LoadObjTree() SelectIdInObjTree(nIdOld) End If End If End Sub '-------------------------------- Tree View ------------------------------------------------------ Private m_nOldIdTree As Integer Private Sub LoadObjTree() ClearObjTree() TreeView1.BeginUpdate() TreeView1.Nodes.Add(GDB_ID_NULL.ToString, "No Selection", 0, 0) AddGroupInObjTree(GDB_ID_ROOT, TreeView1.Nodes) TreeView1.EndUpdate() End Sub Private Sub ClearObjTree() RevertOldIdInObjTree() TreeView1.Nodes.Clear() End Sub Private Sub AddGroupInObjTree(ByVal nGroupId 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 sText = sName + " (Group " + nGroupId.ToString + ")" Else sText = "Group " + nGroupId.ToString End If Dim nImage As Integer = TypeToImageInObjTree(TY_GROUP) CurrNodColl = PrevNodColl.Add(nGroupId.ToString, sText, nImage, nImage).Nodes End If Dim nObjs As Integer = EgtGetGroupObjs(nGroupId) If (nObjs > 20000) Then CurrNodColl.Add("-1", "Too many entities") 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 = TY_GROUP Then AddGroupInObjTree(nId, CurrNodColl) 'se oggetto geometrico ElseIf nType >= 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) CurrNodColl.Add(nId.ToString, sText, nImage, nImage) End If 'passo al successivo nId = EgtGetNext(nId) End While End Sub Private Function TypeToImageInObjTree(ByVal nType As Integer) As Integer Select Case nType Case TY_GROUP Return 2 Case TY_GEO_VECTOR Return 3 Case TY_GEO_POINT Return 4 Case TY_GEO_FRAME Return 5 Case TY_CRV_LINE Return 6 Case TY_CRV_ARC Return 7 Case TY_CRV_BEZ Return 8 Case TY_CRV_COMPO Return 9 Case TY_SRF_MESH Return 10 Case TY_EXT_TEXT Return 11 End Select Return 1 End Function Private Sub ObjTree_AfterSelect(ByVal sender As Object, ByVal e As TreeViewEventArgs) Handles TreeView1.AfterSelect ' 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 UpdateObjInObjTree(ByVal nId As Integer) ' ripristino eventuale vecchio oggetto selezionato RevertOldIdInObjTree() ' recupero il tipo del nuovo oggetto Dim nType As Integer = EgtGetType(nId) ' stampa dei dati del nuovo oggetto Dim sDump As String = String.Empty If nType = TY_NONE Then tBoxInfo.Text = String.Empty ElseIf nType = 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 ' permetto in ogni caso la visualizzazione dell'oggetto e lo evidenzio Dim nOldMode As Integer = GDB_MD_STD EgtGetMode(nId, nOldMode) Dim nMode As Integer = IIf((nOldMode = GDB_MD_HIDDEN), GDB_MD_STD, nOldMode) EgtSetMode(nId, nMode) Dim nOldStatus As Integer = GDB_ST_ON EgtGetStatus(nId, nOldStatus) Dim nStat As Integer = IIf((nOldStatus = GDB_ST_OFF), GDB_ST_ON, nOldStatus) EgtSetStatus(nId, nStat) EgtSetMark(nId) m_nOldIdTree = nId ' imposto il ridisegno della scena Scene1.Invalidate() End Sub Private Function RevertOldIdInObjTree() As Integer ' salvo il vecchio Id Dim nOldId As Integer = m_nOldIdTree ' se non nullo... If EgtExistsObj(m_nOldIdTree) Then ' ripristino il modo e lo stato precedente dell'oggetto e lo smarco EgtRevertMode(m_nOldIdTree) EgtRevertStatus(m_nOldIdTree) EgtResetMark(m_nOldIdTree) ' annullo oggetto da ripristinare m_nOldIdTree = 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) Return True Else Return False End If End Function '-------------------------------- Utilities ------------------------------------------------------ Private Function ManageModified() As Boolean ' se non modificato, procedo normalmente If Not m_bModified Then Return True End If ' chiedo cosa fare Dim sMsg As String = "Salvare le modifiche" If Not String.IsNullOrEmpty(m_sCurrFile) Then sMsg += " a " + m_sCurrFile End If sMsg += " ?" Dim nRes = MessageBox.Show(sMsg, "", MessageBoxButtons.YesNoCancel, MessageBoxIcon.Question) Select Case nRes Case Windows.Forms.DialogResult.Yes Scene1.SaveProject(m_sCurrFile) Return True Case Windows.Forms.DialogResult.No Return True Case Else Return False End Select End Function Private Sub EmitTitle() ' nome file Dim sTitle As String = m_sCurrFile If String.IsNullOrEmpty(m_sCurrFile) Then sTitle = "New" End If ' indicazione di modificato If m_bModified Then sTitle += "*" End If ' dati del prodotto sTitle += " - EgalTech TestEGr" ' emissione del titolo Me.Text = sTitle End Sub End Class