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 = DirectCast(Application.Current.MainWindow, 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 ' Costanti tipo progetto Friend Enum PRJ_TYPE As Integer EMPTY = 0 FLATS = 1 FRAMES = 2 End Enum 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 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(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 EgtMsgBox If m_MainWindow.IsSiemensPc Then MissingKeyWnd = New EgtMsgBox(m_MainWindow, Me.ActualWidth / 15 * 5, EgtMsgBox.WidthType.PIXEL, EgtMsg(MSG_MISSINGKEYWD + 1), EgtMsg(MSG_MISSINGKEYWD + 2) & " " & EgtMsg(MSG_MISSINGKEYWD + 3), EgtMsgBox.Buttons.OK, EgtMsgBox.Icons.NULL) Else MissingKeyWnd = New EgtMsgBox(m_MainWindow, EgtMsg(MSG_MISSINGKEYWD + 1), EgtMsg(MSG_MISSINGKEYWD + 2) & " " & EgtMsg(MSG_MISSINGKEYWD + 3), EgtMsgBox.Buttons.OK, EgtMsgBox.Icons.NULL) End If m_MainWindow.Close() End If ' Verifico abilitazione prodotto If Not m_MainWindow.GetKeyOption(MainWindow.KEY_OPT.BASE) Then Dim MissingKeyWnd As New EgtMsgBox(m_MainWindow, EgtMsg(MSG_MISSINGKEYWD + 1), EgtMsg(MSG_MISSINGKEYWD + 5), EgtMsgBox.Buttons.OK, EgtMsgBox.Icons.NULL, 1) 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 ' Nascondo progress per fotografia PhotoProgress.Visibility = Windows.Visibility.Hidden ' Carico sottopagina opportuna If GetProjectType() <> PRJ_TYPE.FRAMES Then CurrentProjectPageGrid.Children.Add(m_MainWindow.m_CadCutPageUC) m_MainWindow.m_ActivePage = MainWindow.Pages.CadCut m_MainWindow.CadCutBtn.IsChecked = True Else CurrentProjectPageGrid.Children.Add(m_MainWindow.m_FrameCutPageUC) m_MainWindow.m_ActivePage = MainWindow.Pages.FrameCut m_MainWindow.FrameCutBtn.IsChecked = True End If Else EgtSetCurrentContext(CurrentProjectScene.GetCtx()) End If ' inibisco selezione diretta da Scene CurrentProjectScene.SetStatusNull() ' Imposto dati progetto If Not IsNothing(m_MainWindow.m_CurrentMachine.CurrMat) Then MaterialTxBx.Text = m_MainWindow.m_CurrentMachine.CurrMat.sName Else MaterialTxBx.Text = "-----" End If ' Visualizzo lama e lavorazione correnti ToolTxBx.Text = m_MainWindow.m_CurrentMachine.sCurrSaw MachiningTxBx.Text = m_MainWindow.m_CurrentMachine.sCurrSawing 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 Friend 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(Optional sTabName As String = MAIN_TAB, Optional bRetainParkedParts As Boolean = False) As Boolean ' Se richiesto, conservo eventuali pezzi parcheggiati del progetto corrente Dim sTmpFiles As New ArrayList() Dim nId As Integer = If(bRetainParkedParts, EgtGetFirstPart(), GDB_ID.NULL) While nId <> GDB_ID.NULL ' Esporto il pezzo in un file temporaneo Dim sTmpFile As String = m_MainWindow.GetTempDir() & "\FlatPart" & nId & ".Nge" sTmpFiles.Add(sTmpFile) If Not EgtSaveObjToFile(nId, sTmpFile, NGE.BIN) Then Return False End If ' Passo al pezzo successivo nId = EgtGetNextPart(nId) End While ' 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(sTabName) 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 UpdateHeightTxBx() ' Recupero i pezzi parcheggiati precedentemente salvati For Each sTmpfile As String In sTmpFiles If My.Computer.FileSystem.FileExists(sTmpfile) Then ' Inserisco il pezzo EgtInsertFile(sTmpfile) ' Ne recupero l'Id Dim nId2 As Integer = EgtGetLastPart() ' Inserisco in parcheggio m_MainWindow.m_CadCutPageUC.m_NestPage.StoreOnePart(nId2, True) ' Cancello il file My.Computer.FileSystem.DeleteFile(sTmpfile) End If Next ' Dichiaro progetto non modificato EgtResetModified() Return True End Function Friend Function AdjustAdditionalTable() As Boolean ' Recupero altezza sottotavola corrente Dim nFixtId As Integer = EgtGetFirstNameInGroup(EgtGetFirstMachGroup(), MACH_FIXT_GROUP) Dim nAddTabId As Integer = EgtGetFirstNameInGroup(nFixtId, MACH_ADD_TABLE) Dim dCurrAddTab As Double = 0 If nAddTabId <> GDB_ID.NULL And Not EgtGetInfo(nAddTabId, KEY_ADD_TABLE, dCurrAddTab) Then Dim b3AddTab As New BBox3d EgtGetBBoxGlob(nAddTabId, GDB_BB.STANDARD, b3AddTab) dCurrAddTab = b3AddTab.DimZ() End If ' Se valore cambiato, aggiorno... Dim dDeltaZ As Double = m_MainWindow.m_CurrentMachine.dAdditionalTable - dCurrAddTab If Math.Abs(dDeltaZ) > EPS_SMALL Then AddAdditionalTable() UpdateAllRawsZ(dDeltaZ) If GetPhoto() <> GDB_ID.NULL Then UpdatePhoto() If EgtGetRawPartCount() > 0 Then ShowPhoto(False) End If End If End If Return True End Function Friend Function AddAdditionalTable() As Boolean ' Gruppo dei sottopezzi Dim nFixtId As Integer = EgtGetFirstNameInGroup(EgtGetFirstMachGroup(), MACH_FIXT_GROUP) ' Elimino eventuale vecchia tavola dal gruppo dei bloccaggi EgtErase(EgtGetFirstNameInGroup(nFixtId, MACH_ADD_TABLE)) ' Altezza eventuale tavola aggiuntiva Dim dAddTable As Double = m_MainWindow.m_CurrentMachine.dAdditionalTable ' Se non esiste sovratavola, esco subito If dAddTable < 10 * EPS_SMALL Then Return True ' Recupero box tavola Dim ptMin, ptMax As Point3d EgtGetTableArea(1, ptMin, ptMax) ' Aggiungo sovratavola nel gruppo dei bloccaggi ptMax.z -= DELTAZ_ADDTAB ptMin.z = ptMax.z ptMax.z += dAddTable Dim nAddTabId As Integer = EgtCreateSurfTmBBox(nFixtId, ptMin, ptMax, GDB_RT.GLOB) If nAddTabId = GDB_ID.NULL Then Return False EgtSetName(nAddTabId, MACH_ADD_TABLE) EgtSetColor(nAddTabId, New Color3d(150, 75, 0, 100), True) EgtSetInfo(nAddTabId, KEY_ADD_TABLE, dAddTable) 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 (è il primo con fase 1) m_nRawId = EgtGetFirstRawPart() While m_nRawId <> GDB_ID.NULL And Not EgtVerifyRawPartPhase(m_nRawId, 1) m_nRawId = EgtGetNextRawPart(m_nRawId) End While m_MainWindow.m_CadCutPageUC.m_NestPage.CalcRawPart() ' aggiorno spessore grezzo m_dRawHeight = GetRawHeight() UpdateHeightTxBx() ' 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 ' Se la macchina del file è quella impostata If String.Compare(sFileMachine, m_MainWindow.GetCurrMachine(), True) = 0 Then AdjustAdditionalTable() ' altrimenti avverto, porto i pezzi in parcheggio e cancello il grezzo Else ' Emetto messaggio Dim sOut As String = EgtMsg(90320) & " (" & sFileMachine & ")" ' Macchina diversa SetErrorMessage(sOut) ' Cancello il gruppo di lavoro EgtRemoveMachGroup(nMachGrpId) ' Cancello eventuale foto EgtErase(GetPhoto()) ' Cancello eventuali preview rimaste nei pezzi ' (cancellare tramite cancellazione lavorazioni può non essere sufficiente) RemovePreviewFromParts() ' Creo un nuovo gruppo di lavoro con la macchina corrente If EgtAddMachGroup(MACH_GROUP, m_MainWindow.GetCurrMachine()) = GDB_ID.NULL Then Return False ' Imposto la tavola corrente If Not EgtSetTable(MAIN_TAB) Then Return False ' Aggiungo eventuale sovratavola AddAdditionalTable() End If ' Visualizzo solo la tavola della macchina EgtShowOnlyTable(True) ' Nascondo tutte le lavorazioni HideAllMachinings() ' 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) ' Altrimenti cancello eventuali file di foto associabili al progetto Else Dim sPhoto1 As String = Path.ChangeExtension(sPath, "jpg") Dim sPhoto2 As String = Path.ChangeExtension(sPath, "png") Try If My.Computer.FileSystem.FileExists(sPhoto1) Then My.Computer.FileSystem.DeleteFile(sPhoto1) End If If My.Computer.FileSystem.FileExists(sPhoto2) Then My.Computer.FileSystem.DeleteFile(sPhoto2) End If Catch ex As Exception End Try End If ' Se assente, inserisco contrassegno di progetto OmagCut valido AddProjectMark() ' Assegno indice di progetto e materiale SetProjectIndexFlag() SetProjectMaterial() ' 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) ' Nascondo le lavorazioni HideAllMachinings() ' Ripristino visualizzazione di eventuali pezzi in parcheggio (save li nasconde) ShowParkedParts() Return bOk End Function Friend Function SaveNamedProject() As Boolean ' Determino nome del progetto Dim CurrProjName As String = String.Empty GetPrivateProfileString(S_GENERAL, K_LASTNAMEPROJ, "", CurrProjName, m_MainWindow.GetIniFile()) ' Se nome vuoto, non salvo If String.IsNullOrEmpty(CurrProjName) Then Return False End If Dim sPath As String = m_MainWindow.GetNamedSaveDir() & "\" & CurrProjName & ".nge" ' 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 GetCurrentProjectName() As String Dim CurrProjName As String = String.Empty GetPrivateProfileString(S_GENERAL, K_LASTNAMEPROJ, "", CurrProjName, m_MainWindow.GetIniFile()) If Not String.IsNullOrEmpty(CurrProjName) Then CurrProjName &= ".nge (" & Math.Abs(m_nCurrProj).ToString("D4") & ")" Else CurrProjName = Math.Abs(m_nCurrProj).ToString("D4") & ".nge" End If Return CurrProjName End Function Private Function GetProjectType() As Integer ' Se non c'è grezzo, è vuoto Dim nRawId As Integer = EgtGetFirstRawPart() If nRawId = GDB_ID.NULL Then Return PRJ_TYPE.EMPTY ' Cerco un pezzo parcheggiato o nel grezzo Dim nPartId As Integer = EgtGetFirstPart() While nPartId <> GDB_ID.NULL Dim sTemp As String = String.Empty If Not EgtGetName(nPartId, sTemp) OrElse String.Compare(sTemp, NAME_COPYTEMPLATE, True) <> 0 Then Exit While nPartId = EgtGetNextPart(nPartId) End While If nPartId = GDB_ID.NULL Then nPartId = EgtGetFirstPartInRawPart(nRawId) ' Se non ci sono pezzi, è vuoto If nPartId = GDB_ID.NULL Then Return PRJ_TYPE.EMPTY ' Verifico il tipo di pezzo Dim sName As String = String.Empty If EgtGetName(nPartId, sName) AndAlso sName = NAME_FRAME Then Return PRJ_TYPE.FRAMES Else Return PRJ_TYPE.FLATS End If End Function Friend Function GetCurrentProjectType() As Integer ' Imposto contesto del progetto corrente Dim nOldCtx As Integer = EgtGetCurrentContext() Dim nNewCtx As Integer = CurrentProjectScene.GetCtx() If nOldCtx <> nNewCtx Then EgtSetCurrentContext(nNewCtx) ' Recupero il tipo di progetto Dim nPrjType As Integer = GetProjectType() ' Reimposto contesto originale If nOldCtx <> nNewCtx Then EgtSetCurrentContext(nOldCtx) ' Restituisco il risultato Return nPrjType End Function Friend Function RemovePreviewFromParts() As Boolean ' Processo i sottogruppi, se di livello System li rimuovo Dim nGrpId As Integer = EgtGetFirstGroupInGroup(GDB_ID.ROOT) While nGrpId <> GDB_ID.NULL ' Ciclo sui sottogruppi Dim nSubId As Integer = EgtGetFirstGroupInGroup(nGrpId) While nSubId <> GDB_ID.NULL ' Recupero il prossimo sottogruppo Dim nNextSubId = EgtGetNextGroup(nSubId) ' Verifico il livello, eventuale cancellazione Dim nLevel As Integer = GDB_LV.USER EgtGetLevel(nSubId, nLevel) If nLevel = GDB_LV.SYSTEM Then EgtErase(nSubId) End If nSubId = nNextSubId End While ' Passo al prossimo gruppo nGrpId = EgtGetNextGroup(nGrpId) End While Return True 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) Dim nReducedCut As Integer = GetPrivateProfileInt(S_MACH_NEST, K_MACH_REDUCEDCUT, 1, m_MainWindow.GetMachIniFile()) EgtSetInfo(nMarkId, INFO_REDUCEDCUT, nReducedCut) End If Return nMarkId End Function Friend Function SetOrderMachiningFlag() As Boolean Dim nMarkId As Integer = AddProjectMark() Return EgtSetInfo(nMarkId, INFO_MACHORDER, 1) End Function Friend Function ResetOrderMachiningFlag() As Boolean Dim nMarkId As Integer = AddProjectMark() Return EgtRemoveInfo(nMarkId, INFO_MACHORDER) End Function Friend Function GetOrderMachiningFlag() As Boolean Dim nMarkId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_PROJMARK) Dim nFlag As Integer = 0 EgtGetInfo(nMarkId, INFO_MACHORDER, nFlag) Return (nFlag <> 0) End Function Friend Function SetProjectIndexFlag() As Boolean Dim nMarkId As Integer = AddProjectMark() Return EgtSetInfo(nMarkId, INFO_PROJINDEX, Math.Abs(m_nCurrProj)) End Function Friend Function SetProjectMaterial() As Boolean Dim nMarkId As Integer = AddProjectMark() Return EgtSetInfo(nMarkId, INFO_PROJMAT, m_MainWindow.m_CurrentMachine.CurrMat.sName) End Function Friend Function SetProjectNcProgSent(nNcProg As Integer) As Boolean Dim nMarkId As Integer = AddProjectMark() Return EgtSetInfo(nMarkId, INFO_NCPROGSENT, nNcProg) End Function Friend Function GetProjectNcProgSent() As Integer Dim nMarkId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_PROJMARK) Dim nNcSent As Integer = 0 EgtGetInfo(nMarkId, INFO_NCPROGSENT, nNcSent) Return nNcSent End Function Friend Sub UpdateHeightTxBx() HeightTxBx.Text = LenToString(m_dRawHeight, 3) End Sub Friend Sub UpdateMachiningTxBx() MachiningTxBx.Text = m_MainWindow.m_CurrentMachine.sCurrSawing 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 ' Altezza eventuale tavola aggiuntiva Dim dAddTable As Double = m_MainWindow.m_CurrentMachine.dAdditionalTable ' Aggiusto dati per spessore grezzo If Math.Abs(m_dRawHeight + dAddTable) > EPS_SMALL Then ' Coefficiente di scalatura Dim dFsca As Double = (ptCen.z - m_dRawHeight - dAddTable) / (ptCen.z - ptOri.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 + 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 ' 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 UpdatePhoto() As Boolean ' Verifico esistenza oggetto foto Dim nPhotoId As Integer = GetPhoto() If nPhotoId = GDB_ID.NULL Then Return False ' Verifico esistenza texture della foto Dim sPath As String = String.Empty EgtGetPhotoPath(nPhotoId, sPath) If Not File.Exists(sPath) Then Return False End If ' Recupero i dati aggiuntivi della foto Dim ptOri As New Point3d(0, 0, 0) EgtGetPhotoOrigin(nPhotoId, ptOri) Dim ptCen As New Point3d(0, 0, 1) EgtGetPhotoCenter(nPhotoId, ptCen) Dim dMMxPixel As Double = 1 EgtGetPhotoMMxPixel(nPhotoId, dMMxPixel) ' Recupero origine della tavola Dim ptTab As Point3d If Not EgtGetTableRef(1, ptTab) Then Return False End If ' Porto i punti in locale ptOri.ToLoc(New Frame3d(ptTab)) ptCen.ToLoc(New Frame3d(ptTab)) ' Altezza eventuale tavola aggiuntiva Dim dAddTable As Double = m_MainWindow.m_CurrentMachine.dAdditionalTable ' Aggiusto dati per spessore grezzo (Coefficiente di scalatura) Dim dFsca As Double = (ptCen.z - m_dRawHeight - dAddTable) / (ptCen.z - ptOri.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 + dAddTable ' Porto i punti in globale 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 ' 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, Optional bDisableModified As Boolean = True) As Boolean ' Recupero la foto Dim nId As Integer = GetPhoto() If nId = GDB_ID.NULL Then Return False ' Se richiesto, disabilito impostazione modificato Dim bOldEnMod As Boolean = False If bDisableModified Then bOldEnMod = EgtGetEnableModified() If bOldEnMod Then EgtDisableModified() End If ' Ne cambio lo stato Dim bOk As Boolean = EgtSetStatus(nId, If(bShow, GDB_ST.ON_, GDB_ST.OFF)) ' Se necessario, ripristino precedente impostazione modificato If bOldEnMod Then EgtEnableModified() Return bOk 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