Imports EgtUILib Imports System.IO Public Class CurrentProjectPageUC ' Dichiarazione eventi Friend Event OnMouseDownScene(sender As Object, e As System.Windows.Forms.MouseEventArgs) Friend Event OnMouseMoveScene(sender As Object, e As System.Windows.Forms.MouseEventArgs) Friend Event OnMouseUpScene(sender As Object, e As System.Windows.Forms.MouseEventArgs) ' Riferimento alla MainWindow Private m_MainWindow As MainWindow = Application.Current.MainWindow 'Dichiarazione delle Page UserControl Friend m_SceneButtons As SceneButtonsUC ' Properties Private m_bFirst As Boolean = True ' Dichiarazione Scene Friend WithEvents CurrentProjectScene As New Scene Private CurrentProjectSceneHost As New System.Windows.Forms.Integration.WindowsFormsHost ' Dichiarazione altezza grezzo Friend m_dRawHeight As Double ' Identificativo del grezzo Friend m_nRawId As Integer = GDB_ID.NULL ' Costanti Friend Const MACH_GROUP As String = "Mach01" Friend Const MAIN_TAB As String = "MainTab" Friend Const PHOTO_GRP As String = "Photos" Friend Const PHOTO_NAME As String = "Raw" Private Sub CurrentProjectPage_Initialized(sender As Object, e As EventArgs) 'Creazione delle Page UserControl m_SceneButtons = New SceneButtonsUC 'Posizionemento nella griglia delle Page UserControl m_SceneButtons.SetValue(Grid.ColumnProperty, 5) m_MainWindow.m_DirectCutPageUC.SetValue(Grid.RowSpanProperty, 3) m_MainWindow.m_DirectCutPageUC.SetValue(Grid.ColumnSpanProperty, 2) m_MainWindow.m_CadCutPageUC.SetValue(Grid.RowSpanProperty, 3) m_MainWindow.m_CadCutPageUC.SetValue(Grid.ColumnSpanProperty, 2) m_MainWindow.m_FrameCutPageUC.SetValue(Grid.RowSpanProperty, 3) m_MainWindow.m_FrameCutPageUC.SetValue(Grid.ColumnSpanProperty, 2) 'Assegno SceneButtons alla pagina UpperButtonGrid.Children.Add(m_SceneButtons) 'Assegnazione scena all'host e posizionamento nella PlacePageGrid CurrentProjectSceneHost.Child = CurrentProjectScene CurrentProjectSceneHost.SetValue(Grid.ColumnProperty, 1) CurrentProjectSceneHost.SetValue(Grid.RowProperty, 1) Me.CurrentProjectPageGrid.Children.Add(CurrentProjectSceneHost) 'Imposto i messaggi letti dal file dei messaggi MaterialLbl.Content = EgtMsg(MSG_ROWPARTPAGEUC + 9) 'Material - Materiale HeightLbl.Content = EgtMsg(MSG_ROWPARTPAGEUC + 5) 'Height - Spessore ToolLbl.Content = EgtMsg(MSG_CADCUTPAGEUC + 11) 'Tool - Utensile MachiningLbl.Content = EgtMsg(MSG_CADCUTPAGEUC + 12) 'Machining - Lavorazione End Sub Private Sub CurrentProjectPage_Loaded(sender As Object, e As RoutedEventArgs) If m_bFirst Then ' imposto colore di default Dim DefColor As New Color3d(0, 0, 0) GetPrivateProfileColor(S_GEOMDB, K_DEFAULTCOLOR, DefColor, m_MainWindow.GetIniFile()) CurrentProjectScene.SetDefaultMaterial(DefColor) ' imposto colori sfondo Dim BackTopColor As New Color3d(192, 192, 192) GetPrivateProfileColor(S_SCENE, K_BACKTOP, BackTopColor, m_MainWindow.GetIniFile()) Dim BackBotColor As New Color3d(BackTopColor) GetPrivateProfileColor(S_SCENE, K_BACKBOTTOM, BackBotColor, m_MainWindow.GetIniFile()) CurrentProjectScene.SetViewBackground(BackTopColor, BackBotColor) ' imposto colore di evidenziazione Dim MarkColor As New Color3d(255, 255, 0) GetPrivateProfileColor(S_SCENE, K_MARK, MarkColor, m_MainWindow.GetIniFile()) CurrentProjectScene.SetMarkMaterial(MarkColor) ' imposto colore per superfici selezionate Dim SelSurfColor As New Color3d(255, 255, 192) GetPrivateProfileColor(S_SCENE, K_SELSURF, SelSurfColor, m_MainWindow.GetIniFile()) CurrentProjectScene.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, m_MainWindow.GetIniFile()) CurrentProjectScene.SetZoomWinAttribs(bOutline, ZwColor) ' imposto colore della linea di distanza Dim DstLnColor As New Color3d(255, 0, 0) GetPrivateProfileColor(S_SCENE, K_DISTLINE, DstLnColor, m_MainWindow.GetIniFile()) CurrentProjectScene.SetDistLineMaterial(DstLnColor) ' imposto parametri OpenGL Dim nDriver As Integer = GetPrivateProfileInt(S_OPENGL, K_DRIVER, 3, m_MainWindow.GetIniFile()) Dim b2Buff As Boolean = (GetPrivateProfileInt(S_OPENGL, K_DOUBLEBUFFER, 1, m_MainWindow.GetIniFile()) <> 0) Dim nColorBits As Integer = GetPrivateProfileInt(S_OPENGL, K_COLORBITS, 32, m_MainWindow.GetIniFile()) Dim nDepthBits As Integer = GetPrivateProfileInt(S_OPENGL, K_DEPTHBITS, 32, m_MainWindow.GetIniFile()) CurrentProjectScene.SetViewAttributes(nDriver, b2Buff, nColorBits, nDepthBits) ' inizializzo la scena (DB geometrico + visualizzazione) e verifico presenza chiave If Not CurrentProjectScene.Init() Then Dim m_MissingKeyWindow As New MissingKeyWD m_MissingKeyWindow.Top = m_MainWindow.Top + (m_MainWindow.Height / 2 - m_MissingKeyWindow.Height / 2) m_MissingKeyWindow.Left = m_MainWindow.Left + (m_MainWindow.Width / 2 - m_MissingKeyWindow.Width / 2) m_MainWindow.Close() m_MissingKeyWindow.Show() End If ' inizializzo gestore lavorazioni EgtInitMachMgr(m_MainWindow.GetMachinesRootDir()) m_bFirst = False ' carico la macchina corrente Dim sCurrMach As String = String.Empty GetPrivateProfileString(S_MACH, K_CURRMACH, "", sCurrMach, m_MainWindow.GetIniFile()) EgtAddMachGroup("Mach01", sCurrMach) ' imposto la tavola corrente EgtSetTable("MainTab") EgtShowOnlyTable(True) Else EgtSetCurrentContext(CurrentProjectScene.GetCtx()) End If ' inibisco selezione diretta da Scene CurrentProjectScene.SetStatusNull() ' Imposto dati progetto If m_MainWindow.m_nCurrentMaterial >= 0 And m_MainWindow.m_nCurrentMaterial < m_MainWindow.m_MaterialsList.Count() Then MaterialTxBx.Text = m_MainWindow.m_MaterialsList(m_MainWindow.m_nCurrentMaterial).Name Else MaterialTxBx.Text = "" End If HeightTxBx.Text = m_dRawHeight GetPrivateProfileString("Mach", "CurrSaw", "", ToolTxBx.Text, m_MainWindow.GetIniFile) End Sub Private Sub OnMyMouseDownScene(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles CurrentProjectScene.OnMouseDownScene RaiseEvent OnMouseDownScene(sender, e) End Sub Private Sub OnMyMouseMoveScene(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles CurrentProjectScene.OnMouseMoveScene RaiseEvent OnMouseMoveScene(sender, e) End Sub Private Sub OnMyMouseUpScene(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles CurrentProjectScene.OnMouseUpScene RaiseEvent OnMouseUpScene(sender, e) End Sub Friend Function NewProject() As Boolean EgtNewFile() ' carico la macchina corrente Dim sCurrMach As String = String.Empty GetPrivateProfileString(S_MACH, K_CURRMACH, "", sCurrMach, m_MainWindow.GetIniFile()) If EgtAddMachGroup(MACH_GROUP, sCurrMach) = GDB_ID.NULL Then Return False End If ' imposto la tavola corrente If Not EgtSetTable(MAIN_TAB) Then Return False End If EgtShowOnlyTable(True) Return True End Function Friend Function LoadProject(ByVal sPath As String) As Boolean If Not EgtOpenFile(sPath) Then Return False End If ' attivo il gruppo di lavoro corrente Dim nMachGrpId As Integer = EgtGetFirstMachGroup() If Not EgtSetCurrMachGroup(nMachGrpId) Then Return False End If EgtShowOnlyTable(True) ' aggiorno eventuale identificativo grezzo m_nRawId = EgtGetFirstRawPart() ' aggiorno spessore grezzo m_dRawHeight = m_MainWindow.m_RawPartPage.GetRawHeight() HeightTxBx.Text = DoubleToString(m_dRawHeight, 2) ' se presente la foto, ne carico la texture ReloadPhoto() Return True End Function Friend Function SaveProject(ByVal sPath As String) As Boolean Dim bOk As Boolean = EgtSaveFile(sPath, NGE.CMPTEXT) ' Ripristino visualizzazione di eventuali pezzi in parcheggio (save li nasconde) ShowParkedParts() Return bOk End Function Friend Function LoadPhoto(ByVal sPath As String) As Boolean ' Verifico esistenza file immagine If Not File.Exists(sPath) Then Return False End If ' Leggo file dati aggiuntivi se esiste Dim ptOri As New Point3d(0, 0, 0) Dim ptCen As New Point3d(0, 0, 1) Dim dMMxPixel As Double = 1 Dim sAuxPath As String = Path.ChangeExtension(sPath, ".txt") Try Dim sLine As String = String.Empty Dim sr As StreamReader = New StreamReader(sAuxPath) Do While sr.Peek() > -1 sLine = sr.ReadLine() sLine = sLine.Replace(" ", "") If sLine.StartsWith("X=") Then StringToDouble(sLine.Substring(2), ptOri.x) ElseIf sLine.StartsWith("Y=") Then StringToDouble(sLine.Substring(2), ptOri.y) ElseIf sLine.StartsWith("Z_Lastra=") Then StringToDouble(sLine.Substring(9), ptOri.z) ElseIf sLine.StartsWith("X_ScaleCenter=") Then StringToDouble(sLine.Substring(14), ptCen.x) ElseIf sLine.StartsWith("Y_ScaleCenter=") Then StringToDouble(sLine.Substring(14), ptCen.y) ElseIf sLine.StartsWith("Z_ScaleCenter=") Then StringToDouble(sLine.Substring(14), ptCen.z) ElseIf sLine.StartsWith("Pixelxmm=") Then Dim dTmp As Double StringToDouble(sLine.Substring(9), dTmp) If dTmp > EPS_SMALL Then dMMxPixel = 1 / dTmp End If End If Loop sr.Close() Catch ex As Exception EgtOutLog("LoadPhoto Error on auxfile : " & sAuxPath) End Try ' Recupero origine della tavola e porto i punti in globale Dim ptTab As Point3d EgtGetTableRef1(ptTab) ptOri.ToGlob(New Frame3d(ptTab)) ptCen.ToGlob(New Frame3d(ptTab)) ' Recupero le dimensioni della tavola Dim nAreaId As Integer Dim ptMin, ptMax As Point3d If Not EgtGetTableArea1(nAreaId) Or Not EgtGetBBoxGlob(nAreaId, GDB_BB.STANDARD, ptMin, ptMax) Then Return False End If ' Carico la fotografia Return AddPhoto(PHOTO_NAME, sPath, ptOri, ptCen, dMMxPixel, ptMin, ptMax) End Function Friend Function ReloadPhoto() As Boolean Dim nPhotoId As Integer = GetPhoto() If nPhotoId = GDB_ID.NULL Then Return True End If ' recupero i dati Dim sPath As String = String.Empty EgtGetInfo(nPhotoId, "!TPA", sPath) Dim dDimX As Double EgtGetInfo(nPhotoId, "!TDX", dDimX) Dim dDimY As Double EgtGetInfo(nPhotoId, "!TDY", dDimY) ' Carico la texture If Not EgtLoadTexture(PHOTO_NAME, sPath, 0, dDimX, dDimY, False) Then Return False End If Return True End Function Private Function AddPhoto(ByVal sName As String, ByVal sPath As String, ByVal ptOri As Point3d, ByVal ptCen As Point3d, ByVal dMMxPixel As Double, ByVal ptMin As Point3d, ByVal ptMax As Point3d) As Boolean ' Se non esiste il gruppo per le foto, lo creo Dim nPhGrpId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, PHOTO_GRP) If nPhGrpId = GDB_ID.NULL Then nPhGrpId = EgtCreateGroup(GDB_ID.ROOT) If nPhGrpId = GDB_ID.NULL Then Return False End If EgtSetName(nPhGrpId, PHOTO_GRP) End If EgtSetLevel(nPhGrpId, GDB_LV.SYSTEM) ' Carico la texture If Not EgtLoadTexture(sName, sPath, dMMxPixel, 0, 0, False) Then Return False End If ' Recupero le dimensioni fisiche Dim dDimX, dDimY As Double EgtGetTextureDimensions(sName, dDimX, dDimY) ' Inserisco il rettangolo della foto Dim ptCross As Point3d = ptOri + New Vector3d(dDimX, dDimY, 0) ptOri.x = Math.Max(ptOri.x, ptMin.x) ptOri.y = Math.Max(ptOri.y, ptMin.y) ptCross.x = Math.Min(ptCross.x, ptMax.x) ptCross.y = Math.Min(ptCross.y, ptMax.y) Dim nId As Integer = EgtCreateSurfFrRectangle(nPhGrpId, ptOri, ptCross, GDB_RT.GLOB) If nId = GDB_ID.NULL Then EgtUnloadTexture(sName) Return False End If EgtSetColor(nId, New Color3d(255, 255, 255, 100)) EgtSetName(nId, sName) EgtSetInfo(nId, "!TNA", sName) EgtSetInfo(nId, "!TPA", sPath) EgtSetInfo(nId, "!TDX", dDimX) EgtSetInfo(nId, "!TDY", dDimY) EgtSetInfo(nId, "!TFR", New Frame3d(ptOri)) Return True End Function Friend Function ShowPhoto(ByVal bShow As Boolean) As Boolean ' Recupero la foto Dim nId As Integer = GetPhoto() If nId = GDB_ID.NULL Then Return False End If ' Ne cambio lo stato Return EgtSetStatus(nId, If(bShow, GDB_ST.ON_, GDB_ST.OFF)) End Function Friend Function GetPhoto() As Integer Dim nPhGrpId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, PHOTO_GRP) Return EgtGetFirstNameInGroup(nPhGrpId, PHOTO_NAME) End Function Friend Function GetPhotoTextureRef(ByRef refTxt As Frame3d) As Boolean ' Recupero la foto Dim nId As Integer = GetPhoto() If nId = GDB_ID.NULL Then Return False End If ' Recupero il riferimento Return EgtGetInfo(nId, "!TFR", refTxt) End Function End Class