Imports EgtUILib Imports EgtWPFLib 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 ' Identificativo progetto corrente Private m_nCurrProj As Integer = 0 ' Dati del grezzo Friend m_nRawId As Integer = GDB_ID.NULL Friend m_dRawHeight As Double ' Altezza della eventuale tavola aggiuntiva Friend m_dAddTable As Double = 0 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 MaterialTxBl.Text = EgtMsg(MSG_RAWPARTPAGEUC + 9) 'Material - Materiale HeightTxBl.Text = EgtMsg(MSG_RAWPARTPAGEUC + 5) 'Height - Spessore ToolTxBl.Text = EgtMsg(MSG_CADCUTPAGEUC + 11) 'Tool - Utensile MachiningTxBl.Text = EgtMsg(MSG_CADCUTPAGEUC + 12) 'Machining - Lavorazione 'Recupero altezza eventuale tavola aggiuntiva m_dAddTable = GetPrivateProfileDouble(S_TABLE, K_ADDITIONALTABLE, 0, m_MainWindow.GetMachIniFile()) End Sub Private Sub CurrentProjectPage_Loaded(sender As Object, e As RoutedEventArgs) ClearMessage() 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(211, 211, 211) GetPrivateProfileColor(S_SCENE, K_BACKTOP, BackTopColor, m_MainWindow.GetIniFile()) Dim BackBotColor As New Color3d(211, 211, 211) 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 ' Rimuovo l'host della scena perchè altrimenti rimarrebbe il buco!! Me.CurrentProjectPageGrid.Children.Remove(CurrentProjectSceneHost) Dim MissingKeyWnd As New EgtMsgBox(m_MainWindow, EgtMsg(MSG_MISSINGKEYWD + 1), EgtMsg(MSG_MISSINGKEYWD + 2) & " " & EgtMsg(MSG_MISSINGKEYWD + 3), EgtMsgBox.Buttons.OK, EgtMsgBox.Icons.NULL) m_MainWindow.Close() End If ' Inizializzo gestore lavorazioni EgtInitMachMgr(m_MainWindow.GetMachinesRootDir()) m_bFirst = False ' Se richiesto, carico ultimo progetto Dim bAutoLoadLast As Boolean = GetPrivateProfileInt(S_GENERAL, K_AUTOLOADLASTPROJ, 0, m_MainWindow.GetIniFile()) <> 0 If bAutoLoadLast Then m_nCurrProj = GetPrivateProfileInt(S_GENERAL, K_LASTPROJ, 0, m_MainWindow.GetIniFile()) Dim sPath As String = m_MainWindow.GetSaveDir() & "\" & m_nCurrProj.ToString("D4") & ".nge" If Not LoadProject(sPath, False) Then NewProject() End If EgtResetModified() ' Altrimenti ne imposto uno nuovo Else m_nCurrProj = GetPrivateProfileInt(S_GENERAL, K_LASTPROJ, 0, m_MainWindow.GetIniFile()) NewProject() End If ' Imposto utensile e lavorazione correnti Dim sCurrSaw As String = String.Empty GetPrivateProfileString(S_MACH, K_CURRSAW, "", sCurrSaw, m_MainWindow.GetIniFile()) ToolTxBx.Text = sCurrSaw 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 Dim sCurrMach As String = String.Empty GetPrivateProfileString(S_MACH, K_CURRSAWING, "", sCurrMach, m_MainWindow.GetIniFile()) MachiningTxBx.Text = sCurrMach 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 ' Gestione progetto Private Sub SetNextProjectIndex() ' se indice negativo, non devo calcolarne uno nuovo If m_nCurrProj < 0 Then Return End If ' Recupero massimo indice ammesso Dim nMaxProj As Integer = GetPrivateProfileInt(S_GENERAL, K_MAXPROJ, 100, m_MainWindow.GetIniFile()) ' Imposto nuovo indice di progetto m_nCurrProj = -(Math.Abs(m_nCurrProj) + 1) If m_nCurrProj < -nMaxProj Then m_nCurrProj = -1 End If End Sub Friend Function NewProject() As Boolean ' Imposto nuovo indice di progetto SetNextProjectIndex() ' Imposto il nuovo progetto EgtOutLog("NewProject (" & m_nCurrProj.ToString() & ")") EgtNewFile() ' Inserisco contrassegno di progetto OmagCut valido AddProjectMark() ' Creo un gruppo di lavoro e carico la macchina corrente If EgtAddMachGroup(MACH_GROUP, m_MainWindow.GetCurrMachine()) = GDB_ID.NULL Then Return False End If ' Imposto la tavola corrente If Not EgtSetTable(MAIN_TAB) Then Return False End If EgtShowOnlyTable(True) ' Aggiungo eventuale sovratavola AddAdditionalTable() ' Reset grezzo m_nRawId = GDB_ID.NULL m_MainWindow.m_CadCutPageUC.m_NestPage.CalcRawPart() m_dRawHeight = 0 HeightTxBx.Text = LenToString(m_dRawHeight, 2) ' Dichiaro progetto non modificato EgtResetModified() Return True End Function Private Function AddAdditionalTable() As Boolean ' Se non esiste sovratavola, esco subito If m_dAddTable < 10 * EPS_SMALL Then Return True End If ' Recupero box tavola Dim ptMin, ptMax As Point3d EgtGetTableArea(1, ptMin, ptMax) ' Aggiungo sovratavola nel gruppo dei bloccaggi Const MACH_FIXT_GROUP As String = "Fixt" ptMax.z -= DELTAZ_ADDTAB ptMin.z = ptMax.z ptMax.z += m_dAddTable Dim nMchId As Integer = EgtGetFirstMachGroup() Dim nFixtId As Integer = EgtGetFirstNameInGroup(nMchId, MACH_FIXT_GROUP) Dim nAddTabId As Integer = EgtCreateSurfTmBBox(nFixtId, ptMin, ptMax, GDB_RT.GLOB) If nAddTabId = GDB_ID.NULL Then Return False End If EgtSetName(nAddTabId, "AddTab") EgtSetColor(nAddTabId, New Color3d(150, 75, 0, 100), True) Return True End Function Friend Function LoadProject(ByVal sPath As String, Optional ByVal bUpdateIndex As Boolean = True) As Boolean ' Se richiesto, imposto nuovo indice di progetto If bUpdateIndex Then SetNextProjectIndex() End If ' Carico il file del progetto EgtOutLog("LoadProject : " & sPath & " (" & m_nCurrProj.ToString() & ")") If Not LoadFile(sPath) Then Return False End If ' aggiorno grezzo m_nRawId = EgtGetFirstRawPart() m_MainWindow.m_CadCutPageUC.m_NestPage.CalcRawPart() ' aggiorno spessore grezzo m_dRawHeight = m_MainWindow.m_RawPartPage.GetRawHeight() HeightTxBx.Text = LenToString(m_dRawHeight, 2) ' Dichiaro progetto non modificato EgtResetModified() Return True End Function Private Function LoadFile(ByVal sPath As String) As Boolean ' Carico il file If Not EgtOpenFile(sPath) Then Return False End If ' Recupero il gruppo di lavoro del file Dim nMachGrpId As Integer = EgtGetFirstMachGroup() If nMachGrpId = GDB_ID.NULL Then Return False End If ' Carico il gruppo e verifico che la sua macchina sia quella corrente Dim sFileMachine As String = String.Empty If Not EgtSetCurrMachGroup(nMachGrpId) Then EgtGetInfo(nMachGrpId, "Machine", sFileMachine) Else EgtGetCurrMachineName(sFileMachine) End If ' Verifico che la macchina del file sia quella impostata If String.Compare(sFileMachine, m_MainWindow.GetCurrMachine(), True) <> 0 Then ' Emetto messaggio Dim sOut As String = EgtMsg(90320) & " (" & sFileMachine & ")" ' Macchina diversa SetErrorMessage(sOut) ' Cancello il gruppo di lavoro EgtRemoveMachGroup(nMachGrpId) ' Ne creo uno nuovo con la macchina corrente If EgtAddMachGroup(MACH_GROUP, m_MainWindow.GetCurrMachine()) = GDB_ID.NULL Then Return False End If ' Imposto la tavola corrente If Not EgtSetTable(MAIN_TAB) Then Return False End If ' Aggiungo eventuale sovratavola AddAdditionalTable() End If ' Visualizzo solo la tavola della macchina EgtShowOnlyTable(True) ' Ripristino visualizzazione di eventuali pezzi in parcheggio ShowParkedParts() Return True End Function Friend Function SaveProject() As Boolean ' Determino nome del progetto m_nCurrProj = Math.Abs(m_nCurrProj) Dim sPath As String = m_MainWindow.GetSaveDir() & "\" & m_nCurrProj.ToString("D4") & ".nge" ' Aggiorno file Ini WritePrivateProfileString(S_GENERAL, K_LASTPROJ, m_nCurrProj.ToString(), m_MainWindow.GetIniFile()) ' Rinomino eventuale fotografia Dim nPhotoId As Integer = GetPhoto() If nPhotoId <> GDB_ID.NULL Then ' Path originale Dim sPhoto As String = String.Empty EgtGetPhotoPath(nPhotoId, sPhoto) ' Nuova path Dim sNewPhoto As String = Path.ChangeExtension(sPath, Path.GetExtension(sPhoto)) ' Se diverse, eseguo copia If Not String.Equals(sPhoto, sNewPhoto, StringComparison.InvariantCultureIgnoreCase) Then Try File.Copy(sPhoto, sNewPhoto, True) Catch ex As Exception Return False End Try End If ' Notifico a foto il cambio di path EgtChangePhotoPath(nPhotoId, sNewPhoto) End If ' Se assente, inserisco contrassegno di progetto OmagCut valido AddProjectMark() ' Eseguo If Not SaveFile(sPath) Then Return False End If ' Dichiaro progetto non modificato EgtResetModified() Return True End Function Friend Function SaveFile(ByVal sPath As String) As Boolean ' Eseguo salvataggio 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 AddProjectMark() As Integer ' Se assente, inserisco contrassegno di progetto OmagCut valido Dim nMarkId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_PROJMARK) If nMarkId = GDB_ID.NULL Then nMarkId = EgtCreateGroup(GDB_ID.ROOT) EgtSetName(nMarkId, NAME_PROJMARK) EgtSetLevel(nMarkId, GDB_LV.SYSTEM) End If Dim nReducedCut As Integer = GetPrivateProfileInt(S_MACH_NEST, K_MACH_REDUCEDCUT, 1, m_MainWindow.GetMachIniFile()) EgtSetInfo(nMarkId, INFO_REDUCEDCUT, nReducedCut) Return nMarkId End Function Friend Function SetOrderMachiningFlag() As Boolean Dim nMarkId As Integer = m_MainWindow.m_CurrentProjectPageUC.AddProjectMark() Return EgtSetInfo(nMarkId, INFO_MACHORDER, 1) End Function Friend Function ResetOrderMachiningFlag() As Boolean Dim nMarkId As Integer = m_MainWindow.m_CurrentProjectPageUC.AddProjectMark() Return EgtRemoveInfo(nMarkId, INFO_MACHORDER) End Function Friend Function GetOrderMachiningFlag() As Boolean Dim nMarkId As Integer = m_MainWindow.m_CurrentProjectPageUC.AddProjectMark() Dim nFlag As Integer If EgtGetInfo(nMarkId, INFO_MACHORDER, nFlag) Then Return (nFlag <> 0) Else Return False End If End Function Friend Sub UpdateHeightTxBx() HeightTxBx.Text = LenToString(m_dRawHeight, 2) End Sub ' Gestione fotografia della lastra 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 ' Aggiusto dati per spessore grezzo If Math.Abs(m_dRawHeight + m_dAddTable) > EPS_SMALL Then ' Coefficiente di scalatura Dim dFsca As Double = (ptCen.z - m_dRawHeight - m_dAddTable) / ptCen.z dMMxPixel *= dFsca ptOri.x = ptCen.x + (ptOri.x - ptCen.x) * dFsca ptOri.y = ptCen.y + (ptOri.y - ptCen.y) * dFsca ptOri.z = m_dRawHeight + m_dAddTable End If ' Recupero origine della tavola e porto i punti in globale Dim ptTab As Point3d If Not EgtGetTableRef(1, ptTab) Then Return False End If ptOri.ToGlob(New Frame3d(ptTab)) ptCen.ToGlob(New Frame3d(ptTab)) ' Recupero le dimensioni della tavola Dim ptMin, ptMax As Point3d If Not EgtGetTableArea(1, ptMin, ptMax) Then Return False End If ptMin.z += m_dAddTable ptMax.z += m_dAddTable ' Elimino eventuale precedente foto Dim nOldPhotoId = GetPhoto() If nOldPhotoId <> GDB_ID.NULL Then EgtErase(nOldPhotoId) End If ' 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 fotografia Return EgtAddPhoto(PHOTO_NAME, sPath, ptOri, ptCen, dMMxPixel, nPhGrpId, ptMin, ptMax) <> GDB_ID.NULL 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 refTxr 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 in globale Return EgtGetTextureFrame(nId, GDB_ID.ROOT, refTxr) End Function ' Gestione messaggi in interfaccia Friend Sub SetInfoMessage(sMessage As String) OutMessageBrd.Background = Application.Current.FindResource("OmagCut_Green") OutMessageTxBl.Text = sMessage OutMessageBrd.Visibility = Windows.Visibility.Visible End Sub Friend Sub SetWarningMessage(sMessage As String) OutMessageBrd.Background = Application.Current.FindResource("OmagCut_Yellow") OutMessageTxBl.Text = sMessage OutMessageBrd.Visibility = Windows.Visibility.Visible EgtOutLog(sMessage) End Sub Friend Sub SetErrorMessage(sMessage As String) OutMessageBrd.Background = Application.Current.FindResource("OmagCut_Red") OutMessageTxBl.Text = sMessage OutMessageBrd.Visibility = Windows.Visibility.Visible EgtOutLog(sMessage) End Sub Friend Sub ClearMessage() OutMessageBrd.Background = Brushes.Transparent OutMessageBrd.Visibility = Windows.Visibility.Hidden End Sub End Class