'---------------------------------------------------------------------------- ' EgalTech 2014-2015 '---------------------------------------------------------------------------- ' File : Form1.vb Data : 27.01.15 Versione : 1.6a6 ' 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 New Mutex Private m_nInstance As Integer = 0 Private m_sDataRoot As String = String.Empty Private m_sConfigDir As String = String.Empty Private m_sTempDir As String = String.Empty Private m_sIniFile As String = String.Empty Private m_bShowGrid As Boolean Private m_bShowGridFrame As Boolean Private m_bCPlaneTypePos As Boolean Private WithEvents m_Controller As New Controller Private m_MruFiles As New MruList Private m_MruScripts As New MruList 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(S_DATA, K_DATAROOT, "", m_sDataRoot, m_sDataRoot & "\" & DAT_FILE_NAME) = 0 Then m_sDataRoot = Application.StartupPath End If ' Impostazione direttorio di configurazione m_sConfigDir = m_sDataRoot & "\" & CONF_DIR ' Impostazione direttorio per file temporanei m_sTempDir = m_sDataRoot & "\" & TEMP_DIR ' Impostazione path Ini file m_sIniFile = m_sConfigDir & "\" & INI_FILE_NAME ' Verifico indice di istanza ManageIstance() ' Inizializzazione generale di EgtInterface Dim sLogFile As String = m_sTempDir & "\" & GENLOG_FILE_NAME.Replace("#", m_nInstance.ToString()) Dim sLogMsg As String = "User " & SystemInformation.UserName & "\" & SystemInformation.ComputerName & " (" & GetInstance() & ")" & vbLf & My.Application.Info.Description.ToString() & " ver. " & My.Application.Info.Version.ToString() EgtInit(0, sLogFile, sLogMsg) ' Leggo file messaggi Dim sMsgFile As String = String.Empty GetPrivateProfileString(S_GENERAL, K_MESSAGES, "", sMsgFile, m_sIniFile) Dim sMsgFilePath As String = m_sConfigDir & "\" & sMsgFile If Not EgtLoadMessages(sMsgFilePath) Then EgtOutLog("Error in EgtLoadMessages") End If ' Leggo e imposto chiave di protezione Dim sLicFile As String = m_sConfigDir & "\" & LIC_FILE_NAME Dim sKey As String = String.Empty GetPrivateProfileString(S_LICENCE, K_KEY, "", sKey, sLicFile) EgtSetKey(sKey) ' imposto dir font Nfe e font default Dim sNfeDir As String = String.Empty GetPrivateProfileString(S_GEOMDB, K_NFEFONTDIR, "", sNfeDir, m_sIniFile) Dim sDefFont As String = String.Empty GetPrivateProfileString(S_GEOMDB, K_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(S_LUA, K_LIBSDIR, "", sLuaLibsDir, m_sIniFile) EgtSetLuaLibs(sLuaLibsDir) Dim sLuaBaseLib As String = String.Empty GetPrivateProfileString(S_LUA, K_BASELIB, "EgtBase", sLuaBaseLib, m_sIniFile) EgtLuaRequire(sLuaBaseLib) ' imposto colore di default Dim DefColor As New Color3d(0, 0, 0) GetPrivateProfileColor(S_GEOMDB, K_DEFAULTCOLOR, DefColor, m_sIniFile) Scene1.SetDefaultMaterial(DefColor) ' imposto colori sfondo Dim BackTopColor As New Color3d(192, 192, 192) GetPrivateProfileColor(S_SCENE, K_BACKTOP, BackTopColor, m_sIniFile) Dim BackBotColor As New Color3d(BackTopColor) GetPrivateProfileColor(S_SCENE, K_BACKBOTTOM, BackBotColor, m_sIniFile) Scene1.SetViewBackground(BackTopColor, BackBotColor) ' imposto colore di evidenziazione Dim MarkColor As New Color3d(255, 255, 0) GetPrivateProfileColor(S_SCENE, K_MARK, MarkColor, m_sIniFile) Scene1.SetMarkMaterial(MarkColor) ' imposto colore per superfici selezionate Dim SelSurfColor As New Color3d(255, 255, 192) GetPrivateProfileColor(S_SCENE, K_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(S_SCENE, K_ZOOMWIN, bOutline, ZwColor, m_sIniFile) Scene1.SetZoomWinAttribs(bOutline, ZwColor) ' imposto colore della linea di distanza Dim DstLnColor As New Color3d(255, 0, 0) GetPrivateProfileColor(S_SCENE, K_DISTLINE, DstLnColor, m_sIniFile) Scene1.SetDistLineMaterial(DstLnColor) ' imposto parametri OpenGL Dim nDriver As Integer = GetPrivateProfileInt(S_OPENGL, K_DRIVER, 3, m_sIniFile) Dim b2Buff As Boolean = (GetPrivateProfileInt(S_OPENGL, K_DOUBLEBUFFER, 1, m_sIniFile) <> 0) Dim nColorBits As Integer = GetPrivateProfileInt(S_OPENGL, K_COLORBITS, 32, m_sIniFile) Dim nDepthBits As Integer = GetPrivateProfileInt(S_OPENGL, K_DEPTHBITS, 32, m_sIniFile) Scene1.SetViewAttributes(nDriver, b2Buff, nColorBits, nDepthBits) ' inizializzo scena Scene1.Init() ' imposto visualizzazione riferimento globale Dim bShowGlobFrame As Boolean = (GetPrivateProfileInt(S_SCENE, K_SHOWGFRAME, 1, m_sIniFile) <> 0) EgtSetGlobFrameShow(bShowGlobFrame) ' imposto i dati della griglia m_bShowGrid = (GetPrivateProfileInt(S_GRID, K_SHOWGRID, 1, m_sIniFile) <> 0) m_bShowGridFrame = (GetPrivateProfileInt(S_GRID, K_SHOWFRAME, 1, m_sIniFile) <> 0) Dim dSnapStep As Double = GetPrivateProfileDouble(S_GRID, K_SNAPSTEP, 10, m_sIniFile) Dim nMinLineSStep As Integer = GetPrivateProfileInt(S_GRID, K_MINLINESSTEP, 1, m_sIniFile) Dim nMajLineSStep As Integer = GetPrivateProfileInt(S_GRID, K_MAJLINESSTEP, 10, m_sIniFile) Dim nExtSStep As Integer = GetPrivateProfileInt(S_GRID, K_EXTSSTEP, 50, m_sIniFile) Dim MinLnColor As New Color3d(160, 160, 160) GetPrivateProfileColor(S_GRID, K_MINLNCOLOR, MinLnColor, m_sIniFile) Dim MajLnColor As New Color3d(160, 160, 160) GetPrivateProfileColor(S_GRID, K_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(S_SCENE, K_SHOWMODE, SM.SHADING, m_sIniFile) If nShowMode = SM.WIREFRAME Then btnWireFrame.Checked = True ElseIf nShowMode = SM.HIDDENLINE Then btnHiddenLine.Checked = True Else btnShading.Checked = True End If ' visualizzazione direzione curve Dim nShowCurveDir As Integer = GetPrivateProfileInt(S_SCENE, K_CURVEDIR, 0, m_sIniFile) chkCurveDir.Checked = (nShowCurveDir <> 0) ' visualizzazione avanzata dei triangoli costituenti le superfici Dim bShowTriaAdv As Boolean = (GetPrivateProfileInt(S_SCENE, K_SHOWTRIAADV, 1, m_sIniFile) <> 0) EgtSetShowTriaAdv(bShowTriaAdv) ' 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(S_GENERAL, K_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(S_GENERAL, K_COMMANDLOG, 0, m_sIniFile) <> 0) Dim sCmdLogFile As String = CMDLOG_FILE_NAME.Replace("#", m_nInstance.ToString()) If Not m_Controller.SetCommandLog(bLuaReg, m_sTempDir, sCmdLogFile) 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 ' Impostazioni MruLists m_MruFiles.Init(m_sIniFile, S_MRUFILES, 8) m_MruScripts.Init(m_sIniFile, S_MRUSCRIPTS, 8) ' Apro progetto vuoto m_Controller.NewProject(True) ' Impostazione Testi e ToolTips SetMessages() End Sub Private Sub ManageIstance() Dim bCreated As Boolean Try m_objMutex = New Mutex(False, "Global\TestEIn", bCreated) Catch bCreated = False End Try If bCreated Then ' Prima istanza m_nInstance = 1 ' Aggiorno stato istanze attive WritePrivateProfileString(S_GENERAL, K_INSTANCES, m_nInstance, m_sIniFile) Else ' Leggo il massimo numero di istanze ammesse Dim nMaxInst As Integer = GetPrivateProfileInt(S_GENERAL, K_MAXINST, 1, m_sIniFile) nMaxInst = Max(1, Min(nMaxInst, 32)) ' Cerco il primo indice di istanza libero (max 32) Dim nTmp As Integer = GetPrivateProfileInt(S_GENERAL, K_INSTANCES, 0, m_sIniFile) m_nInstance = 1 Dim nMask As Integer = 1 While (nTmp And nMask) <> 0 And m_nInstance <= m_nInstance m_nInstance += 1 nMask *= 2 End While ' Se l'indice supera il massimo If m_nInstance > nMaxInst Then ' porto in primo piano la prima istanza Dim bFound As Boolean = False ' processi del programma a 32 bit Dim localProc As Process() = Process.GetProcessesByName("TestEInR32") For Each p As Process In localProc If p.Id <> Process.GetCurrentProcess().Id Then bFound = True ShowWindow(p.MainWindowHandle, SW.SHOWMAXIMIZED) Exit For End If Next ' se non trovati processi a 32 bit provo a 64 bit If Not bFound Then localProc = Process.GetProcessesByName("TestEInR64") For Each p As Process In localProc If p.Id <> Process.GetCurrentProcess().Id Then bFound = True ShowWindow(p.MainWindowHandle, SW.SHOWMAXIMIZED) Exit For End If Next End If ' esco dal programma End End If ' Aggiorno stato istanze attive nTmp += (1 << (m_nInstance - 1)) WritePrivateProfileString(S_GENERAL, K_INSTANCES, nTmp, m_sIniFile) End If 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 m_Controller.OpenProject(s, False) bOpen = True Case FT.DXF, FT.STL, FT.CNC m_Controller.ImportProject(s, False) bOpen = True Case FT.TSC, FT.LUA m_Controller.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(S_SCENE, K_SHOWMODE, EgtGetShowMode(), m_sIniFile) ' Salvo stato visualizzazione direzione curve WritePrivateProfileString(S_SCENE, K_CURVEDIR, IIf(EgtGetShowCurveDirection(), 1, 0), m_sIniFile) ' Salvo posizione Form Dim nFlag As Integer = IIf(Me.WindowState = FormWindowState.Maximized, 1, 0) WritePrivateProfileWinPos(S_GENERAL, K_WINPLACE, nFlag, Me.Left, Me.Top, Me.Width, Me.Height, m_sIniFile) ' Terminazione generale di EgtInterface EgtExit() ' Rilascio mutex m_objMutex.Close() ' Aggiorno istanze usate Dim nTmp As Integer = GetPrivateProfileInt(S_GENERAL, K_INSTANCES, 0, m_sIniFile) nTmp -= (1 << (m_nInstance - 1)) WritePrivateProfileString(S_GENERAL, K_INSTANCES, nTmp, m_sIniFile) ' 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 OnMouseSelectedAll(ByVal sender As Object) Handles Scene1.OnMouseSelectedAll m_Controller.MouseSelectedAll() End Sub Private Sub OnMouseDeselectedAll(ByVal sender As Object) Handles Scene1.OnMouseDeselectedAll m_Controller.MouseDeselectedAll() 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, ByVal nAux As Integer) Handles Scene1.OnMousePointFromSelection m_Controller.SetPointFromSelection(PtP, nAux) 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 m_Controller.OnNewProject If Not bOk Then MessageBox.Show(EgtMsg(10002), EgtMsg(10001), MessageBoxButtons.OK, MessageBoxIcon.Error) ' Error on new file - Error End If End Sub Private Sub OnOpeningProject(ByVal sender As Object) Handles m_Controller.OnOpeningProject ClearObjTree() End Sub Private Sub OnOpenProject(ByVal sender As Object, ByVal sFile As String, ByVal bOk As Boolean) Handles m_Controller.OnOpenProject WritePrivateProfileString(S_GENERAL, K_LASTNGEDIR, Path.GetDirectoryName(sFile), m_sIniFile) If bOk Then m_MruFiles.Add(sFile) Else m_MruFiles.Remove(sFile) Dim sMsg As String = EgtMsg(10003) & " '" & sFile & "'" 'Error opening file MessageBox.Show(sMsg, EgtMsg(10001), MessageBoxButtons.OK, MessageBoxIcon.Error) 'Error End If End Sub Private Sub OnSavingProject(ByVal sender As Object) Handles m_Controller.OnSavingProject End Sub Private Sub OnSavedProject(ByVal sender As Object, ByVal sFile As String, ByVal bOk As Boolean) Handles m_Controller.OnSavedProject WritePrivateProfileString(S_GENERAL, K_LASTNGEDIR, Path.GetDirectoryName(sFile), m_sIniFile) If bOk Then m_MruFiles.Add(sFile) Else m_MruFiles.Remove(sFile) Dim sMsg As String = EgtMsg(10004) & " '" & sFile & "'" 'Error saving file MessageBox.Show(sMsg, EgtMsg(10001), MessageBoxButtons.OK, MessageBoxIcon.Error) ' Error End If End Sub Private Sub OnImportingProject(ByVal sender As Object, ByVal bOkType As Boolean) Handles m_Controller.OnImportingProject If bOkType Then ClearObjTree() Else MessageBox.Show(EgtMsg(10005), EgtMsg(10001), MessageBoxButtons.OK, MessageBoxIcon.Error) ' File type unknown - Error End If End Sub Private Sub OnImportedProject(ByVal sender As Object, ByVal sFile As String, ByVal bOk As Boolean) Handles m_Controller.OnImportedProject WritePrivateProfileString(S_GENERAL, K_LASTIMPDIR, Path.GetDirectoryName(sFile), m_sIniFile) If Not bOk Then Dim sMsg As String = EgtMsg(10006) & " '" & sFile & "'" 'Error importing file MessageBox.Show(sMsg, EgtMsg(10001), MessageBoxButtons.OK, MessageBoxIcon.Error) ' Error End If End Sub Private Sub OnExportingProject(ByVal sender As Object) Handles m_Controller.OnExportingProject End Sub Private Sub OnExportedProject(ByVal sender As Object, ByVal sFile As String, ByVal bOk As Boolean) Handles m_Controller.OnExportedProject WritePrivateProfileString(S_GENERAL, K_LASTEXPDIR, Path.GetDirectoryName(sFile), m_sIniFile) If Not bOk Then Dim sMsg As String = EgtMsg(10007) & " '" & sFile & "'" 'Error exporting file MessageBox.Show(sMsg, EgtMsg(10001), MessageBoxButtons.OK, MessageBoxIcon.Error) ' Error End If End Sub Private Sub OnExecutingScript(ByVal sender As Object) Handles m_Controller.OnExecutingScript ClearObjTree() End Sub Private Sub OnExecutedScript(ByVal sender As Object, ByVal sFile As String, ByVal bOk As Boolean, ByVal sError As String) Handles m_Controller.OnExecutedScript WritePrivateProfileString(S_GENERAL, K_LASTLUADIR, Path.GetDirectoryName(sFile), m_sIniFile) If bOk Then m_MruScripts.Add(sFile) Else m_MruScripts.Remove(sFile) MessageBox.Show(sError, EgtMsg(10001), MessageBoxButtons.OK, MessageBoxIcon.Error) ' Error End If End Sub Private Sub OnPrepareInputBox(ByVal sTitle As String, ByVal sLabel As String, ByVal 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() If m_Controller.GetContinue() Then tsStatusOutput.Text = EgtMsg(399) Else tsStatusOutput.Text = "" End If ' 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 btnCPlanePerpObj.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 btnPolygon.Enabled = bLayerOk btnText.Enabled = bLayerOk ' Construct btnPlane.Enabled = bLayerOk And bSelOk btnExtrude.Enabled = bLayerOk And bSelOk btnRevolve.Enabled = bLayerOk And bSelOk btnScrew.Enabled = bLayerOk And bSelOk btnRuled.Enabled = bLayerOk And bSelOk btnMergeSurf.Enabled = bSelOk btnInvertSurf.Enabled = bSelOk ' Edit btnDelete.Enabled = bSelOk btnChangeLayer.Enabled = bSelOk btnChangeColor.Enabled = bSelOk btnInvertCurve.Enabled = bSelOk btnChangeStartCurve.Enabled = bSelOk btnExtendCurve.Enabled = bSelOk btnBreakCurve.Enabled = bSelOk btnJoinCurve.Enabled = bLayerOk And bSelOk btnExplodeCurve.Enabled = bSelOk btnSetCurveTh.Enabled = bSelOk ' Transform btnMove.Enabled = bSelOk btnRotate.Enabled = bSelOk btnMirror.Enabled = bSelOk btnScale.Enabled = bSelOk btnOffset.Enabled = bSelOk End Sub Private Sub SetMessages() ' File TabFile.Text = EgtMsg(1) ' File SetTextAndToolTip(btnNew, 3, 0) ' New SetTextAndToolTip(btnOpen, 5, 6) ' Open
Recent files (Shift) SetTextAndToolTip(btnInsert, 7, 0) ' Insert SetTextAndToolTip(btnSave, 9, 0) ' Save SetTextAndToolTip(btnSaveAs, 11, 0) ' SaveAs SetTextAndToolTip(btnImport, 13, 0) ' Import SetTextAndToolTip(btnExport, 15, 0) ' Export SetTextAndToolTip(btnExec, 17, 0) ' Exec ' View TabView.Text = EgtMsg(101) ' View SetTextAndToolTip(btnWireFrame, 103, 0) ' WFrame SetTextAndToolTip(btnHiddenLine, 105, 0) ' HLine SetTextAndToolTip(btnShading, 107, 0) ' Shading SetTextAndToolTip(btnZoomAll, 109, 0) ' ZoomAll SetTextAndToolTip(btnZoomIn, 111, 0) ' ZoomIn SetTextAndToolTip(btnZoomOut, 113, 0) ' ZoomOut SetTextAndToolTip(btnTop, 115, 0) ' Top SetTextAndToolTip(btnFront, 117, 0) ' Front SetTextAndToolTip(btnRight, 119, 0) ' Right SetTextAndToolTip(btnBack, 121, 0) ' Back SetTextAndToolTip(btnLeft, 123, 0) ' Left SetTextAndToolTip(btnIsoSW, 127, 0) ' Iso SW SetTextAndToolTip(btnIsoSE, 129, 0) ' Iso SE SetTextAndToolTip(btnIsoNE, 131, 0) ' Iso NE SetTextAndToolTip(btnIsoNW, 133, 0) ' Iso NW SetTextAndToolTip(btnCPlane, 135, 136) ' CPlane / SetView perpendicular to current CPlane SetTextAndToolTip(chkCurveDir, 137, 0) ' CurveDir SetTextAndToolTip(chkAnalyze, 139, 0) ' Analyze SetTextAndToolTip(chkGetDist, 141, 0) ' GetDist ' CPlane TabCPlane.Text = EgtMsg(201) ' CPlane SetTextAndToolTip(btnCplaneTop, 203, 0) ' Top SetTextAndToolTip(btnCplaneFront, 205, 0) ' Front SetTextAndToolTip(btnCplaneRight, 207, 0) ' Right SetTextAndToolTip(btnCplaneBack, 209, 0) ' Back SetTextAndToolTip(btnCplaneLeft, 211, 0) ' Left SetTextAndToolTip(btnCplaneBottom, 213, 0) ' Bottom SetTextAndToolTip(btnCPlaneView, 215, 216) ' View / Set CPlane perpendicular to View SetTextAndToolTip(btnCplaneElevation, 217, 218) ' Elevat / Set Cplane Elevation SetTextAndToolTip(btnCplaneOrigin, 219, 220) ' Origin / Set Cplane Origin SetTextAndToolTip(btnCplaneRotate, 221, 222) ' Rotate / Rotate Cplane
3D Rotate Cplane (Shift) SetTextAndToolTip(btnCplane3P, 223, 224) ' 3 Points / Set Cplane from 3 Points SetTextAndToolTip(btnCPlanePerpObj, 225, 226) ' PerpCrv / Set Cplane Perpendicular to Curve SetTextAndToolTip(btnCPlaneObj, 227, 228) ' Object / Set Cplane from Object 'Draw TabDraw.Text = EgtMsg(301) ' Draw SetTextAndToolTip(btnPoint, 303, 304) ' Point / Point SetTextAndToolTip(btnLine2P, 305, 306) ' Line 2P / Line : 2 Points SetTextAndToolTip(btnLinePDL, 307, 308) ' Line PDL / Line : point, direction, length SetTextAndToolTip(btnCircleCP, 309, 310) ' Circle CP / Circle : Center, Point SetTextAndToolTip(btnCircleCD, 311, 312) ' Circle CØ / Circle : Center, Diameter SetTextAndToolTip(btnArcCSE, 313, 314) ' Arc CSE / Arc : Center, Start, End SetTextAndToolTip(btnArc3P, 315, 316) ' Arc 3P / Arc : 3 Points SetTextAndToolTip(btnArcPDP, 317, 318) ' Arc SDE / Arc : Start, Direction, End SetTextAndToolTip(btnRectangle2P, 319, 320) ' Rect 2P / Rectangle : 2 Points SetTextAndToolTip(btnPolygon, 321, 322) ' Polygon / Polygon : Side with 2 Points SetTextAndToolTip(btnText, 323, 324) ' Text / Text
Advanced Text (Shift) ' Construct TabConstruct.Text = EgtMsg(401) ' Construct SetTextAndToolTip(btnPlane, 403, 404) ' Plane / Surface : between planar curves SetTextAndToolTip(btnExtrude, 405, 406) ' Extrude / Surface : curve extrusion SetTextAndToolTip(btnRevolve, 407, 408) ' Revolve / Surface : curve revolution SetTextAndToolTip(btnScrew, 409, 410) ' Screw / Surface : curve screwing SetTextAndToolTip(btnRuled, 411, 412) ' Ruled / Surface : ruled between 2 curves SetTextAndToolTip(btnMergeSurf, 413, 414) ' Merge / Merge Surfaces SetTextAndToolTip(btnInvertSurf, 415, 416) ' Flip / Flip Surface Outside ' Edit TabEdit.Text = EgtMsg(501) ' Edit SetTextAndToolTip(btnDelete, 503, 504) ' Delete Objects SetTextAndToolTip(btnChangeLayer, 505, 506) ' Change Object Layer to Current SetTextAndToolTip(btnChangeColor, 507, 508) ' Change Color
Remove Color (Shift) SetTextAndToolTip(btnInvertCurve, 509, 510) ' Invert Curve SetTextAndToolTip(btnExtendCurve, 511, 512) ' Trim or Extend Curve SetTextAndToolTip(btnBreakCurve, 513, 514) ' Break Curve
Split Curve in Pieces (Shift) SetTextAndToolTip(btnJoinCurve, 515, 516) ' Join Curves SetTextAndToolTip(btnExplodeCurve, 517, 518) ' Explode Text or Curve in Components SetTextAndToolTip(btnChangeStartCurve, 521, 522) ' Start / Change Closed Curve Start Point SetTextAndToolTip(btnSetCurveTh, 519, 520) ' Set Curve Thickness and Extrusion ' Transform TabTransform.Text = EgtMsg(601) ' Transform SetTextAndToolTip(btnMove, 603, 604) ' Move / Object Move SetTextAndToolTip(btnRotate, 605, 606) ' Rotate / Object Rotate
3D Object Rotate (Shift) SetTextAndToolTip(btnMirror, 607, 608) ' Mirror / Object Mirror
3D Object Mirror (Shift) SetTextAndToolTip(btnScale, 609, 610) ' Scale / Object Scale
3D Object Scale (Shift) SetTextAndToolTip(btnOffset, 611, 612) ' Offset / Curve Offset End Sub Private Sub SetTextAndToolTip(control As Control, nTxtMsg As Integer, nTtiMsg As Integer) If nTxtMsg > 0 Then control.Text = EgtMsg(nTxtMsg) End If If nTtiMsg > 0 Then ToolTip1.SetToolTip(control, EgtMsg(nTtiMsg)) End If End Sub '-------------------------------- Top Commands --------------------------------------------------- Private Sub btnNew_Click(sender As System.Object, e As System.EventArgs) Handles btnNew.Click m_Controller.NewProject(True) End Sub Private Sub btnOpen_Click(sender As System.Object, e As System.EventArgs) Handles btnOpen.Click If (ModifierKeys And Keys.Shift) <> Keys.Shift Then Dim sDir As String = String.Empty GetPrivateProfileString(S_GENERAL, K_LASTNGEDIR, "", sDir, m_sIniFile) m_Controller.OpenProject(sDir) Else ShowMenuMruFiles(btnOpen, New Point(0, btnOpen.Height)) End If 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(S_GENERAL, K_LASTNGEDIR, "", sDir, m_sIniFile) m_Controller.InsertProject(sDir) End Sub Private Sub btnSave_Click(sender As System.Object, e As System.EventArgs) Handles btnSave.Click Dim nType As NGE = GetPrivateProfileInt(S_GEOMDB, K_SAVETYPE, NGE.CMPTEXT, m_sIniFile) If Not String.IsNullOrWhiteSpace(m_Controller.GetCurrFile()) Then m_Controller.SaveProject(nType) Else Dim sFile As String = String.Empty GetPrivateProfileString(S_GENERAL, K_LASTNGEDIR, "", sFile, m_sIniFile) sFile.TrimEnd("\"c) sFile += "\New" & m_nInstance.ToString() & ".nge" m_Controller.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(S_GEOMDB, K_SAVETYPE, NGE.CMPTEXT, m_sIniFile) Dim sFile As String = m_Controller.GetCurrFile() If String.IsNullOrWhiteSpace(sFile) Then GetPrivateProfileString(S_GENERAL, K_LASTNGEDIR, "", sFile, m_sIniFile) sFile.TrimEnd("\"c) sFile += "\New" & m_nInstance.ToString() & ".nge" End If m_Controller.SaveAsProject(sFile, nType) End Sub Private Sub btnImport_Click(sender As System.Object, e As System.EventArgs) Handles btnImport.Click Dim sDir As String = String.Empty GetPrivateProfileString(S_GENERAL, K_LASTIMPDIR, "", sDir, m_sIniFile) m_Controller.ImportProject(sDir) End Sub Private Sub btnExport_Click(sender As System.Object, e As System.EventArgs) Handles btnExport.Click m_Controller.ExportProject(Path.ChangeExtension(m_Controller.GetCurrFile(), "dxf")) End Sub Private Sub btnExec_Click(sender As System.Object, e As System.EventArgs) Handles btnExec.Click If (ModifierKeys And Keys.Shift) <> Keys.Shift Then Dim sDir As String = String.Empty GetPrivateProfileString(S_GENERAL, K_LASTLUADIR, "", sDir, m_sIniFile) m_Controller.Exec(sDir) Else ShowMenuMruScripts(btnExec, New Point(0, btnExec.Height)) End If End Sub Private Sub btnWireFrame_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles btnWireFrame.CheckedChanged Scene1.WireFrame() End Sub Private Sub btnHiddenLine_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles btnHiddenLine.CheckedChanged Scene1.HiddenLine() End Sub Private Sub btnShading_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles btnShading.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 btnCplaneView_Click(sender As System.Object, e As System.EventArgs) Handles btnCPlaneView.Click m_Controller.SetLastInteger(GRID_TYPE.VIEW) 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 btnCPlanePerpObj.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 If (ModifierKeys And Keys.Control) = Keys.Control Then m_Controller.SetContinue() tsStatusOutput.Text = EgtMsg(399) ' Continue : 'L' with line, 'A' with arc End If m_Controller.ExecuteCommand(CMD.LINE2P) End Sub Private Sub btnLinePDL_Click(sender As System.Object, e As System.EventArgs) Handles btnLinePDL.Click If (ModifierKeys And Keys.Shift) <> Keys.Shift Then m_Controller.ExecuteCommand(CMD.LINEPDL) Else m_Controller.ExecuteCommand(CMD.LINEPVL) End If 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 If (ModifierKeys And Keys.Shift) <> Keys.Shift Then If (ModifierKeys And Keys.Control) = Keys.Control Then m_Controller.SetContinue() tsStatusOutput.Text = EgtMsg(399) ' Continue : 'L' with line, 'A' with arc End If m_Controller.ExecuteCommand(CMD.ARCPDP) Else m_Controller.ExecuteCommand(CMD.ARCPVP) End If 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 btnPolygon_Click(sender As System.Object, e As System.EventArgs) Handles btnPolygon.Click If (ModifierKeys And Keys.Shift) <> Keys.Shift Then m_Controller.ExecuteCommand(CMD.POLYGON) Else m_Controller.ExecuteCommand(CMD.POLYGONSIDE) End If 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 m_Controller.ExecuteCommand(CMD.REVOLVE) End Sub Private Sub btnScrew_Click(sender As System.Object, e As System.EventArgs) Handles btnScrew.Click m_Controller.ExecuteCommand(CMD.SCREW) 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 btnMergeSurf_Click(sender As System.Object, e As System.EventArgs) Handles btnMergeSurf.Click m_Controller.ExecuteCommand(CMD.MERGESURF) 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 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.Control) = Keys.Control Then m_Controller.ExecuteCommand(CMD.CHANGEALPHA) ElseIf (ModifierKeys And Keys.Shift) = Keys.Shift Then m_Controller.ExecuteCommand(CMD.RESETCOLOR) Else m_Controller.ExecuteCommand(CMD.CHANGECOLOR) 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 btnChangeStart_Click(sender As System.Object, e As System.EventArgs) Handles btnChangeStartCurve.Click m_Controller.ExecuteCommand(CMD.CHANGESTARTCURVE) 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 If (ModifierKeys And Keys.Shift) <> Keys.Shift Then m_Controller.ExecuteCommand(CMD.BREAKCURVE) Else m_Controller.ExecuteCommand(CMD.SPLITCURVE) End If 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 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() ' con SPAZIO ripeto l'ultimo comando ElseIf e.KeyData = Keys.Space Then m_Controller.RepeatLastCommand() ' Se in modalità continuazione ElseIf m_Controller.GetContinue() Then ' Con 'A' forzo il passaggio ad arco If e.KeyData = Keys.A Then m_Controller.ContinueArcPDP() ' Con 'L' forzo il passaggio a retta ElseIf e.KeyData = Keys.L Then m_Controller.ContinueLine2P() End If ' Se in acquisizione punto Else 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) 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() Scene1.Focus() End Sub Private Function SetInputBoxText(ByVal sVal As String) As Boolean InputText.Text = sVal InputText.Focus() 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" & m_nInstance.ToString() 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 = EgtMsg(1102) 'Sketch Point Case SP.PT_GRID tsStatusSnapPointType.Text = EgtMsg(1104) 'Grid Point Case SP.PT_END tsStatusSnapPointType.Text = EgtMsg(1106) 'End Point Case SP.PT_MID tsStatusSnapPointType.Text = EgtMsg(1108) 'Mid Point Case SP.CENTER tsStatusSnapPointType.Text = EgtMsg(1110) 'Center Case SP.CENTROID tsStatusSnapPointType.Text = EgtMsg(1112) 'Centroid Case SP.PT_NEAR tsStatusSnapPointType.Text = EgtMsg(1114) 'Near Point" Case SP.PT_INTERS tsStatusSnapPointType.Text = EgtMsg(1116) 'Inters Point Case SP.PT_TANGENT tsStatusSnapPointType.Text = EgtMsg(1118) 'Tang Point Case SP.PT_PERPENDICULAR tsStatusSnapPointType.Text = EgtMsg(1120) 'Perp Point Case SP.PT_MINDIST tsStatusSnapPointType.Text = EgtMsg(1122) '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 '-------------------------------- MRU Files Menu ------------------------------------------------- Private Sub ShowMenuMruFiles(ByVal control As Control, ByVal Pos As Point) Dim sFileName As String = String.Empty For Each Item As ToolStripItem In ContextMenuMruFiles.Items Dim nInd As Integer If Item.Name = "MruTitle" Then Item.Text = EgtMsg(19) ' Recent files Item.Visible = True ElseIf Item.Name = "MruSep" Then Item.Visible = True ElseIf Int32.TryParse(Item.Name.Replace("MruFile", ""), nInd) AndAlso m_MruFiles.GetFileName(nInd, sFileName) Then Item.Text = sFileName Item.Visible = True Else Item.Visible = False End If Next ContextMenuMruFiles.Show(control, Pos) End Sub Private Sub OnMenuMruFiles_ItemClick(sender As Object, e As ToolStripItemClickedEventArgs) Handles ContextMenuMruFiles.ItemClicked If e.ClickedItem.Text <> "" Then m_Controller.OpenProject(e.ClickedItem.Text, False) End If End Sub '-------------------------------- MRU Scripts Menu ----------------------------------------------- Private Sub ShowMenuMruScripts(ByVal control As Control, ByVal Pos As Point) Dim sFileName As String = String.Empty For Each Item As ToolStripItem In ContextMenuMruScripts.Items Dim nInd As Integer If Item.Name = "MruSTitle" Then Item.Text = EgtMsg(20) ' Recent scripts Item.Visible = True ElseIf Item.Name = "MruSSep" Then Item.Visible = True ElseIf Int32.TryParse(Item.Name.Replace("MruSFile", ""), nInd) AndAlso m_MruScripts.GetFileName(nInd, sFileName) Then Item.Text = sFileName Item.Visible = True Else Item.Visible = False End If Next ContextMenuMruScripts.Show(control, Pos) End Sub Private Sub OnMenuMruScripts_ItemClick(sender As Object, e As ToolStripItemClickedEventArgs) Handles ContextMenuMruScripts.ItemClicked If e.ClickedItem.Text <> "" Then ContextMenuMruScripts.Close() m_Controller.Exec(e.ClickedItem.Text, False) End If End Sub End Class