OmagCUT/Utility/Utility.vb

Imports System.Globalization
Imports EgtUILib
Imports EgtWPFLib

Module Utility
   Friend Function CompoColor(sIniFile As String) As Color3d
      Dim InsertColor As New Color3d(89, 210, 210, 25)
      Dim IndexColor As Integer = GetPrivateProfileInt(S_COMPO, K_LASTCOLOR, 1, sIniFile)
      If Not GetPrivateProfileColor(S_COMPO, K_COLOR & IndexColor.ToString, InsertColor, sIniFile) Then
         IndexColor = 1
         GetPrivateProfileColor(S_COMPO, K_COLOR & IndexColor.ToString, InsertColor, sIniFile)
      End If
      WritePrivateProfileString(S_COMPO, K_LASTCOLOR, (IndexColor + 1).ToString, sIniFile)
      Return InsertColor
   End Function


    Friend StopWatch As Stopwatch

   Friend Sub TimeSpanInit()
      StopWatch = New Stopwatch
      StopWatch.Start()
   End Sub

   Friend Function TimeSpanEnd() As String
      Dim sTime As String = ""
      If Not IsNothing(StopWatch) Then
         StopWatch.Stop()
         Dim ts As TimeSpan = StopWatch.Elapsed
         sTime = String.Format("{0:00}:{1:00}:{2:00}.{3:000}", ts.Hours, ts.Minutes, ts.Seconds, ts.Milliseconds)
      End If
      Return sTime
   End Function

   '--------------------------------------------------------------------------------------------------
   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

   '--------------------------------------------------------------------------------------------------
#Region "INCHES FRACTIONS"
   ' seleziona il tipo di Pattern di stampa dei dati
   Friend nCurrFractionPattern As FractionStringConverter.FractionPattern = FractionPattern.Feet_Inches
   Friend dPrecision As Double = 64
#End Region    ' Inches Fraction
   '--------------------------------------------------------------------------------------------------

   Friend Function DoubleToString(dVal As Double, 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(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

   ' converte il dato (in mm) in stringa nell'unità corrente
   Friend Function LenToString(dVal As Double, nNumDec As Integer, Optional ByVal bForceToDecimal As Boolean = False) As String
      Dim sVal As String = DoubleToString(EgtToUiUnits(dVal), nNumDec)
      ' se richiesta scrittura in frazione (solo se unità corrente INCHES)
      If (nCurrFractionPattern <> FractionPattern.None And Not EgtUiUnitsAreMM()) And Not bForceToDecimal Then
         ' converto il dato corrente in decimale
         Dim dCurrVal As Double = dVal / ONEINCH
         Return DoubleToStringFraction(dCurrVal, dPrecision)
      End If
      Return sVal
   End Function

   Friend Function StringToLen(sVal As String, ByRef dVal As Double, Optional ByVal bForceToDecimal As Boolean = False) As Boolean
      If String.IsNullOrEmpty(sVal) Then Return False

      If (nCurrFractionPattern <> FractionPattern.None And Not EgtUiUnitsAreMM()) And Not bForceToDecimal Then
         Dim sValSource As String = sVal
         ' conevrto la stringa in formato decimale (sempre in stringa)
         StringFractionToStringDecimal(sValSource, sVal)
      End If

      If EgtLuaEvalNumExpr(sVal, dVal) Then
         dVal = EgtFromUiUnits(dVal)
         Return True
      Else
         Return False
      End If
   End Function

#Region "PreGuidCode"

   ' recupero i primi 5 caratteri della stringa
   Friend Function GetPreGuidCode(sGuidCode As String) As String
      If sGuidCode.Count > 5 Then
         Return sGuidCode(0) & sGuidCode(1) & sGuidCode(2) & sGuidCode(3) & sGuidCode(4)
      End If
      Return String.Empty
   End Function

   ' sostituisce i primi 5 caratteri della stringa con qualle passata
   Friend Function UppDateGuidCode(ByRef sGuidCode As String, sPreGuidCode As String) As Boolean
      If sPreGuidCode.Count = 5 Then
         sGuidCode = sGuidCode.Remove(0, 5)
         sGuidCode = sPreGuidCode & sGuidCode
         Return True
      End If
      Return False
   End Function

   ' restituisce 5 caratteri 
   Friend Function CreatePreGuidCode(nId As Integer) As String
      ' recupero il frame dell'oggetto
      Dim frGlobFrame As New Frame3d
      If Not EgtGetGroupGlobFrame(nId, frGlobFrame) Then
         Return String.Empty
      End If
      ' recupero il suo versore
      Dim vtX As Vector3d = frGlobFrame.VersX
      Dim Len As Double
      Dim AngV As Double
      Dim AngH As Double
      vtX.ToSpherical(Len, AngV, AngH)
      ' costruisco il codice (6 caratteri!) che identifica la posizione del pezzo in parcheggio
      Dim sPreGuid As String = GetDirectionCode(AngH)
      Return sPreGuid
   End Function

   Friend Function GetDirectionCode(dVal As Double) As String
      Dim bIsNegative As Boolean = False
      If dVal < 0 Then
         dVal = dVal + (-1)
         bIsNegative = True
      End If
      Dim sVal As String = DoubleToString(dVal * 1000, 0)
      Dim nCount As Integer = sVal.Count
      For Index As Integer = 1 To 4 - nCount
         sVal = "0" & sVal
      Next
      Dim vVal As Char() = {"+", "1", "0", "0", "0"}
      If bIsNegative Then
         vVal = {"-"c, sVal(0), sVal(1), sVal(2), sVal(3)}
      Else
         vVal = {"+"c, sVal(0), sVal(1), sVal(2), sVal(3)}
      End If
      ' ricostruisco la stringa dotata di segno
      sVal = vVal(0) & vVal(1) & vVal(2) & vVal(3) & vVal(4)
      Return sVal
   End Function

#End Region    ' PreGiudCode


   Friend Function UIExprToExpr(sUIExpr As String) As String
      If String.IsNullOrWhiteSpace(sUIExpr) Then
         Return ""
      End If
      Return sUIExpr.Replace("""", "*GEO.ONE_INCH")
   End Function

   Friend Function ExprToUIExpr(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

      ' Visualizzo gli elementi attivi in parcheggio
      SelParkIndWD.UpdateViewOnParkInd(False)

      ' 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( 0, 0, 0)
      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

   Friend Function AddTopToPartRegion( nRegId As Integer) As Boolean
      Dim frReg As New Frame3d : EgtGetGroupGlobFrame( nRegId, frReg)
      Dim b3Reg As New BBox3d : EgtGetBBoxGlob( nRegId, GDB_BB.STANDARD, b3Reg)
      Dim dH As Double = Math.Min(0.1 * b3Reg.DimY(), 30)
      Dim ptIns As New Point3d( b3Reg.Center().x, b3Reg.Max().y - dH, b3Reg.Max().z)
      ptIns.ToLoc( frReg)
      Dim nSfrId As Integer = EgtGetFirstInGroup( nRegId)
      While nSfrId <> GDB_ID.NULL 
         If EgtGetType( nSfrId) = GDB_TY.SRF_FRGN Then Exit While
         nSfrId = EgtGetNext( nSfrId)
      End While
      If nSfrId <> GDB_ID.NULL Then
         Dim ptStart As New Point3d ( b3Reg.Min().x, b3Reg.Max().y - dH, b3Reg.Max().z)
         ptStart.ToLoc( frReg)
         Dim ptEnd As New Point3d ( b3Reg.Max().x, b3Reg.Max().y - dH, b3Reg.Max().z)
         ptEnd.ToLoc( frReg)
         Dim nLineId As Integer = EgtCreateLine( nRegId, ptStart, ptEnd)
         Dim nCount As Integer = 0
         Dim nNewId As Integer = EgtTrimCurveWithRegion( nLineId, nSfrId, True, False, nCount) 
         If nNewId <> GDB_ID.NULL Then
            If nCount > 0 Then EgtMidPoint( nNewId, ptIns)
            For nTmpId As Integer = nNewId To nNewId + nCount - 1
               EgtErase( nTmpId)
            Next 
         Else
            EgtErase( nLineId)
         End If
      End If
      Dim vtDir As New Vector3d( 1, 0, 0)
      vtDir.ToLoc( frReg)
      Dim dLen, dAngV, dAngH As Double
      vtDir.ToSpherical( dLen, dAngV, dAngH)
      Dim nText As Integer = EgtCreateTextAdv(nRegId, ptIns, dAngH, "*TOP*", "", 500, False, dH, 1, 0, INS_POS.MC)
      Return ( nText <> GDB_ID.NULL)
   End Function

   Friend Function SetBlockAndSlabNbr( sBlock As String, sSlabNbr As String) As Boolean
      Dim nRawId As Integer = GetCurrentRaw()
      If nRawId = GDB_ID.NULL Then Return False
      If String.IsNullOrWhiteSpace(sBlock) Then sSlabNbr = ""
      ' Assegno info
      EgtSetInfo( nRawId, INFO_RAW_BLOCK, sBlock)
      EgtSetInfo( nRawId, INFO_RAW_SLABNBR, sSlabNbr)
      ' Cancello eventuale vecchio BarCode
      EgtErase( EgtGetFirstNameInGroup( nRawId, NAME_BARCODE))
      ' Se definito, inserisco nuovo BarCode
      Dim sBarCode As String = sBlock & " - " & sSlabNbr
      If sBarCode <> " - " Then
         Dim ptRawCen As Point3d
         GetRawCenter( ptRawCen)
         Dim ptRawMin, ptRawMax As Point3d
         GetRawBox( ptRawMin, ptRawMax)
         Dim ptText As New Point3d( ptRawCen.x, ptRawCen.y, ptRawMax.z)
         Dim nText As Integer = EgtCreateTextAdv( nRawId, ptText, 0, sBarCode, "", 500, False, 50.0, 1, 0, INS_POS.MC, GDB_RT.GLOB)
         EgtSetName( nText, NAME_BARCODE)
         EgtSetColor( nText, New Color3d(255, 0, 0))
      End If
      Return True
   End Function

   ' Restituisce il colore dell'utensile correntemente settato, se non trova l'utensile o il colore ritorna il default (0,255,0)
   Friend Function GetColorPV() As Color3d
      ' Recupero il campo COLOR dalle note di sistema
      Dim ToolColor As String = String.Empty
      EgtTdbGetCurrToolValInNotes(MCH_TP.SYSNOTES, "COLOR", ToolColor)
      ' Recupero i tre valori interi RGB
      Dim sItems As String() = ToolColor.Split(","c)
      Dim nRed, nGreen, nBlue As Integer
      If sItems.Count>= 3 AndAlso
         Integer.TryParse( sItems(0), nRed) AndAlso
         Integer.TryParse( sItems(1), nGreen) AndAlso
         Integer.TryParse( sItems(2), nBlue) Then
         Return New Color3d(nRed, nGreen, nBlue, 100)
      Else
         Return New Color3d(0, 255, 0, 100)
      End If
   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

   Public Function GetDrillFromDrilling(sCurrDrilling As String) As String
      ' Se foratura non definita, esco subito
      If String.IsNullOrWhiteSpace(sCurrDrilling) Then Return ""
      ' Salvo lavorazione e utensile correnti
      Dim sPrevMach As String = ""
      EgtMdbGetCurrMachiningParam(MCH_MP.NAME, sPrevMach)
      Dim sPrevTool As String = ""
      EgtTdbGetCurrToolParam(MCH_TP.NAME, sPrevTool)
      ' Inizializzo nome utensile a nessuno
      Dim sCurrDrill As String = ""
      ' Se esiste la lavorazione
      If EgtMdbSetCurrMachining(sCurrDrilling) Then
         ' recupero il nome dell'utensile della lavorazione
         Dim sTuuid As String = ""
         Dim sToolName As String = ""
         If Not EgtMdbGetCurrMachiningParam(MCH_MP.TUUID, sTuuid) OrElse
            Not EgtTdbGetToolFromUUID(sTuuid, sToolName) Then
            EgtMdbGetCurrMachiningParam(MCH_MP.TOOL, sToolName)
         End If
         ' ne verifico il tipo
         Dim nToolType As Integer = MCH_TY.NONE
         If EgtTdbSetCurrTool( sToolName) AndAlso
            EgtTdbGetCurrToolParam( MCH_TP.TYPE, nToolType) AndAlso ( nToolType And MCH_TF.DRILLBIT) <> 0 Then
            sCurrDrill = sToolName
         End If
      End If
      ' Ripristino lavorazione e utensile correnti
      EgtMdbSetCurrMachining(sPrevMach)
      EgtTdbSetCurrTool(sPrevTool)
      ' Restituisco il nome dell'utensile
      Return sCurrDrill
   End Function

   Public Function GetMillFromMilling(sCurrMilling As String) As String
      ' Se fresatura non definita, esco subito
      If String.IsNullOrWhiteSpace(sCurrMilling) Then Return ""
      ' Salvo lavorazione e utensile correnti
      Dim sPrevMach As String = ""
      EgtMdbGetCurrMachiningParam(MCH_MP.NAME, sPrevMach)
      Dim sPrevTool As String = ""
      EgtTdbGetCurrToolParam(MCH_TP.NAME, sPrevTool)
      ' Inizializzo nome utensile a nessuno
      Dim sCurrMill As String = ""
      ' Se esiste la lavorazione
      If EgtMdbSetCurrMachining(sCurrMilling) Then
         ' recupero il nome dell'utensile della lavorazione
         Dim sTuuid As String = ""
         Dim sToolName As String = ""
         If Not EgtMdbGetCurrMachiningParam(MCH_MP.TUUID, sTuuid) OrElse
            Not EgtTdbGetToolFromUUID(sTuuid, sToolName) Then
            EgtMdbGetCurrMachiningParam(MCH_MP.TOOL, sToolName)
         End If
         ' ne verifico il tipo
         Dim nToolType As Integer = MCH_TY.NONE
         If EgtTdbSetCurrTool( sToolName) AndAlso
            EgtTdbGetCurrToolParam( MCH_TP.TYPE, nToolType) AndAlso ( nToolType And MCH_TF.MILL) <> 0 Then
            sCurrMill = sToolName
         End If
      End If
      ' Ripristino lavorazione e utensile correnti
      EgtMdbSetCurrMachining(sPrevMach)
      EgtTdbSetCurrTool(sPrevTool)
      ' Restituisco il nome dell'utensile
      Return sCurrMill
   End Function

End Module