Files
TestEIn/Form1.vb
T
Dario Sassi 3eb7aedd9e TestEIn 1.5j3 :
- unificati Scene, EgtInterface e GenInterface con EgtUILib
- modifiche a gestione mouse in Scene
- aggiunte funzioni in EgtInterface.
2014-10-15 08:03:07 +00:00

512 lines
20 KiB
VB.net

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
'Title
Me.Text = "EgalTech TestEIn"
'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 colori sfondo
Dim nTopRed As Integer = 192
Dim nTopGreen As Integer = 192
Dim nTopBlue As Integer = 192
GetPrivateProfileColor("Scene", "BackTop", nTopRed, nTopGreen, nTopBlue, m_sIniFile)
Dim nBotRed As Integer = 192
Dim nBotGreen As Integer = 192
Dim nBotBlue As Integer = 192
GetPrivateProfileColor("Scene", "BackBottom", nBotRed, nBotGreen, nBotBlue, m_sIniFile)
Scene1.SetViewBackground(nTopRed, nTopGreen, nTopBlue, nBotRed, nBotGreen, nBotBlue)
' inizializzo scena
Scene1.Init()
rbtShading.Checked = True
m_nOldIdTree = GDB_ID_NULL
' aggiungo voce per about box nel menù di sistema
Dim hSysMenu As IntPtr = GetSystemMenu(Handle, False)
If hSysMenu <> IntPtr.Zero Then
AppendMenu(hSysMenu, MF_SEPARATOR, 0, "")
AppendMenu(hSysMenu, MF_STRING, IDM_ABOUTBOX, "About TestEIn...")
End If
'Posizione e dimensioni del Form
If ModifierKeys <> Keys.Shift Then
Dim nFlag As Integer
Dim nLeft As Integer
Dim nTop As Integer
Dim nWidth As Integer
Dim nHeight As Integer
GetPrivateProfileWinPos("General", "WinPlace", nFlag, nLeft, nTop, nWidth, nHeight, m_sIniFile)
Me.StartPosition = System.Windows.Forms.FormStartPosition.Manual
Me.Location = New Point(nLeft, nTop)
Me.Size = New Size(nWidth, nHeight)
WindowState = IIf(nFlag = 1, FormWindowState.Maximized, FormWindowState.Normal)
End If
End Sub
Private Sub Form1_FormClosing(sender As System.Object, e As FormClosingEventArgs) Handles MyBase.FormClosing
'Salvo posizione Form
Dim nFlag As Integer = IIf(Me.WindowState = FormWindowState.Maximized, 1, 0)
WritePrivateProfileWinPos("General", "WinPlace", nFlag, Me.Left, Me.Top, Me.Width, Me.Height, m_sIniFile)
'Terminazione generale di EgtInterface
EgtExit()
End Sub
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
MyBase.WndProc(m)
If m.Msg = WM_SYSCOMMAND Then
If m.WParam.ToInt32 = IDM_ABOUTBOX Then
AboutBox1.ShowDialog()
End If
End If
End Sub
'-------------------------------- Events management ----------------------------------------------
Private Sub OnCursorPos(ByVal sender As Object, ByVal sCursorPos As String) Handles Scene1.OnCursorPos
ToolStripStatusCursorPos.Text = sCursorPos
End Sub
Private Sub OnMouseSelected(ByVal sender As Object, ByVal nId As Integer) Handles Scene1.OnMouseSelected
If EgtIsSelectedObj(Scene1.GetCtx(), nId) Then
EgtDeselectObj(Scene1.GetCtx(), nId)
Else
EgtSelectObj(Scene1.GetCtx(), nId)
End If
EgtDraw(Scene1.GetCtx())
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
Me.Text = "EgalTech TestEIn"
ClearObjTree()
End Sub
Private Sub OnOpeningProject(ByVal sender As Object) Handles Scene1.OnOpeningProject
ClearObjTree()
End Sub
Private Sub OnOpenProject(ByVal sender As Object, ByVal sFile As String) Handles Scene1.OnOpenProject
m_sCurrFile = sFile
Me.Text = Path.GetFileName(m_sCurrFile) & " - EgalTech TestEIn"
LoadObjTree()
End Sub
Private Sub OnSavingProject(ByVal sender As Object, ByVal sFile As String) Handles Scene1.OnSavingProject
m_sCurrFile = sFile
Me.Text = Path.GetFileName(m_sCurrFile) & " - EgalTech TestEIn"
' ripristino stato eventuale oggetto marcato
m_nMarkObj = RevertOldIdInObjTree()
End Sub
Private Sub OnSavedProject(ByVal sender As Object) Handles Scene1.OnSavedProject
' 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
m_sCurrFile = Path.ChangeExtension(sFile, "nge")
Me.Text = Path.GetFileName(m_sCurrFile) & " - EgalTech TestEIn"
LoadObjTree()
End Sub
Private Sub OnExportingProject(ByVal sender As Object, ByVal sFile As String) Handles Scene1.OnExportingProject
' 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
ClearObjTree()
End Sub
Private Sub OnExecutedScript(ByVal sender As Object) Handles Scene1.OnExecutedScript
LoadObjTree()
End Sub
'-------------------------------- Buttons --------------------------------------------------------
Private Sub btnNew_Click(sender As System.Object, e As System.EventArgs) Handles btnNew.Click
Scene1.NewProject()
End Sub
Private Sub btnOpen_Click(sender As System.Object, e As System.EventArgs) Handles btnOpen.Click
Scene1.OpenProject()
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 btnImport_Click(sender As System.Object, e As System.EventArgs) Handles btnImport.Click
Scene1.ImportProject()
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
Scene1.Exec()
End Sub
Private Sub rbtWireFrame_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles rbtWireFrame.CheckedChanged
EgtSetShowMode(Scene1.GetCtx(), SM_WIREFRAME)
End Sub
Private Sub rbtHiddenLine_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles rbtHiddenLine.CheckedChanged
EgtSetShowMode(Scene1.GetCtx(), SM_HIDDENLINE)
End Sub
Private Sub rbtShading_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles rbtShading.CheckedChanged
EgtSetShowMode(Scene1.GetCtx(), SM_SHADING)
End Sub
Private Sub chkCurveDir_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles chkCurveDir.CheckedChanged
EgtSetShowCurveDirection(Scene1.GetCtx(), chkCurveDir.Checked)
End Sub
Private Sub chkAnalyze_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles chkAnalyze.CheckedChanged
If chkAnalyze.Checked Then
chkGetDist.Checked = False
Scene1.SetStatusAnalyze()
Else
Scene1.ResetStatusAnalyze()
SelectIdInObjTree(GDB_ID_NULL)
End If
End Sub
Private Sub chkGetDist_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles chkGetDist.CheckedChanged
If chkGetDist.Checked Then
chkAnalyze.Checked = False
Scene1.SetStatusGetDistance()
ToolStripStatusOutput.Text = " "
Else
Scene1.ResetStatusGetDistance()
EgtResetGeoLine(Scene1.GetCtx())
ToolStripStatusOutput.Text = " "
End If
End Sub
Private Sub btnZoomAll_Click(sender As System.Object, e As System.EventArgs) Handles btnZoomAll.Click
EgtZoom(Scene1.GetCtx, ZM_ALL)
End Sub
Private Sub btnZoomIn_Click(sender As System.Object, e As System.EventArgs) Handles btnZoomIn.Click
EgtZoom(Scene1.GetCtx, ZM_IN)
End Sub
Private Sub btnZoomOut_Click(sender As System.Object, e As System.EventArgs) Handles btnZoomOut.Click
EgtZoom(Scene1.GetCtx, ZM_OUT)
End Sub
Private Sub btnTop_Click(sender As System.Object, e As System.EventArgs) Handles btnTop.Click
EgtSetView(Scene1.GetCtx, CT_TOP)
End Sub
Private Sub btnFront_Click(sender As System.Object, e As System.EventArgs) Handles btnFront.Click
EgtSetView(Scene1.GetCtx, CT_FRONT)
End Sub
Private Sub btnLeft_Click(sender As System.Object, e As System.EventArgs) Handles btnLeft.Click
EgtSetView(Scene1.GetCtx, CT_LEFT)
End Sub
Private Sub btnBack_Click(sender As System.Object, e As System.EventArgs) Handles btnBack.Click
EgtSetView(Scene1.GetCtx, CT_BACK)
End Sub
Private Sub btnRight_Click(sender As System.Object, e As System.EventArgs) Handles btnRight.Click
EgtSetView(Scene1.GetCtx, CT_RIGHT)
End Sub
Private Sub btnIso_Click(sender As System.Object, e As System.EventArgs) Handles btnIso.Click
EgtSetView(Scene1.GetCtx, CT_ISO_SW)
End Sub
Private Sub btnRotP90_Click(sender As System.Object, e As System.EventArgs) Handles btnRotP90.Click
Rotate(Scene1.GetCtx(), 90)
' aggiorno visualizzazione
EgtZoom(Scene1.GetCtx(), ZM_ALL)
UpdateObjInObjTree(m_nOldIdTree)
End Sub
Private Sub btnRotM90_Click(sender As System.Object, e As System.EventArgs) Handles btnRotM90.Click
Rotate(Scene1.GetCtx(), -90)
' aggiorno visualizzazione
EgtZoom(Scene1.GetCtx(), ZM_ALL)
UpdateObjInObjTree(m_nOldIdTree)
End Sub
Private Sub Rotate(ByVal nCtx As Integer, ByVal dAngRotDeg As Double)
' indice del primo gruppo sotto la radice
Dim nId As Integer = EgtGetFirstInGroup(nCtx, GDB_ID_ROOT)
' recupero il box del gruppo in globale
Dim PtMinPre As New Point3d
Dim PtMaxPre As New Point3d
EgtGetBBoxGlob(nCtx, nId, BBF_IGNORE_TEXT, PtMinPre, PtMaxPre)
' ruoto attorno al punto minimo
EgtRotateGlob(nCtx, nId, PtMinPre, Vector3d.Z_AX, dAngRotDeg)
' calcolo nuovo box in globale
Dim PtMinPost As New Point3d
Dim PtMaxPost As New Point3d
EgtGetBBoxGlob(nCtx, nId, BBF_IGNORE_TEXT, PtMinPost, PtMaxPost)
' eseguo traslazione per riavere lo stesso punto minimo
Dim VtMove As Vector3d = Vector3d.FromPointDiff(PtMinPre, PtMinPost)
EgtMoveGlob(nCtx, nId, VtMove)
End Sub
Private Sub btnMirror_Click(sender As System.Object, e As System.EventArgs) Handles btnMirror.Click
' indice del primo gruppo sotto la radice
Dim nId As Integer = EgtGetFirstInGroup(Scene1.GetCtx(), GDB_ID_ROOT)
' recupero il box del gruppo in globale
Dim PtMin As New Point3d
Dim PtMax As New Point3d
EgtGetBBoxGlob(Scene1.GetCtx(), nId, BBF_IGNORE_TEXT, PtMin, PtMax)
Dim PtCen As Point3d = Point3d.Media(PtMin, PtMax)
' mirror rispetto a Y centrato nel box
EgtMirrorGlob(Scene1.GetCtx(), nId, PtCen, Vector3d.X_AX)
' sistemo gli eventuali testi
UnMirrorTexts(Scene1.GetCtx(), nId)
' aggiorno visualizzazione
EgtZoom(Scene1.GetCtx(), ZM_ALL)
UpdateObjInObjTree(m_nOldIdTree)
End Sub
Private Sub UnMirrorTexts(ByVal nCtx As Integer, ByVal nGroupId As Integer)
Dim nId As Integer = EgtGetFirstInGroup(nCtx, nGroupId)
While nId <> GDB_ID_NULL
'recupero il tipo di oggetto
Dim nType As Integer = EgtGetType(nCtx, nId)
'se gruppo
If nType = TY_GROUP Then
UnMirrorTexts(nCtx, nId)
' se testo
ElseIf nType = TY_EXT_TEXT Then
EgtMirrorText(nCtx, nId, True)
End If
' passo al successivo
nId = EgtGetNext(nCtx, nId)
End While
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(Scene1.GetCtx, sCmd) Then
Scene1.Invalidate()
ToolStripStatusOnR.Text = " "
Else
ToolStripStatusOnR.Text = "Error executing command"
End If
' ricarico albero degli oggetti
LoadObjTree()
SelectIdInObjTree(nIdOld)
End If
End If
End Sub
'-------------------------------- Tree View ------------------------------------------------------
Private m_nOldIdTree As Integer
Private Sub LoadObjTree()
ClearObjTree()
TreeView1.BeginUpdate()
TreeView1.Nodes.Add(GDB_ID_NULL.ToString, "No Selection", 0, 0)
AddGroupInObjTree(GDB_ID_ROOT, TreeView1.Nodes)
TreeView1.EndUpdate()
End Sub
Private Sub ClearObjTree()
RevertOldIdInObjTree()
TreeView1.Nodes.Clear()
End Sub
Private Sub AddGroupInObjTree(ByVal nGroupId As Integer, ByRef PrevNodColl As TreeNodeCollection)
Dim CurrNodColl As TreeNodeCollection
If nGroupId = GDB_ID_ROOT Then
CurrNodColl = PrevNodColl
Else
Dim sName As String = String.Empty
Dim sText As String = String.Empty
If EgtGetName(Scene1.GetCtx, nGroupId, sName) Then
sText = sName + " (Group " + nGroupId.ToString + ")"
Else
sText = "Group " + nGroupId.ToString
End If
Dim nImage As Integer = TypeToImageInObjTree(TY_GROUP)
CurrNodColl = PrevNodColl.Add(nGroupId.ToString, sText, nImage, nImage).Nodes
End If
Dim nObjs As Integer = EgtGetGroupObjs(Scene1.GetCtx(), nGroupId)
If (nObjs > 20000) Then
CurrNodColl.Add("-1", "Too many entities")
Return
End If
Dim nId As Integer = EgtGetFirstInGroup(Scene1.GetCtx, nGroupId)
While nId <> GDB_ID_NULL
'recupero il tipo di nodo
Dim nType As Integer = EgtGetType(Scene1.GetCtx, nId)
'se gruppo
If nType = TY_GROUP Then
AddGroupInObjTree(nId, CurrNodColl)
'se oggetto geometrico
ElseIf nType >= TY_GEO_VECTOR Then
Dim sTitle As String = String.Empty
EgtGetTitle(Scene1.GetCtx, nId, sTitle)
Dim sName As String = String.Empty
Dim sText As String = String.Empty
If EgtGetName(Scene1.GetCtx, nId, sName) Then
sText = sName + " (" + sTitle + " " + nId.ToString + ")"
Else
sText = sTitle + " " + nId.ToString
End If
Dim nImage As Integer = TypeToImageInObjTree(nType)
CurrNodColl.Add(nId.ToString, sText, nImage, nImage)
End If
'passo al successivo
nId = EgtGetNext(Scene1.GetCtx, nId)
End While
End Sub
Private Function TypeToImageInObjTree(ByVal nType As Integer) As Integer
Select Case nType
Case TY_GROUP
Return 2
Case TY_GEO_VECTOR
Return 3
Case TY_GEO_POINT
Return 4
Case TY_GEO_FRAME
Return 5
Case TY_CRV_LINE
Return 6
Case TY_CRV_ARC
Return 7
Case TY_CRV_BEZ
Return 8
Case TY_CRV_COMPO
Return 9
Case TY_SRF_MESH
Return 10
Case TY_EXT_TEXT
Return 11
End Select
Return 1
End Function
Private Sub ObjTree_AfterSelect(ByVal sender As Object, ByVal e As TreeViewEventArgs) Handles TreeView1.AfterSelect
' recupero l'Id del nuovo oggetto selezionato
Dim nId As Integer
If Not Int32.TryParse(e.Node.Name, nId) Then
Return
End If
UpdateObjInObjTree(nId)
End Sub
Private Sub UpdateObjInObjTree(ByVal nId As Integer)
' ripristino eventuale vecchio oggetto selezionato
RevertOldIdInObjTree()
' recupero il tipo del nuovo oggetto
Dim nType As Integer = EgtGetType(Scene1.GetCtx, 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(Scene1.GetCtx, nId, sDump) Then
tBoxInfo.Text = sDump
Else
tBoxInfo.Text = String.Empty
End If
Else
If EgtGeoObjDump(Scene1.GetCtx, 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(Scene1.GetCtx, nId, nOldMode)
Dim nMode As Integer = IIf((nOldMode = GDB_MD_HIDDEN), GDB_MD_STD, nOldMode)
EgtSetMode(Scene1.GetCtx, nId, nMode)
Dim nOldStatus As Integer = GDB_ST_ON
EgtGetStatus(Scene1.GetCtx, nId, nOldStatus)
Dim nStat As Integer = IIf((nOldStatus = GDB_ST_OFF), GDB_ST_ON, nOldStatus)
EgtSetStatus(Scene1.GetCtx, nId, nStat)
EgtSetMark(Scene1.GetCtx, nId)
m_nOldIdTree = nId
' imposto il ridisegno della scena
Scene1.Invalidate()
End Sub
Private Function RevertOldIdInObjTree() As Integer
' salvo il vecchio Id
Dim nOldId As Integer = m_nOldIdTree
' se non nullo...
If EgtExistsObj(Scene1.GetCtx, m_nOldIdTree) Then
' ripristino il modo e lo stato precedente dell'oggetto e lo smarco
EgtRevertMode(Scene1.GetCtx, m_nOldIdTree)
EgtRevertStatus(Scene1.GetCtx, m_nOldIdTree)
EgtResetMark(Scene1.GetCtx, m_nOldIdTree)
' annullo oggetto da ripristinare
m_nOldIdTree = GDB_ID_NULL
End If
Return nOldId
End Function
Private Function SelectIdInObjTree(ByVal nId As Integer) As Boolean
Dim tNode() As TreeNode = TreeView1.Nodes.Find(nId.ToString, True)
If tNode.Length > 0 Then
TreeView1.SelectedNode = tNode(0)
Return True
Else
Return False
End If
End Function
End Class