Dario Sassi
206 lines
8.1 KiB
VB.net
206 lines
8.1 KiB
VB.net
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
|