Imports System.Globalization Imports EgtUILib Module Utility '-------------------------------------------------------------------------------------------------- Friend Sub UpdateUI() ' Costringo ad aggiornare UI Dim nDummy As Integer Application.Current.Dispatcher.Invoke(Windows.Threading.DispatcherPriority.Background, _ New Action(Function() nDummy = 0)) End Sub '-------------------------------------------------------------------------------------------------- Friend Function DoubleToString(ByVal dVal As Double, ByVal nNumDec As Integer) As String Dim sFormat As String = "F" + Math.Abs(nNumDec).ToString() Dim sVal As String = dVal.ToString(sFormat, CultureInfo.InvariantCulture) If nNumDec > 0 Then Return sVal.TrimEnd("0".ToCharArray()).TrimEnd(".".ToCharArray) Else Return sVal End If End Function Friend Function StringToDouble(ByVal sVal As String, ByRef dVal As Double) As Boolean If String.IsNullOrEmpty(sVal) Then Return False Return EgtLuaEvalNumExpr(sVal, dVal) End Function Friend Function StringToInt(sVal As String, ByRef nVal As Integer) As Boolean Dim dVal As Double = 0 If Not StringToDouble(sVal, dVal) Then Return False nVal = CInt(Math.Round(dVal)) Return True End Function Friend Function LenToString(ByVal dVal As Double, ByVal nNumDec As Integer) As String Return DoubleToString(EgtToUiUnits(dVal), nNumDec) End Function Friend Function StringToLen(ByVal sVal As String, ByRef dVal As Double) As Boolean If String.IsNullOrEmpty(sVal) Then Return False If EgtLuaEvalNumExpr(sVal, dVal) Then dVal = EgtFromUiUnits(dVal) Return True Else Return False End If End Function Friend Function UIExprToExpr(ByVal sUIExpr As String) As String If String.IsNullOrWhiteSpace(sUIExpr) Then Return "" End If Return sUIExpr.Replace("""", "*GEO.ONE_INCH") End Function Friend Function ExprToUIExpr(ByVal sExpr As String) As String If String.IsNullOrWhiteSpace(sExpr) Then Return "" End If Return sExpr.Replace("*GEO.ONE_INCH", """") End Function Friend Function DistToString(vtDist As Vector3d) As String Dim nDec As Integer = If(EgtUiUnitsAreMM(), 1, 2) Dim sDistance As String = EgtMsg(1301) 'Dist= sDistance &= LenToString(vtDist.Len(), nDec) & vbCrLf sDistance &= " dX=" & LenToString(vtDist.x, nDec) sDistance &= " dY=" & LenToString(vtDist.y, nDec) sDistance &= " dZ=" & LenToString(vtDist.z, nDec) Return sDistance End Function '-------------------------------------------------------------------------------------------------- Friend Function GetValueWithKey(sString As String, sKey As String) As String If String.IsNullOrWhiteSpace(sString) Then Return "" Dim sPurged As String = sString.Trim() Dim nPos As Integer = sPurged.IndexOf("="c) If nPos < 0 Then Return "" If String.Compare(sPurged.Substring(0, nPos), sKey, True) = 0 Then Return sPurged.Substring(nPos + 1) Return "" End Function '-------------------------------------------------------------------------------------------------- Friend Sub HideParkedParts(Optional bDisableModified As Boolean = True) ' Se richiesto, disabilito impostazione modificato Dim bOldEnMod As Boolean = False If bDisableModified Then bOldEnMod = EgtGetEnableModified() If bOldEnMod Then EgtDisableModified() End If ' Nascondo pezzi parcheggiati Dim nPartId As Integer = EgtGetFirstPart() While nPartId <> GDB_ID.NULL EgtSetStatus(nPartId, GDB_ST.OFF) nPartId = EgtGetNextPart(nPartId) End While ' Se necessario, ripristino precedente impostazione modificato If bOldEnMod Then EgtEnableModified() End Sub Friend Sub ShowParkedParts(Optional bDisableModified As Boolean = True) ' Se richiesto, disabilito impostazione modificato Dim bOldEnMod As Boolean = False If bDisableModified Then bOldEnMod = EgtGetEnableModified() If bOldEnMod Then EgtDisableModified() End If ' Visualizzo pezzi parcheggiati Dim nPartId As Integer = EgtGetFirstPart() While nPartId <> GDB_ID.NULL EgtSetStatus(nPartId, GDB_ST.ON_) nPartId = EgtGetNextPart(nPartId) End While ' Se necessario, ripristino precedente impostazione modificato If bOldEnMod Then EgtEnableModified() End Sub Friend Function SetTextColor( nGroup As Integer) As Boolean ' Recupero il colore da assegnare ai testi Dim colText As New Color3d() Dim sTextColor As String = " " Dim MainWindow As MainWindow = DirectCast(Application.Current.MainWindow, MainWindow) If GetPrivateProfileString(S_NEST, K_TEXTCOLOR, " ", sTextColor, MainWindow.GetIniFile()) <> 0 Then Dim sTextColorArray() As String = sTextColor.Split(",") Dim nRed As Integer = 0 : Integer.TryParse( sTextColorArray(0), nRed) Dim nGreen As Integer = 0 : Integer.TryParse( sTextColorArray(1), nGreen) Dim nBlue As Integer = 0 : Integer.TryParse( sTextColorArray(2), nBlue) colText.Setup( nRed, nGreen, nBlue) End If ' Assegno questo colore ai testi del layer indicato Dim nId As Integer = EgtGetFirstInGroup( nGroup) While nId <> GDB_ID.NULL If EgtGetType(nId) = GDB_TY.EXT_TEXT Then EgtSetColor(nId, colText) End If nId = EgtGetNext(nId) End While Return True End Function '-------------------------------------------------------------------------------------------------- Public Class Language Private m_sLanguageName As String Private m_sFileName As String Public Property LanguageName As String Get Return m_sLanguageName End Get Set(value As String) m_sLanguageName = value End Set End Property Public Property FileName As String Get Return m_sFileName End Get Set(value As String) m_sFileName = value End Set End Property Sub New(LanguageName As String, FileName As String) Me.LanguageName = LanguageName Me.FileName = FileName End Sub End Class Public Function GetPrivateProfileLanguage( lpAppName As String, lpKeyName As String, lpFileName As String) As Language Dim sVal As String = String.Empty GetPrivateProfileString(lpAppName, lpKeyName, "", sVal, lpFileName) Dim sItems() As String = sVal.Split(",".ToCharArray) If sItems.Count() = 2 Then Return New Language(sItems(0), sItems(1)) End If Return Nothing End Function '-------------------------------------------------------------------------------------------------- Public Function GetBackTopColor() As Color3d Dim MyMainWindow As MainWindow = DirectCast(Application.Current.MainWindow, MainWindow) Dim nTheme = GetPrivateProfileInt(S_GENERAL, K_THEME, 0, MyMainWindow.GetIniFile()) Dim BackTopColor As New Color3d(211, 211, 211) Dim sBackTop As String = K_BACKTOP If nTheme = 1 Then sBackTop &= "1" GetPrivateProfileColor(S_SCENE, sBackTop, BackTopColor, MyMainWindow.GetIniFile()) Return BackTopColor End Function Public Function GetBackBottomColor() As Color3d Dim MyMainWindow As MainWindow = DirectCast(Application.Current.MainWindow, MainWindow) Dim nTheme = GetPrivateProfileInt(S_GENERAL, K_THEME, 0, MyMainWindow.GetIniFile()) Dim BackBottomColor As New Color3d(211, 211, 211) Dim sBackBottom As String = K_BACKBOTTOM If nTheme = 1 Then sBackBottom &= "1" GetPrivateProfileColor(S_SCENE, sBackBottom, BackBottomColor, MyMainWindow.GetIniFile()) Return BackBottomColor End Function End Module