'---------------------------------------------------------------------------- ' EgalTech 2015-2015 '---------------------------------------------------------------------------- ' File : Component.vb Data : 09.07.15 Versione : 1.6g3 ' Contenuto : Classe Component (dialogo esecuzione componente parametrico). ' ' ' ' Modifiche : 08.07.15 DS Creazione modulo. ' ' '---------------------------------------------------------------------------- Imports System.Globalization Imports TestEIn.EgtInterface Imports TestEIn.Scene Public Class Component ' Constants Private Const NUM_VAR As Integer = 10 Private Const LUA_CMP_VARS As String = "CMP" Private Const LUA_CMP_DRAW As String = "CMP_Draw" Private Const INFO_VAR As String = "Var" ' Properties Private m_sCompoDir As String = String.Empty Private m_sCompoName As String = String.Empty Private m_CVars(NUM_VAR - 1) As CompoVar Private m_bDrawOk As Boolean = False Private Sub Component_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load ' imposto colore di default Dim DefColor As New Color3d(0, 0, 0) GetPrivateProfileColor(S_GEOMDB, K_DEFAULTCOLOR, DefColor, Form1.GetIniFile()) Scene2.SetDefaultMaterial(DefColor) ' imposto colori sfondo Dim BackTopColor As New Color3d(192, 192, 192) GetPrivateProfileColor(S_SCENE, K_BACKTOP, BackTopColor, Form1.GetIniFile()) Dim BackBotColor As New Color3d(BackTopColor) GetPrivateProfileColor(S_SCENE, K_BACKBOTTOM, BackBotColor, Form1.GetIniFile()) Scene2.SetViewBackground(BackTopColor, BackBotColor) ' imposto colore di evidenziazione Dim MarkColor As New Color3d(255, 255, 0) GetPrivateProfileColor(S_SCENE, K_MARK, MarkColor, Form1.GetIniFile()) Scene2.SetMarkMaterial(MarkColor) ' imposto colore per superfici selezionate Dim SelSurfColor As New Color3d(255, 255, 192) GetPrivateProfileColor(S_SCENE, K_SELSURF, SelSurfColor, Form1.GetIniFile()) Scene2.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, Form1.GetIniFile()) Scene2.SetZoomWinAttribs(bOutline, ZwColor) ' imposto colore della linea di distanza Dim DstLnColor As New Color3d(255, 0, 0) GetPrivateProfileColor(S_SCENE, K_DISTLINE, DstLnColor, Form1.GetIniFile()) Scene2.SetDistLineMaterial(DstLnColor) ' imposto parametri OpenGL Dim nDriver As Integer = GetPrivateProfileInt(S_OPENGL, K_DRIVER, 3, Form1.GetIniFile()) Dim b2Buff As Boolean = (GetPrivateProfileInt(S_OPENGL, K_DOUBLEBUFFER, 1, Form1.GetIniFile()) <> 0) Dim nColorBits As Integer = GetPrivateProfileInt(S_OPENGL, K_COLORBITS, 32, Form1.GetIniFile()) Dim nDepthBits As Integer = GetPrivateProfileInt(S_OPENGL, K_DEPTHBITS, 32, Form1.GetIniFile()) Scene2.SetViewAttributes(nDriver, b2Buff, nColorBits, nDepthBits) ' inizializzo la scena (DB geometrico + visualizzazione) Scene2.Init() ' inibisco selezione diretta da Scene Scene2.SetStatusNull() ' assegno posizione e dimensioni finestra Dim nFlag As Integer Dim nLeft As Integer Dim nTop As Integer Dim nWidth As Integer Dim nHeight As Integer GetPrivateProfileWinPos(S_COMPO, K_CMPWINPLACE, nFlag, nLeft, nTop, nWidth, nHeight, Form1.GetIniFile()) Dim PtTL = New Point(nLeft, nTop) Dim s As Screen = Screen.FromPoint(PtTL) If s.Bounds.Contains(PtTL) Then Me.StartPosition = System.Windows.Forms.FormStartPosition.Manual Me.Location = New Point(nLeft, nTop) Me.Size = New Size(nWidth, nHeight) WindowState = If(nFlag = 1, FormWindowState.Maximized, FormWindowState.Normal) End If ' leggo direttorio componenti GetPrivateProfileString(S_COMPO, K_COMPODIR, "", m_sCompoDir, Form1.GetIniFile()) ' recupero i file lua del direttorio e li inserisco nella lista dei componenti Dim DirInfo As New IO.DirectoryInfo(m_sCompoDir) If Not DirInfo.Exists Then EgtOutLog("Error : CompoDir does not exist") Return End If Dim vFi As IO.FileInfo() = DirInfo.GetFiles("*.lua") Dim Fi As IO.FileInfo For Each Fi In vFi ListBox1.Items.Add(IO.Path.GetFileNameWithoutExtension(Fi.Name)) Next If ListBox1.Items.Count = 0 Then EgtOutLog("Error : CompoDir empty (missing lua files)") Return End If ' Imposto selezione sul primo -> viene caricato il relativo componente ListBox1.SelectedIndex = 0 End Sub Private Sub Component_FormClosing(sender As System.Object, e As FormClosingEventArgs) Handles MyBase.FormClosing ' Salvo posizione finestra Dim nFlag As Integer = If(Me.WindowState = FormWindowState.Maximized, 1, 0) WritePrivateProfileWinPos(S_COMPO, K_CMPWINPLACE, nFlag, Me.Left, Me.Top, Me.Width, Me.Height, Form1.GetIniFile()) ' Pulisco l'ambiente lua ResetLuaVariables() ' Termino la scena (DB geometrico + visualizzazione) Scene2.Terminate() End Sub Private Sub Component_KeyDown(ByVal sender As System.Object, ByVal e As KeyEventArgs) Handles Me.KeyDown If e.KeyData = Keys.Escape Then Me.DialogResult = System.Windows.Forms.DialogResult.Cancel Me.Close() End If End Sub Private Sub ListBox1_SelectedIndexChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles ListBox1.SelectedIndexChanged ' Recupero item selezionato Dim sCompo As String = ListBox1.SelectedItem.ToString() ' Carico componente LoadCurrentCompo(sCompo) End Sub Private Sub LoadCurrentCompo(ByVal sCompo As String) ' Verifico se cambiato If sCompo = m_sCompoName Then Return End If m_sCompoName = sCompo ' Pulisco l'ambiente lua ResetLuaVariables() ' Carico il file ed eseguo in modalità anteprima Dim bOk As Boolean = ExecCompoFile() Dim sMsg As String = String.Empty bOk = bOk AndAlso MakePreview(sMsg) If Not bOk Then EgtNewFile() End If tbMsg.Text = sMsg tbMsg.BackColor = If(m_bDrawOk, Color.White, Color.Tomato) Scene2.ZoomAll() ' leggo variabili e aggiorno griglia ReadAndShowVariables() ' abilito bottoni Vista e Inserisci btnView.Enabled = True btnInsert.Enabled = True ' un pezzo da inserire tbNbr.Text = "1" End Sub Private Sub btnView_Click(sender As Object, e As EventArgs) Handles btnView.Click ' aggiorno le variabili dalla griglia UpdateVariables() ' ricalcolo il disegno Dim sMsg As String = String.Empty MakePreview(sMsg) tbMsg.Text = sMsg tbMsg.BackColor = If(m_bDrawOk, Color.White, Color.Tomato) ' aggiorno visualizzazione EgtSetView(VT.TOP, False) EgtZoom(ZM.ALL) End Sub Private Sub btnInsert_Click(sender As Object, e As EventArgs) Handles btnInsert.Click ' aggiorno visualizzazione btnView_Click(sender, e) ' se errore esco If Not m_bDrawOk Then Return End If ' Leggo numero di pezzi da inserire Dim InsNbr As Integer = tbNbr.Text ' Passo al contesto principale EgtSetCurrentContext(Form1.GetCtx()) ' Inserisco il componente nel DB geometrico principale MakeInsert(InsNbr) ' Aggiorno ambiente principale EgtZoom(ZM.ALL) Form1.LoadObjTree() ' Chiudo il dialogo Me.DialogResult = System.Windows.Forms.DialogResult.OK Me.Close() End Sub Protected Sub OnMouseDownScene(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles Scene2.OnMouseDownScene ' Verifico se selezionata variabile EgtSetObjFilterForSelect(True, True, True, True, True) Dim nSel As Integer EgtSelect(e.Location, 2 * DIM_SEL, 2 * DIM_SEL, nSel) Dim nVarInd As Integer = 0 Dim nId As Integer = EgtGetFirstObjInSelWin() While nId <> GDB_ID.NULL If EgtGetInfo(nId, INFO_VAR, nVarInd) Then Exit While End If nId = EgtGetNextObjInSelWin() End While If nVarInd = 0 Then Return End If ' Dialogo modifica diretta variabile Dim VarInDlg As New VarInput VarInDlg.m_sVarVal = m_CVars(nVarInd - 1).ToString() VarInDlg.StartPosition = System.Windows.Forms.FormStartPosition.Manual Dim ptScreen As Point = Scene2.PointToScreen(e.Location) ptScreen.Offset(0, 0) VarInDlg.Location = ptScreen If VarInDlg.ShowDialog(Me) = System.Windows.Forms.DialogResult.Cancel Then Return End If ' Applico il nuovo valore m_CVars(nVarInd - 1).FromString(VarInDlg.m_sVarVal) GetValueEdit(nVarInd).Text = m_CVars(nVarInd - 1).ToString() m_CVars(nVarInd - 1).ToLua() ' Ricalcolo il disegno Dim sMsg As String = String.Empty MakePreview(sMsg) tbMsg.Text = sMsg tbMsg.BackColor = If(m_bDrawOk, Color.White, Color.Tomato) ' aggiorno visualizzazione EgtSetView(VT.TOP, False) EgtZoom(ZM.ALL) End Sub Private Function ExecCompoFile() As Boolean ' Costruisco path completa del componente Dim sPath = m_sCompoDir & "\" & m_sCompoName & ".lua" ' Carico il file Return EgtLuaExecFile(sPath) End Function Private Function ReadAndShowVariables() As Boolean ' Recupero nome, tipo e valore delle variabili globali For i As Integer = 1 To NUM_VAR Dim CVar = New CompoVar CVar.m_nInd = i If CVar.NameTypeValueFromLua() Then m_CVars(i - 1) = CVar Else m_CVars(i - 1) = Nothing End If Next ' Aggiorno la griglia dalle variabili For i As Integer = 1 To NUM_VAR If m_CVars(i - 1) IsNot Nothing Then GetNameEdit(i).Text = m_CVars(i - 1).m_sName GetNameEdit(i).Show() GetValueEdit(i).Text = m_CVars(i - 1).ToString() GetValueEdit(i).Show() Else GetNameEdit(i).Hide() GetValueEdit(i).Hide() End If Next Return True End Function Private Function UpdateVariables() As Boolean ' aggiorno le variabili For i As Integer = 1 To NUM_VAR If m_CVars(i - 1) IsNot Nothing Then ' interpreto il valore, se non riesco ripristino default If Not m_CVars(i - 1).FromString(GetValueEdit(i).Text) Then GetValueEdit(i).Text = m_CVars(i - 1).ToString() End If ' aggiorno la corrispondente variabile lua If Not m_CVars(i - 1).ToLua() Then Dim sErr As String = String.Empty EgtLuaGetLastError(sErr) EgtOutLog(sErr) End If End If Next Return True End Function Private Function ResetLuaVariables() As Boolean EgtLuaResetGlobVar(LUA_CMP_VARS) EgtLuaResetGlobVar(LUA_CMP_DRAW) Return False End Function Private Function MakePreview(ByRef sMsg As String) As Boolean If Not EgtLuaExecLine(LUA_CMP_DRAW & "(true)") Then sMsg = "Error in component execution" m_bDrawOk = False Else EgtLuaGetGlobStringVar(LUA_CMP_VARS & ".MSG", sMsg) Dim nErr As Integer = 0 EgtLuaGetGlobIntVar(LUA_CMP_VARS & ".ERR", nErr) m_bDrawOk = (nErr = 0) End If Return m_bDrawOk End Function Private Function MakeInsert(ByVal nNbr As Integer) As Boolean ' abilito registrazione EgtEnableCommandLogger() ' ricarico componente corrente ExecCompoFile() ' aggiorno variabili UpdateVariables() ' elimino eventuali precedenti pezzi vuoti EgtEraseEmptyParts() ' eseguo inserimento For i As Integer = 1 To nNbr ' Inserisco il componente If Not EgtLuaExecLine(LUA_CMP_DRAW & "(false)") Then Dim sErr As String = String.Empty EgtLuaGetLastError(sErr) EgtOutLog(sErr) Exit For End If ' Ne recupero l'Id Dim nId2 As Integer = EgtGetLastPart() ' Lo posiziono in ordine EgtPackBox(nId2, 0, 0, PACK_MAX_X, PACK_MAX_Y, PACK_OFFS, True) Next ' disabilito registrazione EgtDisableCommandLogger() Return True End Function Private Function GetNameEdit(ByVal nInd As Integer) As TextBox Select Case nInd Case 1 Return tbName1 Case 2 Return tbName2 Case 3 Return tbName3 Case 4 Return tbName4 Case 5 Return tbName5 Case 6 Return tbName6 Case 7 Return tbName7 Case 8 Return tbName8 Case 9 Return tbName9 Case Else Return tbName10 End Select End Function Private Function GetValueEdit(ByVal nInd As Integer) As TextBox Select Case nInd Case 1 Return tbValue1 Case 2 Return tbValue2 Case 3 Return tbValue3 Case 4 Return tbValue4 Case 5 Return tbValue5 Case 6 Return tbValue6 Case 7 Return tbValue7 Case 8 Return tbValue8 Case 9 Return tbValue9 Case Else Return tbValue10 End Select End Function ' --------------------------------------------------------------------------- Private Class CompoVar ' Public Members Public m_nInd As Integer Public m_sName As String Public m_nType As Integer Public m_bVal As Boolean Public m_nVal As Integer Public m_dVal As Double Public m_sVal As String ' Constants Const LUA_NAME As String = LUA_CMP_VARS & ".N" Const LUA_TYPE As String = LUA_CMP_VARS & ".T" Const LUA_VALUE As String = LUA_CMP_VARS & ".V" Public Sub New() m_nInd = 0 m_nType = 0 End Sub Public Overrides Function ToString() As String Select Case m_nType Case 1 ' booleano Return m_bVal.ToString() Case 2 ' intero Return m_nVal.ToString() Case 3 ' lunghezza Return EgtToUiUnits(m_dVal).ToString("F4", CultureInfo.InvariantCulture) Case 4 ' double Return m_dVal.ToString("F4", CultureInfo.InvariantCulture) Case 5 ' stringa Return m_sVal End Select Return "" End Function Public Function FromString(ByVal sVal As String) As Boolean Select Case m_nType Case 1 ' booleano Dim bVal As Boolean = False If Boolean.TryParse(sVal, bVal) Then m_bVal = bVal Return True End If Case 2 ' intero Dim dVal As Double If EgtLuaEvalNumExpr(sVal, dVal) Then m_nVal = CInt(dVal) Return True End If Case 3 ' lunghezza Dim dVal As Double If EgtLuaEvalNumExpr(sVal, dVal) Then m_dVal = EgtFromUiUnits(dVal) Return True End If Case 4 ' double Dim dVal As Double If EgtLuaEvalNumExpr(sVal, dVal) Then m_dVal = dVal Return True End If Case 5 'stringa m_sVal = sVal Return True End Select Return False End Function Public Function ToLua() As Boolean Select Case m_nType Case 1 Return EgtLuaSetGlobBoolVar(LUA_VALUE & m_nInd.ToString(), m_bVal) Case 2 Return EgtLuaSetGlobIntVar(LUA_VALUE & m_nInd.ToString(), m_nVal) Case 3, 4 Return EgtLuaSetGlobNumVar(LUA_VALUE & m_nInd.ToString(), m_dVal) Case 5 Return EgtLuaSetGlobStringVar(LUA_VALUE & m_nInd.ToString(), m_sVal) End Select Return False End Function Public Function FromLua() As Boolean Select Case m_nType Case 1 Return EgtLuaGetGlobBoolVar(LUA_VALUE & m_nInd.ToString(), m_bVal) Case 2 Return EgtLuaGetGlobIntVar(LUA_VALUE & m_nInd.ToString(), m_nVal) Case 3, 4 Return EgtLuaGetGlobNumVar(LUA_VALUE & m_nInd.ToString(), m_dVal) Case 5 Return EgtLuaGetGlobStringVar(LUA_VALUE & m_nInd.ToString(), m_sVal) End Select Return False End Function Public Function NameTypeValueFromLua() As Boolean Dim bOk As Boolean = True bOk = bOk AndAlso EgtLuaGetGlobStringVar(LUA_NAME & m_nInd.ToString(), m_sName) bOk = bOk AndAlso EgtLuaGetGlobIntVar(LUA_TYPE & m_nInd.ToString(), m_nType) Return bOk AndAlso FromLua() End Function End Class End Class