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_nMarkObj As Integer = GDB_ID.NULL '-------------------------------- 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 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 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 tipo e colore del rettangolo di zoom Dim bOutline As Boolean = True Dim ZwColor As Color3d 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 Color3d 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() ' imposto i dati della griglia EgtSetGridShow(True, True) EgtSetGridFrame(Frame3d.GLOB) EgtSetGridGeo(10, 1, 10, 50) EgtSetGridColor(New Color3d(160, 160, 160), New Color3d(160, 160, 160)) ' 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 ' 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 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 If Not bOpen Then Scene1.NewProject() End If 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, ByVal bLast As Boolean) Handles Scene1.OnMouseSelected If EgtIsSelectedObj(nId) Then EgtDeselectObj(nId) Else EgtSelectObj(nId) End If If bLast Then EgtDraw() End If 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 ResetModified() EmitTitle() ResetCurrPartLayer() LoadObjTree() 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 ResetModified() EmitTitle() WritePrivateProfileString("General", "LastNgeDir", Path.GetDirectoryName(m_sCurrFile), m_sIniFile) ResetCurrPartLayer() 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 ResetModified() ' 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 SetModified() EmitTitle() ResetCurrPartLayer() 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 SetModified() 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 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() ToolStripStatusOutput.Text = " " Else Scene1.ResetStatusGetDistance() ToolStripStatusOutput.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 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 ' ----------------- Test ------------------- Private Sub XbtnRotP90_Click(sender As System.Object, e As System.EventArgs) Handles XbtnRotP90.Click XRotate(90) ' aggiorno visualizzazione Scene1.ZoomAll() UpdateObjInObjTree(m_nObjTreeOldId) End Sub Private Sub XbtnRotM90_Click(sender As System.Object, e As System.EventArgs) Handles XbtnRotM90.Click XRotate(-90) ' aggiorno visualizzazione Scene1.ZoomAll() UpdateObjInObjTree(m_nObjTreeOldId) End Sub Private Sub XRotate(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, EgtGetGridVersZ(), 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 XbtnMirror_Click(sender As System.Object, e As System.EventArgs) Handles XbtnMirror.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 XUnMirrorTexts(nId) ' aggiorno visualizzazione Scene1.ZoomAll() UpdateObjInObjTree(m_nObjTreeOldId) End Sub Private Sub XUnMirrorTexts(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 XUnMirrorTexts(nId) ' se testo ElseIf nType = TY.EXT_TEXT Then EgtMirrorText(nId, True) End If ' passo al successivo nId = EgtGetNext(nId) End While End Sub ' --------------------- Update UI ------------------------------- Private Sub Application_Idle(ByVal sender As Object, ByVal e As EventArgs) Dim bLayerOk As Boolean = (GetCurrLayer() <> GDB_ID.NULL) Dim bSelOk As Boolean = (EgtGetFirstSelectedObj() <> GDB_ID.NULL) ' Draw btnPoint.Enabled = bLayerOk btnLine2P.Enabled = bLayerOk btnArcCSE.Enabled = bLayerOk btnArc3P.Enabled = bLayerOk ' Construct btnPlane.Enabled = bLayerOk And bSelOk ' Edit btnDelete.Enabled = bSelOk btnInvertCurve.Enabled = bSelOk ' Transform btnCopy.Enabled = bSelOk btnMove.Enabled = bSelOk btnRotate.Enabled = bSelOk btnMirror.Enabled = bSelOk End Sub ' --------------------- Commands -------------------------------- Private Enum EST As Integer NULL = 0 POINT LINE2P_1 LINE2P_2 ARCCSE_1 ARCCSE_2 ARCCSE_3 ARC3P_1 ARC3P_2 ARC3P_3 MOVE_1 MOVE_2 COPY_1 COPY_2 ROTATE_1 ROTATE_2 ROTATE_3 MIRROR_1 MIRROR_2 End Enum Private m_nStatus As EST = EST.NULL Private m_ptP1 As Point3d Private m_ptP2 As Point3d Private Sub btnPoint_Click(sender As System.Object, e As System.EventArgs) Handles btnPoint.Click ' posso partire solo da stato libero If m_nStatus <> EST.NULL Then Return End If ' posso partire solo se esiste un gruppo corrente If GetCurrLayer() = GDB_ID.NULL Then Return End If ' non serve il gruppo di drag ' imposto stato di scena a selezione punto Scene1.SetStatusSelPoint() ' imposto stato a primo punto per point m_nStatus = EST.POINT ToolStripStatusOutput.Text = "Point : select Point" End Sub Private Sub btnLine2P_Click(sender As System.Object, e As System.EventArgs) Handles btnLine2P.Click ' posso partire solo da stato libero If m_nStatus <> EST.NULL Then Return End If ' posso partire solo se esiste un gruppo corrente If GetCurrLayer() = GDB_ID.NULL Then Return End If ' creo il gruppo di drag If Not Scene1.CreateDragGroup() Then Return End If ' imposto stato di scena a selezione punto Scene1.SetStatusSelPoint() ' imposto stato a primo punto per Line2P m_nStatus = EST.LINE2P_1 ToolStripStatusOutput.Text = "Line : select Start Point" End Sub Private Sub btnArcCSE_Click(sender As System.Object, e As System.EventArgs) Handles btnArcCSE.Click ' posso partire solo da stato libero If m_nStatus <> EST.NULL Then Return End If ' posso partire solo se esiste un gruppo corrente If GetCurrLayer() = GDB_ID.NULL Then Return End If ' creo il gruppo di drag If Not Scene1.CreateDragGroup() Then Return End If ' imposto stato di scena a selezione punto Scene1.SetStatusSelPoint() ' imposto stato a primo punto per ArcCSE m_nStatus = EST.ARCCSE_1 ToolStripStatusOutput.Text = "Arc : select Center" End Sub Private Sub btnArc3P_Click(sender As System.Object, e As System.EventArgs) Handles btnArc3P.Click ' posso partire solo da stato libero If m_nStatus <> EST.NULL Then Return End If ' posso partire solo se esiste un gruppo corrente If GetCurrLayer() = GDB_ID.NULL Then Return End If ' creo il gruppo di drag If Not Scene1.CreateDragGroup() Then Return End If ' imposto stato di scena a selezione punto Scene1.SetStatusSelPoint() ' imposto stato a primo punto per Arc3P m_nStatus = EST.ARC3P_1 ToolStripStatusOutput.Text = "Arc : select Start Point" End Sub Private Sub btnPlane_Click(sender As System.Object, e As System.EventArgs) Handles btnPlane.Click ' posso partire solo da stato libero If m_nStatus <> EST.NULL Then Return End If ' posso partire solo se esiste un gruppo corrente If GetCurrLayer() = GDB_ID.NULL Then Return End If ' creo la superficie EgtCreateSurfTriMeshByContour(GetCurrLayer(), EgtGetFirstSelectedObj(), 10 * EPS_SMALL) EgtDeselectAll() ' reset stato scena Scene1.ResetStatus() ' reset stato m_nStatus = EST.NULL ToolStripStatusOutput.Text = "" SetModified() LoadObjTree() End Sub Private Sub btnDelete_Click(sender As System.Object, e As System.EventArgs) Handles btnDelete.Click ' posso partire solo da stato libero If m_nStatus <> EST.NULL Then Return End If ' lancio la cancellazione EgtErase(GDB_ID.SEL) ' reset stato scena Scene1.ResetStatus() ' reset stato m_nStatus = EST.NULL ToolStripStatusOutput.Text = "" SetModified() LoadObjTree() End Sub Private Sub btnInvertCurve_Click(sender As System.Object, e As System.EventArgs) Handles btnInvertCurve.Click ' posso partire solo da stato libero If m_nStatus <> EST.NULL Then Return End If ' lancio l'inversione della curva EgtInvertCurve(EgtGetFirstSelectedObj()) EgtDeselectAll() ' reset stato scena Scene1.ResetStatus() ' reset stato m_nStatus = EST.NULL ToolStripStatusOutput.Text = "" SetModified() LoadObjTree() End Sub Private Sub btnMove_Click(sender As System.Object, e As System.EventArgs) Handles btnMove.Click ' verifico condizioni e preparo per il drag If Not PrepareTransform() Then Return End If ' imposto stato di scena a selezione punto Scene1.SetStatusSelPoint() ' imposto stato a primo punto per Move m_nStatus = EST.MOVE_1 ToolStripStatusOutput.Text = "Move : select Base Point" End Sub Private Sub btnCopy_Click(sender As System.Object, e As System.EventArgs) Handles btnCopy.Click ' verifico condizioni e preparo per il drag If Not PrepareTransform() Then Return End If ' imposto stato di scena a selezione punto Scene1.SetStatusSelPoint() ' imposto stato a primo punto per Move m_nStatus = EST.COPY_1 ToolStripStatusOutput.Text = "Copy : select Base Point" End Sub Private Sub btnRotate_Click(sender As System.Object, e As System.EventArgs) Handles btnRotate.Click ' verifico condizioni e preparo per il drag If Not PrepareTransform() Then Return End If ' imposto stato di scena a selezione punto Scene1.SetStatusSelPoint() ' imposto stato a primo punto per Rotate m_nStatus = EST.ROTATE_1 ToolStripStatusOutput.Text = "Rotate : select Center" End Sub Private Sub btnMirror_Click(sender As System.Object, e As System.EventArgs) Handles btnMirror.Click ' verifico condizioni e preparo per il drag If Not PrepareTransform() Then Return End If ' imposto stato di scena a selezione punto Scene1.SetStatusSelPoint() ' imposto stato a primo punto per Mirror m_nStatus = EST.MIRROR_1 ToolStripStatusOutput.Text = "Rotate : select Start Point" End Sub Private Function PrepareTransform() As Boolean ' posso partire solo da stato libero If m_nStatus <> EST.NULL Then Return False End If ' verifico ci sia qualcosa di selezionato If EgtGetFirstSelectedObj() = GDB_ID.NULL Then Return False End If ' creo il gruppo di drag e vi copio le entità selezionate If Not Scene1.CreateDragGroup() Then Return False End If Dim nId As Integer = EgtGetFirstSelectedObj() While nId <> GDB_ID.NULL If Not Scene1.AddToDragGroup(nId) Then Scene1.EraseDragGroup() Return False End If nId = EgtGetNextSelectedObj() End While Return True End Function Private Sub OnMouseSelectedPoint(ByVal sender As Object, ByVal PtP As Point3d) Handles Scene1.OnMouseSelectedPoint ' Point If m_nStatus = EST.POINT Then ' creo il punto (i dati sono in globale) EgtCreateGeoPoint(GetCurrLayer(), PtP.Loc(GetCurrLayer())) ' reset stato scena Scene1.ResetStatus() ' aggiorno stato m_nStatus = EST.NULL ToolStripStatusOutput.Text = "" SetModified() LoadObjTree() ' Line2P ElseIf m_nStatus = EST.LINE2P_1 Then m_ptP1 = PtP m_nStatus = EST.LINE2P_2 ToolStripStatusOutput.Text = "Line : select End Point" ElseIf m_nStatus = EST.LINE2P_2 Then ' reset scena Scene1.ResetStatus(False) ' creo la linea (i punti sono in globale) EgtCreateCurveLine(GetCurrLayer(), m_ptP1.Loc(GetCurrLayer()), PtP.Loc(GetCurrLayer())) EgtDraw() ' aggiorno stato m_nStatus = EST.NULL ToolStripStatusOutput.Text = "" SetModified() LoadObjTree() ' Arc3P ElseIf m_nStatus = EST.ARC3P_1 Then m_ptP1 = PtP m_nStatus = EST.ARC3P_2 ToolStripStatusOutput.Text = "Arc : select End Point" ElseIf m_nStatus = EST.ARC3P_2 Then m_ptP2 = PtP m_nStatus = EST.ARC3P_3 ToolStripStatusOutput.Text = "Arc : select Mid Point" ElseIf m_nStatus = EST.ARC3P_3 Then ' reset scena Scene1.ResetStatus() ' creo l'arco (i punti sono in globale) EgtCreateCurveArc3P(GetCurrLayer(), m_ptP1.Loc(GetCurrLayer()), PtP.Loc(GetCurrLayer()), m_ptP2.Loc(GetCurrLayer())) EgtDraw() ' aggiorno stato m_nStatus = EST.NULL ToolStripStatusOutput.Text = "" SetModified() LoadObjTree() ' ArcCSE ElseIf m_nStatus = EST.ARCCSE_1 Then m_ptP1 = PtP m_nStatus = EST.ARCCSE_2 ToolStripStatusOutput.Text = "Arc : select Start Point" ElseIf m_nStatus = EST.ARCCSE_2 Then m_ptP2 = PtP m_nStatus = EST.ARCCSE_3 ToolStripStatusOutput.Text = "Arc : select End (near) Point" ElseIf m_nStatus = EST.ARCCSE_3 Then ' reset scena Scene1.ResetStatus() ' creo l'arco (i punti sono in globale) EgtCreateCurveArcC2PN(GetCurrLayer(), m_ptP1.Loc(GetCurrLayer()), m_ptP2.Loc(GetCurrLayer()), PtP.Loc(GetCurrLayer()), EgtGetGridVersZ()) EgtDraw() ' aggiorno stato m_nStatus = EST.NULL ToolStripStatusOutput.Text = "" SetModified() LoadObjTree() ' Move ElseIf m_nStatus = EST.MOVE_1 Then m_ptP1 = PtP m_nStatus = EST.MOVE_2 ToolStripStatusOutput.Text = "Move : select Target Point" ElseIf m_nStatus = EST.MOVE_2 Then ' eseguo movimento EgtMoveGlob(GDB_ID.SEL, (PtP - m_ptP1)) EgtDeselectAll() ' reset stato scena Scene1.ResetStatus() ' aggiorno stato m_nStatus = EST.NULL ToolStripStatusOutput.Text = "" SetModified() LoadObjTree() ' Copy ElseIf m_nStatus = EST.COPY_1 Then m_ptP1 = PtP m_nStatus = EST.COPY_2 ToolStripStatusOutput.Text = "Copy : select Target Point" ElseIf m_nStatus = EST.COPY_2 Then ' reset scena Scene1.ResetStatus() ' eseguo copia e movimento Dim nId As Integer = EgtGetFirstSelectedObj() While nId <> GDB_ID.NULL Dim nCopyId As Integer = EgtCopyGlob(nId, GetCurrLayer()) EgtMoveGlob(nCopyId, (PtP - m_ptP1)) nId = EgtGetNextSelectedObj() End While EgtDeselectAll() EgtDraw() ' aggiorno stato m_nStatus = EST.NULL ToolStripStatusOutput.Text = "" SetModified() LoadObjTree() ' Rotate ElseIf m_nStatus = EST.ROTATE_1 Then m_ptP1 = PtP m_nStatus = EST.ROTATE_2 ToolStripStatusOutput.Text = "Rotate : select Base Point" ElseIf m_nStatus = EST.ROTATE_2 Then m_ptP2 = PtP m_nStatus = EST.ROTATE_3 ToolStripStatusOutput.Text = "Rotate : select Rotation Point" ElseIf m_nStatus = EST.ROTATE_3 Then ' eseguo rotazione Dim dAngRotDeg As Double = 0 Dim bDet As Boolean = True EgtGetVectorRotation((m_ptP2 - m_ptP1), (PtP - m_ptP1), EgtGetGridVersZ(), dAngRotDeg, bDet) EgtRotateGlob(GDB_ID.SEL, m_ptP1, EgtGetGridVersZ(), dAngRotDeg) EgtDeselectAll() ' reset stato scena Scene1.ResetStatus() ' aggiorno stato m_nStatus = EST.NULL ToolStripStatusOutput.Text = "" SetModified() LoadObjTree() ' Mirror ElseIf m_nStatus = EST.MIRROR_1 Then m_ptP1 = PtP m_ptP2 = m_ptP1 m_nStatus = EST.MIRROR_2 ToolStripStatusOutput.Text = "Mirror : select End Point" ElseIf m_nStatus = EST.MIRROR_2 Then ' eseguo mirror Dim VtNorm As Vector3d = (PtP - m_ptP1) ^ EgtGetGridVersZ() If VtNorm.Len > EPS_SMALL Then EgtMirrorGlob(GDB_ID.SEL, m_ptP1, VtNorm) End If EgtDeselectAll() ' reset stato scena Scene1.ResetStatus() ' aggiorno stato m_nStatus = EST.NULL ToolStripStatusOutput.Text = "" SetModified() LoadObjTree() End If End Sub Private Sub OnMouseMoveSelPoint(ByVal sender As Object, ByVal PtP As Point3d) Handles Scene1.OnMouseMoveSelPoint If m_nStatus = EST.LINE2P_2 Then ' durante la creazione di oggetti il gruppo di Drag ha riferimento globale Dim nId As Integer = EgtGetFirstInGroup(Scene1.GetDragGroup()) If nId = GDB_ID.NULL Then EgtCreateCurveLine(Scene1.GetDragGroup(), m_ptP1, PtP) Else EgtModifyCurveEndPoint(nId, PtP) End If EgtDraw() ElseIf m_nStatus = EST.ARC3P_2 Or m_nStatus = EST.ARCCSE_2 Then ' durante la creazione di oggetti il gruppo di Drag ha riferimento globale Dim nId As Integer = EgtGetFirstInGroup(Scene1.GetDragGroup()) If nId = GDB_ID.NULL Then EgtCreateCurveLine(Scene1.GetDragGroup(), m_ptP1, PtP) Else EgtModifyCurveEndPoint(nId, PtP) End If EgtDraw() ElseIf m_nStatus = EST.ARC3P_3 Then ' durante la creazione di oggetti il gruppo di Drag ha riferimento globale Dim nId As Integer = EgtGetFirstInGroup(Scene1.GetDragGroup()) If EgtGetType(nId) <> TY.CRV_ARC Then EgtErase(nId) nId = GDB_ID.NULL End If If nId = GDB_ID.NULL Then EgtCreateCurveArc3P(Scene1.GetDragGroup(), m_ptP1, PtP, m_ptP2) Else EgtModifyCurveArc3P(nId, PtP) End If EgtDraw() ElseIf m_nStatus = EST.ARCCSE_3 Then ' durante la creazione di oggetti il gruppo di Drag ha riferimento globale Dim nId As Integer = EgtGetFirstInGroup(Scene1.GetDragGroup()) If EgtGetType(nId) <> TY.CRV_ARC Then EgtErase(nId) nId = GDB_ID.NULL End If If nId = GDB_ID.NULL Then Dim vtN As New Vector3d(0, 0, 1) EgtCreateCurveArcC2PN(Scene1.GetDragGroup(), m_ptP1, m_ptP2, PtP, vtN.Glob(GetCurrLayer())) Else EgtModifyCurveArcC2PN(nId, PtP) End If EgtDraw() ElseIf m_nStatus = EST.MOVE_2 Then ' ripristino lo stato iniziale EgtChangeGroupFrame(Scene1.GetDragGroup(), Frame3d.GLOB) ' eseguo tutto il movimento EgtMoveGlob(Scene1.GetDragGroup(), (PtP - m_ptP1)) EgtSetGeoLine(m_ptP1, PtP) EgtDraw() ElseIf m_nStatus = EST.COPY_2 Then ' ripristino lo stato iniziale EgtChangeGroupFrame(Scene1.GetDragGroup(), Frame3d.GLOB) ' eseguo tutto il movimento EgtMoveGlob(Scene1.GetDragGroup(), (PtP - m_ptP1)) EgtSetGeoLine(m_ptP1, PtP) EgtDraw() ElseIf m_nStatus = EST.ROTATE_3 Then ' ripristino lo stato iniziale EgtChangeGroupFrame(Scene1.GetDragGroup(), Frame3d.GLOB) ' eseguo rotazione Dim dAngRotDeg As Double = 0 Dim bDet As Boolean = True EgtGetVectorRotation((m_ptP2 - m_ptP1), (PtP - m_ptP1), EgtGetGridVersZ(), dAngRotDeg, bDet) EgtRotateGlob(Scene1.GetDragGroup(), m_ptP1, EgtGetGridVersZ(), dAngRotDeg) EgtDraw() ElseIf m_nStatus = EST.MIRROR_2 Then ' ripristino lo stato iniziale, tramite annullo mirror precedente Dim VtNorm As Vector3d = (m_ptP2 - m_ptP1) ^ EgtGetGridVersZ() If VtNorm.Len > EPS_SMALL Then EgtMirrorGlob(Scene1.GetDragGroup(), m_ptP1, VtNorm) End If ' eseguo mirror VtNorm = (PtP - m_ptP1) ^ EgtGetGridVersZ() If VtNorm.Len > EPS_SMALL Then EgtMirrorGlob(Scene1.GetDragGroup(), m_ptP1, VtNorm) End If ' salvo il punto m_ptP2 = PtP EgtDraw() 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 m_nStatus = EST.NULL Scene1.ResetStatus() ' reset Analisi e Distanza chkAnalyze.Checked = False chkGetDist.Checked = False ' pulisco output ToolStripStatusOutput.Text = "" 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 ' posso partire solo da stato libero If m_nStatus <> EST.NULL Then Return End If ' lancio la cancellazione If EgtGetFirstSelectedObj() <> GDB_ID.NULL Then EgtErase(GDB_ID.SEL) SetModified() ' reset stato scena Scene1.ResetStatus() ' reset stato m_nStatus = EST.NULL ToolStripStatusOutput.Text = "" End If 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 '-------------------------------- Current Piece/Layer -------------------------------------------- Private m_nCurrPart = GDB_ID.NULL Private m_nCurrLayer = GDB_ID.NULL Private Sub btnNewPart_Click(sender As System.Object, e As System.EventArgs) Handles btnNewPart.Click ' inserisco un nuovo gruppo (piece) sotto la radice Dim nIdNewPart As Integer = EgtCreateGroup(GDB_ID.ROOT) ' inserisco un nuovo gruppo (layer) sotto quello appena creato Dim nIdNewLayer As Integer = EgtCreateGroup(nIdNewPart) ' se ok, salvo nuova situazione If nIdNewPart <> GDB_ID.NULL And nIdNewLayer <> GDB_ID.NULL Then m_nCurrPart = nIdNewPart m_nCurrLayer = nIdNewLayer SetModified() End If ' aggiorno visualizzazione EmitCurrPartLayer() LoadObjTree() End Sub Private Sub btnNewLayer_Click(sender As System.Object, e As System.EventArgs) Handles btnNewLayer.Click ' inserisco un nuovo gruppo (layer) sotto il pezzo corrente Dim nIdNewLayer As Integer = EgtCreateGroup(m_nCurrPart) ' se ok, salvo nuova situazione If nIdNewLayer <> GDB_ID.NULL Then m_nCurrLayer = nIdNewLayer SetModified() End If ' aggiorno visualizzazione EmitCurrPartLayer() LoadObjTree() End Sub Private Sub btnColor_Click(sender As System.Object, e As System.EventArgs) Handles btnColor.Click Dim nCurrId As Integer If m_nCurrPart <> GDB_ID.NULL Then nCurrId = m_nCurrPart If m_nCurrLayer <> GDB_ID.NULL Then nCurrId = m_nCurrLayer End If Else Return End If Dim colObj As Color3d EgtGetCalcColor(nCurrId, colObj) ColorDialog1.Color = colObj.ToColor() If ColorDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then colObj.FromColor(ColorDialog1.Color) EgtSetColor(nCurrId, colObj) EmitCurrPartLayer() SetModified() EgtDraw() End If End Sub Private Function SetCurrPartLayer(ByVal nPart As Integer, ByVal nLayer As Integer) ' verifico esistenza If Not EgtExistsObj(nPart) Or EgtGetParent(nLayer) <> nPart Then Return False End If ' assegno m_nCurrPart = nPart m_nCurrLayer = nLayer ' aggiorno visualizzazione EmitCurrPartLayer() Return True End Function Private Sub ResetCurrPartLayer() ' reset m_nCurrPart = GDB_ID.NULL m_nCurrLayer = GDB_ID.NULL ' cerco il primo pezzo Dim nIdPart As Integer = EgtGetFirstGroupInGroup(GDB_ID.ROOT) If nIdPart <> GDB_ID.NULL Then ' assegno il pezzo corrente m_nCurrPart = nIdPart ' cerco il primo layer del pezzo Dim nIdLayer As Integer = EgtGetFirstGroupInGroup(m_nCurrPart) If nIdLayer <> GDB_ID.NULL Then ' assegno il layer corrente m_nCurrLayer = nIdLayer End If End If ' aggiorno visualizzazione EmitCurrPartLayer() End Sub Private Function GetCurrPart() As Integer Return m_nCurrPart End Function Private Function GetCurrLayer() As Integer Return m_nCurrLayer End Function Private Sub EmitCurrPartLayer() Dim sText As String = " " Dim colObj As Color3d EgtGetColor(GDB_ID.ROOT, colObj) If m_nCurrPart <> GDB_ID.NULL Then sText = "Part " + m_nCurrPart.ToString() EgtGetCalcColor(m_nCurrPart, colObj) If m_nCurrLayer <> GDB_ID.NULL And EgtExistsObj(m_nCurrLayer) Then sText += " --> Layer " + m_nCurrLayer.ToString() EgtGetCalcColor(m_nCurrLayer, colObj) End If End If txtPartLay.Text = sText txtColor.BackColor = colObj.ToColor() End Sub '-------------------------------- Tree View ------------------------------------------------------ Private m_nObjTreeOldId 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 Private Sub LoadObjTree() ClearObjTree() TreeView1.BeginUpdate() 'TreeView1.Nodes.Add(GDB_ID.NULL.ToString, "No Selection", 0, 0) AddGroupInObjTree(GDB_ID.ROOT, 0, TreeView1.Nodes) TreeView1.EndUpdate() End Sub Private Sub ClearObjTree() RevertOldIdInObjTree() TreeView1.Nodes.Clear() End Sub 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(TY.GROUP, nLev) 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, nLev + 1, 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, nLev) 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, ByVal nLev As Integer) As Integer Select Case nType Case TY.GROUP If nLev = 1 Then Return 3 ElseIf nLev = 2 Then Return 4 Else Return 2 End If Case TY.GEO_VECTOR Return 5 Case TY.GEO_POINT Return 6 Case TY.GEO_FRAME Return 7 Case TY.CRV_LINE Return 8 Case TY.CRV_ARC Return 9 Case TY.CRV_BEZ Return 10 Case TY.CRV_COMPO Return 11 Case TY.SRF_MESH Return 12 Case TY.EXT_TEXT Return 13 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 ObjTree_MouseUp(ByVal sender As Object, e As MouseEventArgs) Handles TreeView1.MouseUp If m_nObjTreeOldId <> GDB_ID.NULL Then ' evidenzio EgtSetMark(m_nObjTreeOldId) EgtDraw() ' lancio timer per successiva de-evidenziazione ObjTreeTimer.Stop() ObjTreeTimer.Start() 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 ' recupero il padre Dim nIdParent As Integer = EgtGetParent(m_nObjTreeOldId) If nIdParent = GDB_ID.NULL Then Return ' se Part ElseIf nIdParent = GDB_ID.ROOT Then ' cerco il primo Layer del Part Dim nId As Integer = EgtGetFirstGroupInGroup(m_nObjTreeOldId) SetCurrPartLayer(m_nObjTreeOldId, nId) ' se Layer ElseIf EgtGetParent(nIdParent) = GDB_ID.ROOT Then SetCurrPartLayer(nIdParent, m_nObjTreeOldId) End If End If End Sub Private Sub ObjTree_KeyDown(ByVal sender As System.Object, ByVal e As KeyEventArgs) Handles TreeView1.KeyDown ' Con DEL eseguo cancellazione del pezzo o del layer selezionati If e.KeyData = Keys.Delete Then ' posso partire solo da stato libero If m_nStatus <> EST.NULL Then Return End If ' lancio la cancellazione If m_nObjTreeOldId <> GDB_ID.NULL Then EgtErase(m_nObjTreeOldId) SetModified() ' reset stato scena Scene1.ResetStatus() ' reset stato m_nStatus = EST.NULL ToolStripStatusOutput.Text = "" ' aggiorno visualizzazione If m_nObjTreeOldId = m_nCurrPart Or m_nObjTreeOldId = m_nCurrLayer Then ResetCurrPartLayer() End If m_nObjTreeOldId = GDB_ID.NULL LoadObjTree() End If End If 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_nObjTreeOldId = nId ' imposto il ridisegno della scena EgtDraw() ' lancio timer per successiva de-evidenziazione ObjTreeTimer.Stop() ObjTreeTimer.Start() 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 ' ripristino il modo e lo stato precedente dell'oggetto e lo smarco EgtRevertMode(m_nObjTreeOldId) EgtRevertStatus(m_nObjTreeOldId) 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) Return True Else Return False End If End Function '-------------------------------- Modified Status ------------------------------------------------ Private m_bModified As Boolean = False Private Sub SetModified() m_bModified = True EmitTitle() End Sub Private Sub ResetModified() m_bModified = False EmitTitle() End Sub 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 '-------------------------------- Program Title -------------------------------------------------- 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 TestEIn" ' emissione del titolo Me.Text = sTitle End Sub End Class