Imports System.Collections.ObjectModel Imports System.IO Imports EgtUILib Imports EgtWPFLib Imports System.ComponentModel Imports System.Threading Imports System.Windows.Threading Imports System.Windows.Forms Class MainWindow ' Mutex per avere una sola istanza del programma in esecuzione Private m_objMutex As New Mutex ' Pagine e bottoni Private m_OptionsPageUC As OptionsPageUC Private m_SceneButtons As SceneButtonsUC ' Variabili direttori Private m_sDataRoot As String = String.Empty Private m_sConfigDir As String = String.Empty Private m_sTempDir As String = String.Empty Private m_sMachinesRoot As String = String.Empty Private m_sProjDir As String = String.Empty Private m_sIniFile As String = String.Empty Private m_nDebug As Integer = 0 Private m_sVersion As String = "1.1a1" ' Variabile con la lingua corrente Friend m_CurrLanguage As Language ' Lista delle lingue disponibili e lingua corrente Friend m_LanguagesList As New List(Of Language) ' Macchina corrente Private m_sCurrMachine As String = String.Empty ' Indice progetto corrente Private m_nProjInd As Integer = 0 ' Flag di ultimo progetto trasmesso Private m_bLastProj As Boolean = False ' Variabile con il tema corrente Friend m_CurrTheme As Integer = 0 ' Livello della licenza attiva associata alla chiave Private m_nKeyLevel As Integer = 0 ' Opzioni abilitate dalla licenza attiva associata alla chiave Private m_nKeyOptions As UInteger Friend Enum KEY_OPT As UInteger BASE = 1 MAN_MANIP = 2 AUTO_MANIP = 4 MAN_PHOTO = 8 AUTO_PHOTO = 16 AUTO_NESTING = 32 ENABLE_MILL = 64 PROCUCTION_LINE = 128 End Enum ' Scene Friend WithEvents CurrentProjectScene As New Scene Private CurrentProjectSceneHost As New System.Windows.Forms.Integration.WindowsFormsHost Friend m_nTopViewRotStep As Integer = 0 ' Timer per aggiornamento interfaccia Private m_IdleTimer As New DispatcherTimer(DispatcherPriority.ApplicationIdle) ' Timero per reset dei messaggi Private m_DelayTimerMsg As New DispatcherTimer(DispatcherPriority.ApplicationIdle) ' Lista dei pezzi attivi Private m_vParts As New List(Of Integer) ' percorso file template per stampante Friend m_TemplateFilePrinter As String ' percorso file template per stampante (disegnod della freccia per indicare il TOP del pezzo) Friend m_TemplateFileArrowPrinter As String ' percorso direttorio per stampa file ini Private m_DatDirPrinter As String ' percorso eseguibile per stampante zebra Private m_ZebraUtilitiesExe As String Public Function GetIniFile() As String Return m_sIniFile End Function Public Function GetTempDir() As String Return m_sTempDir End Function Public Function GetMachinesRootDir() As String Return m_sMachinesRoot End Function Public Function GetProjectDir() As String Return m_sProjDir End Function Public Function GetCurrMachine() As String Return m_sCurrMachine End Function Friend Function GetKeyOption(nKeyOpt As KEY_OPT) As Boolean Return m_nKeyOptions And nKeyOpt End Function Friend Function GetKeyOptions() As UInteger Return m_nKeyOptions End Function Friend Function GetVersion() As String Return m_sVersion End Function Private Sub MainWindow_Initialized(sender As Object, e As EventArgs) Handles Me.Initialized ' Verifico sia l'unica istanza ManageSingleIstance() ' Impostazione path radice per i dati m_sDataRoot = System.AppDomain.CurrentDomain.BaseDirectory If GetPrivateProfileString(S_DATA, K_DATAROOT, "", m_sDataRoot, m_sDataRoot & "\" & DAT_FILE_NAME) = 0 Then m_sDataRoot = System.AppDomain.CurrentDomain.BaseDirectory End If ' Impostazione direttorio di configurazione m_sConfigDir = m_sDataRoot & "\" & CONF_DIR ' Impostazione direttorio per file temporanei m_sTempDir = m_sDataRoot & "\" & TEMP_DIR ' Impostazione path Ini file m_sIniFile = m_sConfigDir & "\" & INI_FILE_NAME ' Impostazione direttorio per le macchine If GetPrivateProfileString(S_MACH, K_MACHINESDIR, "", m_sMachinesRoot, m_sIniFile) = 0 Then m_sMachinesRoot = m_sDataRoot & "\" & MACHINES_DFL_DIR End If ' Recupero nome macchina corrente GetPrivateProfileString(S_MACH, K_CURRMACH, "", m_sCurrMachine, m_sIniFile) ' Impostazione direttorio per progetto corrente If GetPrivateProfileString(S_GENERAL, K_PROJDIR, "", m_sProjDir, m_sIniFile) = 0 Then m_sProjDir = m_sDataRoot & "\" & PROJ_DFL_DIR End If ' Imposto tipo di chiave EgtSetLockType(KEY_TYPE.ANY) ' Leggo e imposto chiave di protezione Dim sLicFileName As String = String.Empty GetPrivateProfileString(S_GENERAL, K_LICENCE, LIC_FILE_NAME, sLicFileName, m_sIniFile) Dim sLicFile As String = m_sConfigDir & "\" & sLicFileName Dim sKey As String = String.Empty GetPrivateProfileString(S_LICENCE, K_KEY, "", sKey, sLicFile) EgtSetKey(sKey) ' Inizializzazione generale di EgtInterface m_nDebug = GetPrivateProfileInt(S_GENERAL, K_DEBUG, 0, m_sIniFile) m_sVersion = My.Application.Info.Version.Major.ToString() & "." & My.Application.Info.Version.Minor.ToString() & (ChrW(97 - 1 + My.Application.Info.Version.Build)).ToString() & My.Application.Info.Version.Revision.ToString() Dim sLogFile As String = m_sTempDir & "\" & GENLOG_FILE_NAME Dim sLogMsg As String = My.Application.Info.Description.ToString() & " ver. " & m_sVersion EgtInit(m_nDebug, sLogFile, sLogMsg) ' Leggo tema dal file ini m_CurrTheme = GetPrivateProfileInt(S_GENERAL, K_THEME, 0, GetIniFile) Dim app As Application = Application.Current If (m_CurrTheme = 0) Then app.ChangeTheme(New Uri("/OmagVIEW;component/OmagVIEWDictionary.xaml", UriKind.Relative)) End If If (m_CurrTheme = 1) Then app.ChangeTheme(New Uri("/OmagView;component/OmagViewDarkDictionary.xaml", UriKind.Relative)) Application.Current.Resources("GroupBox_CornerRadius") = 3 Application.Current.Resources("Button_CornerRadius") = 3 Application.Current.Resources("EmptyBorder_CornerRadius") = New CornerRadius(3) End If ' Leggo direttorio dei messaggi (se manca uso direttorio di configurazione) Dim sMsgDir As String = String.Empty If GetPrivateProfileString(S_GENERAL, K_MESSAGESDIR, "", sMsgDir, m_sIniFile) = 0 Then sMsgDir = m_sConfigDir End If ' Leggo elenco lingue disponibili da file ini Dim nIndex As Integer = 1 Dim ReadLanguage As Language = GetPrivateProfileLanguage(S_LANGUAGES, K_LANGUAGE & nIndex, GetIniFile) While Not IsNothing(ReadLanguage) m_LanguagesList.Add(ReadLanguage) nIndex += 1 ReadLanguage = GetPrivateProfileLanguage(S_LANGUAGES, K_LANGUAGE & nIndex, GetIniFile) End While ' Leggo file messaggi Dim sMsgFile As String = String.Empty GetPrivateProfileString(S_GENERAL, K_MESSAGES, "", sMsgFile, m_sIniFile) For i As Integer = 0 To m_LanguagesList.Count - 1 If m_LanguagesList(i).LanguageName = sMsgFile Then m_CurrLanguage = m_LanguagesList(i) End If Next Dim sMsgFilePath As String = sMsgDir & "\EgalTechIta.txt" If Not IsNothing(m_CurrLanguage) Then sMsgFilePath = sMsgDir & "\" & m_CurrLanguage.FileName End If If Not EgtLoadMessages(sMsgFilePath) Then EgtOutLog("Error in EgtLoadMessages") End If Dim sNfeDir As String = String.Empty GetPrivateProfileString(S_GEOMDB, K_NFEFONTDIR, "", sNfeDir, m_sIniFile) Dim sDefFont As String = String.Empty GetPrivateProfileString(S_GEOMDB, K_DEFAULTFONT, "", sDefFont, m_sIniFile) EgtSetFont(sNfeDir, sDefFont) ' leggo nome file prn (per stampante zebra) GetPrivateProfileString(S_PRINTER, K_TEMPLATE, m_sDataRoot & "\Label\Default.prn", m_TemplateFilePrinter, m_sIniFile) GetPrivateProfileString(S_PRINTER, K_TEMPLATE_ARROW, m_sDataRoot & "\Label\DefaultArrow.prn", m_TemplateFileArrowPrinter, m_sIniFile) ' leggo nome del direttorio in cui scrivere il file ini (per stampante zebra) GetPrivateProfileString(S_PRINTER, K_DAT, m_sDataRoot & "\Temp", m_DatDirPrinter, m_sIniFile) ' leggo nome file exe (per stampante zebra) GetPrivateProfileString(S_PRINTER, K_ZEBRAUTILITIES, System.AppDomain.CurrentDomain.BaseDirectory & "ZebraPrinterUtilitiesR32.exe", m_ZebraUtilitiesExe, m_sIniFile) ' Recupero opzioni della chiave Dim bKey As Boolean = EgtGetKeyLevel(9423, 2602, 1, m_nKeyLevel) And EgtGetKeyOptions(9423, 2602, 1, m_nKeyOptions) EgtOutLog("KeyOptions : " & bKey.ToString() & " " & m_nKeyOptions.ToString()) ' Imposto dir di default per libreria Lua e lancio libreria di base Dim sLuaLibsDir As String = String.Empty GetPrivateProfileString(S_LUA, K_LIBSDIR, "", sLuaLibsDir, m_sIniFile) EgtSetLuaLibs(sLuaLibsDir) Dim sLuaBaseLib As String = String.Empty GetPrivateProfileString(S_LUA, K_BASELIB, "EgtBase", sLuaBaseLib, m_sIniFile) EgtLuaRequire(sLuaBaseLib) ' Imposto unità di misura per interfaccia utente Dim bMM As Boolean = (GetPrivateProfileInt(S_GENERAL, K_MMUNITS, 1, m_sIniFile) <> 0) EgtSetUiUnits(bMM) ' Imposto posizione e dimensioni della MainWindow Dim nFlag As Integer Dim nLeft As Integer Dim nTop As Integer Dim nWidth As Integer Dim nHeight As Integer GetPrivateProfileWinPos(S_GENERAL, K_WINPLACE, nFlag, nLeft, nTop, nWidth, nHeight, m_sIniFile) Me.WindowStartupLocation = Windows.WindowStartupLocation.Manual Me.Top = nTop Me.Left = nLeft Me.Height = nHeight Me.Width = nWidth WindowState = If(nFlag = 1, WindowState.Maximized, WindowState.Normal) ' Inizializzazione della libreria EgtWPFLib EgtWPFInit() ' Disabilita la possibilità di imitare il click del tasto destro del mouse tenendo premuto il dito sul touch ' NB: Se abilitato impedisce di utilizzare lo stato Pressed dei Button che quindi non si evidenziano quando premuti Stylus.SetIsPressAndHoldEnabled(Me, False) 'Assegnazione scena all'host e posizionamento nella PlacePageGrid CurrentProjectSceneHost.Child = CurrentProjectScene CurrentProjectSceneHost.SetValue(Grid.ColumnProperty, 1) CurrentProjectSceneHost.SetValue(Grid.RowProperty, 1) Me.SceneGrid.Children.Add(CurrentProjectSceneHost) 'Creazione delle Page UserControl m_SceneButtons = New SceneButtonsUC ' Messaggi sui bottoni OkAllBtn.Content = EgtMsg(91301) 'Pezzi Tutti Validi OkPartBtn.Content = EgtMsg(91302) 'Pezzo Valido RuinedPartBtn.Content = EgtMsg(91303) 'Pezzo Rovinato PrintBtn.Content = EgtMsg(91306) 'Stampa LabelBtn.Content = EgtMsg(91304) 'Stampa Etichetta ConfirmBtn.Content = EgtMsg(91305) 'Conferma ' Abilitazione stampa etichetta LabelBtn.IsEnabled = GetPrivateProfileInt(S_PRINTER, K_ENABLEPRINTER, 0, m_sIniFile) <> 0 ' Visualizzazione bottoni Prev/Next If GetPrivateProfileInt(S_GENERAL, K_PREVNEXTPROJ, 0, m_sIniFile) = 0 Then PrevNextGrid.Visibility = Windows.Visibility.Hidden Else PrevNextGrid.Visibility = Windows.Visibility.Visible End If ' Imposto OnIdle AddHandler m_IdleTimer.Tick, AddressOf OnIdle ' Imposto "Maniglia" per la gestione dell'evento di pulizia dei messaggi AddHandler m_DelayTimerMsg.Tick, AddressOf RefreshErrorMsgPrinter End Sub Private Sub ManageSingleIstance() Dim bCreated As Boolean Try m_objMutex = New Mutex(False, "Global\OmagView", bCreated) Catch bCreated = False End Try If Not bCreated Then ' porto in primo piano la prima istanza Dim bFound As Boolean = False ' processi del programma a 32 bit Dim localProc As Process() = Process.GetProcessesByName("OmagViewR32") For Each p As Process In localProc If p.Id <> Process.GetCurrentProcess().Id Then bFound = True ShowWindow(p.MainWindowHandle, 1) Exit For End If Next ' se non trovati processi a 32 bit provo a 64 bit If Not bFound Then localProc = Process.GetProcessesByName("OmagViewR64") For Each p As Process In localProc If p.Id <> Process.GetCurrentProcess().Id Then bFound = True ShowWindow(p.MainWindowHandle, SW.RESTORE) Exit For End If Next End If ' esco dal programma End End If End Sub Private Sub MainWindow_Loaded(ByVal sender As Object, ByVal e As RoutedEventArgs) Handles Me.Loaded ' imposto colore di default Dim DefColor As New Color3d(0, 0, 0) GetPrivateProfileColor(S_GEOMDB, K_DEFAULTCOLOR, DefColor, GetIniFile()) CurrentProjectScene.SetDefaultMaterial(DefColor) ' imposto colori sfondo Dim BackTopColor As New Color3d(211, 211, 211) Dim sBackTop As String = K_BACKTOP If m_CurrTheme = 1 Then sBackTop &= "1" GetPrivateProfileColor(S_SCENE, sBackTop, BackTopColor, GetIniFile()) Dim BackBotColor As New Color3d(211, 211, 211) Dim sBackBottom As String = K_BACKBOTTOM If m_CurrTheme = 1 Then sBackBottom &= "1" GetPrivateProfileColor(S_SCENE, sBackBottom, BackBotColor, GetIniFile()) CurrentProjectScene.SetViewBackground(BackTopColor, BackBotColor) ' imposto colore di evidenziazione Dim MarkColor As New Color3d(255, 255, 0) GetPrivateProfileColor(S_SCENE, K_MARK, MarkColor, GetIniFile()) CurrentProjectScene.SetMarkMaterial(MarkColor) ' imposto colore per superfici selezionate Dim SelSurfColor As New Color3d(255, 255, 192) GetPrivateProfileColor(S_SCENE, K_SELSURF, SelSurfColor, 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, 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, GetIniFile()) CurrentProjectScene.SetDistLineMaterial(DstLnColor) ' imposto parametri OpenGL Dim nDriver As Integer = GetPrivateProfileInt(S_OPENGL, K_DRIVER, 3, GetIniFile()) Dim b2Buff As Boolean = (GetPrivateProfileInt(S_OPENGL, K_DOUBLEBUFFER, 1, GetIniFile()) <> 0) Dim nColorBits As Integer = GetPrivateProfileInt(S_OPENGL, K_COLORBITS, 32, GetIniFile()) Dim nDepthBits As Integer = GetPrivateProfileInt(S_OPENGL, K_DEPTHBITS, 32, 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.SceneGrid.Children.Remove(CurrentProjectSceneHost) Dim MissingKeyWnd As EgtMsgBox ' Se manca la chiave (non può accadere perchè ammessa anche chiave software) If m_nKeyLevel = -1 Or m_nKeyLevel = -2 Then EgtOutLog("Missing Dongle") ' Box di avviso chiave mancante : "Chiave non presente. \n Inserirla e riavviare il programma." "Errore" Dim sText As String = EgtMsg(MSG_MISSINGKEYWD + 2) & vbCrLf & EgtMsg(MSG_MISSINGKEYWD + 3) Dim sTitle As String = EgtMsg(MSG_MISSINGKEYWD + 1) MissingKeyWnd = New EgtMsgBox(Me, EgtMsg(MSG_MISSINGKEYWD + 1), EgtMsg(MSG_MISSINGKEYWD + 2) & " " & EgtMsg(MSG_MISSINGKEYWD + 3), EgtMsgBox.Buttons.OK, EgtMsgBox.Icons.NULL) ' Altrimenti manca la licenza Else EgtOutLog("Problems with Licence") ' Box di avviso licenza con problemi : "Programma senza licenza. \n Caricala e riavvia il programma." "Errore" Dim sKeyInfo As String = "" : EgtGetKeyInfo(sKeyInfo) Dim sText As String = sKeyInfo & vbCrLf & EgtMsg(MSG_MISSINGKEYWD + 5) & vbCrLf & EgtMsg(MSG_MISSINGKEYWD + 6) Dim sTitle As String = EgtMsg(MSG_MISSINGKEYWD + 1) MissingKeyWnd = New EgtMsgBox(Me, sTitle, sText, EgtMsgBox.Buttons.OK, EgtMsgBox.Icons.NULL, 2, 2) If MissingKeyWnd.DialogResult = True Then ' Apro dialogo per richiesta file licenza Dim LicDlg As New Microsoft.Win32.OpenFileDialog() With { .DefaultExt = ".lic", .Filter = "Licences (.lic)|*.lic", .CheckFileExists = True, .ValidateNames = True } If LicDlg.ShowDialog() = True Then ' Recupero il direttorio del file Dim sDir As String = System.IO.Path.GetDirectoryName(LicDlg.FileName) ' Se il file non è già nel direttorio di configurazione lo copio If Not String.Equals(System.IO.Path.GetFullPath(sDir), System.IO.Path.GetFullPath(m_sConfigDir), StringComparison.OrdinalIgnoreCase) Then Try System.IO.File.Copy(LicDlg.FileName, System.IO.Path.Combine(m_sConfigDir, LicDlg.SafeFileName), True) Catch ex As Exception End Try End If ' Imposto il nuovo file di licenza nell'Ini WritePrivateProfileString(S_GENERAL, K_LICENCE, LicDlg.SafeFileName, GetIniFile()) End If End If End If Me.Close() End If ' dimensione lineare max in pixel delle textures Dim nTxrMaxLinPix As Integer = GetPrivateProfileInt(S_SCENE, K_TEXMAXLINPIX, 4096, GetIniFile()) EgtSetTextureMaxLinPixels(nTxrMaxLinPix) ' Leggo angolo rotazione vista top m_nTopViewRotStep = GetPrivateProfileInt(S_SCENE, K_TOPVIEWROTSTEP, 0, GetIniFile()) ' Inizializzo gestore lavorazioni EgtInitMachMgr(GetMachinesRootDir(), "") ' Carico progetto in scarico Dim sProjNew As String = m_sProjDir & "\" & CURR_PROJ_NEW Dim sProjLock As String = m_sProjDir & "\" & CURR_PROJ_LOCK If LoadProject() Then ' Se c'è file segnalazione nuovo lo trasformo in segnalazione bloccato If My.Computer.FileSystem.FileExists(sProjNew) Then ' Rinomino segnalazione nuovo in segnalazione blocco My.Computer.FileSystem.MoveFile(sProjNew, sProjLock, True) End If Else NewProject() ' Rimuovo eventuale segnalazione di nuovo If My.Computer.FileSystem.FileExists(sProjNew) Then My.Computer.FileSystem.DeleteFile(sProjNew) End If ' Rimuovo eventuale segnalazione di bloccato If My.Computer.FileSystem.FileExists(sProjLock) Then My.Computer.FileSystem.DeleteFile(sProjLock) End If End If ' Leggo stato progetto ReadStatus() ' Gestisco blocco su ultimo inviato UpdateLockOnLast() ' Aggiorno la visualizzazione EgtSetGenericView(0, (m_nTopViewRotStep - 1) * 90) EgtZoom(ZM.ALL) ' Aggiorno visualizzazione nome progetto ClearMessage() ' Aggiorno abilitazione bottoni UpdateBtns() ' inibisco selezione diretta da Scene CurrentProjectScene.SetStatusNull() 'Posizionemento nella griglia delle Page UserControl m_SceneButtons.SetValue(Grid.ColumnProperty, 1) MainTabGrid.Children.Add(m_SceneButtons) ' Lancio timer per aggiornamento interfaccia m_IdleTimer.Interval = TimeSpan.FromMilliseconds(100) m_IdleTimer.Start() End Sub Private Sub MainWindow_PreviewMouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseDown End Sub Private Sub OnKeyDownHandler(ByVal sender As Object, ByVal e As KeyEventArgs) 'If (m_NumericKeyboardWD.IsVisible And e.Key = Key.Enter) Then ' m_NumericKeyboardWD.Visibility = Windows.Visibility.Hidden 'End If End Sub Private Sub OnMyMouseDownScene(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles CurrentProjectScene.OnMouseDownScene ' Si può selezionare solo con il tasto sinistro e se stato NULL If e.Button <> Windows.Forms.MouseButtons.Left Or Not CurrentProjectScene.IsStatusNull() Then Return End If ' Verifico se selezionato indicativo di pezzo EgtSetObjFilterForSelect(True, True, True, True, True) Dim nSel As Integer EgtSelect(e.Location, Scene.DIM_SEL, Scene.DIM_SEL, nSel) Dim nId As Integer = EgtGetFirstObjInSelWin() While nId <> GDB_ID.NULL ' Recupero l'identificativo del pezzo cui appartiene Dim nPartId As Integer = EgtGetParent(EgtGetParent(nId)) ' Verifico sia un pezzo attivo Dim bIsPart As Boolean = (m_vParts.FindIndex(Function(x) x = nPartId) >= 0) If bIsPart Then Dim nStat As Integer = GDB_ST.ON_ EgtGetStatus(nPartId, nStat) ' Se già selezionato deseleziono If nStat = GDB_ST.SEL Then EgtDeselectObj(nPartId) ' Altrimenti seleziono Else If Not (Keyboard.Modifiers And ModifierKeys.Control) > 0 Then EgtDeselectAll() End If EgtSelectObj(nPartId) End If EgtDraw() Exit While End If nId = EgtGetNextObjInSelWin() End While End Sub Private Sub OkAllBtn_Click(sender As Object, e As RoutedEventArgs) Handles OkAllBtn.Click ' Dichiaro validi tutti i pezzi For Each nPartId As Integer In m_vParts SetPartStatus(nPartId, True) Next ' Aggiorno la visualizzazione EgtDeselectAll() EgtDraw() ' Aggiorno abilitazione bottoni UpdateBtns() End Sub Private Sub OkPartBtn_Click(sender As Object, e As RoutedEventArgs) Handles OkPartBtn.Click If SetPartStatus(EgtGetFirstSelectedObj(), True) Then ' Aggiorno la visualizzazione EgtDeselectAll() EgtDraw() ' Aggiorno abilitazione bottoni UpdateBtns() End If End Sub Private Sub RuinedPartBtn_Click(sender As Object, e As RoutedEventArgs) Handles RuinedPartBtn.Click If SetPartStatus(EgtGetFirstSelectedObj(), False) Then ' Aggiorno la visualizzazione EgtDeselectAll() EgtDraw() ' Aggiorno abilitazione bottoni UpdateBtns() End If End Sub Private Function SetPartStatus(nPartId As Integer, bOk As Boolean) As Boolean ' Verifico esistenza If nPartId = GDB_ID.NULL Then Return False ' Cerco layer regione Dim nRegId = EgtGetFirstNameInGroup(nPartId, NAME_REGION) If nRegId = GDB_ID.NULL Then Return False ' Cerco prima regione nel layer Dim nId = EgtGetFirstInGroup(nRegId) While nId <> GDB_ID.NULL If EgtGetType(nId) = GDB_TY.SRF_FRGN Then If bOk Then EgtSetColor(nId, New Color3d(0, 255, 0, 80)) ' Verde Else EgtSetColor(nId, New Color3d(255, 0, 0, 80)) ' Rosso End If Exit While End If nId = EgtGetNext(nId) End While ' Se non trovato, errore If nId = GDB_ID.NULL Then Return False ' Assegno stato a pezzo EgtSetInfo(nPartId, INFO_PARTOK, If(bOk, "1", "0")) Return True End Function Private Sub PrintBtn_Click(sender As Object, e As RoutedEventArgs) Handles PrintBtn.Click Dim printDlg As New System.Windows.Controls.PrintDialog() Dim SM_Select As SM = SM.SHADING If (Keyboard.Modifiers And ModifierKeys.Control) > 0 Then SM_Select = SM.HIDDENLINE End If If printDlg.ShowDialog() Then ' Recupero le dimensioni dell'area di stampa Dim dW As Double = printDlg.PrintableAreaWidth Dim dH As Double = printDlg.PrintableAreaHeight ' Nascondo la tavola ed eseguo zoom su quello che rimane Dim nTabId As Integer = EgtGetTableId(MAIN_TAB) EgtSetStatus(nTabId, GDB_ST.OFF) EgtZoom(ZM.ALL, False) ' Prendo l'immagine per la stampa Dim colWhite As New Color3d(255, 255, 255) Dim nImgW As Integer = 4000 Dim nImgH As Integer = 2400 Dim sPath As String = m_sTempDir & "\Image.png" EgtSetLineAttribs( 3) If Not EgtGetImage(SM_Select, colWhite, colWhite, nImgW, nImgH, sPath) Then EgtOutLog("Errore creazione immagine di stampa") Return End If EgtSetLineAttribs( 1) ' Ripristino la visualizzazione della tavola EgtSetStatus(nTabId, GDB_ST.ON_) EgtZoom(ZM.ALL) Thread.Sleep(10) Try ' Metodo complesso di stampa che permette di rilasciare il file : ' carico la bitmap e la metto in uno stream in memoria Dim stream As System.IO.Stream = New System.IO.MemoryStream() Dim bitmap As System.Drawing.Bitmap = New System.Drawing.Bitmap(sPath) bitmap.Save(stream, System.Drawing.Imaging.ImageFormat.Png) bitmap.Dispose() ' la sposto in una BitmapImage Dim bitImage As New System.Windows.Media.Imaging.BitmapImage() bitImage.BeginInit() bitImage.StreamSource = stream bitImage.EndInit() ' la sposto in un Visual Control Dim tmpImg As New Image tmpImg.BeginInit() tmpImg.Source = bitImage tmpImg.Margin = New Thickness(30) ' ruoto a seconda dell'aspetto della pagina If (dH > dW And nImgH < nImgW) Or (dH < dW And nImgH > nImgW) Then tmpImg.LayoutTransform = New RotateTransform(-90) End If tmpImg.EndInit() ' eseguo la stampa printDlg.PrintVisual(tmpImg, "Parts Layout") Catch EgtOutLog("Errore esecuzione stampa") End Try End If End Sub ' Funzione per stampa delle etichette con ZebraPrinter Private Sub LabelBtn_Click(sender As Object, e As RoutedEventArgs) Handles LabelBtn.Click Dim dTimerSleep As Double = GetPrivateProfileDouble(S_GENERAL, K_PRINTSLEEP, 5000, m_sIniFile) Dim FileName As String = DateTime.Now.ToString() FileName = FileName.Replace("/"c, "_") FileName = FileName.Replace(":"c, "_") FileName = FileName.Replace(" "c, "&") Dim sFileDatIni As String = m_DatDirPrinter & "\" & FileName & ".ini" Dim nId As Integer = EgtGetFirstSelectedObj() ' recupero il part Dim nParentId As Integer = nId ' se nessun elemento selezionato esco If nParentId = GDB_ID.NULL Then ReadFileErrorPrinter(False) Return End If Dim bArrow As Boolean = False While nParentId <> GDB_ID.NULL CreateFileData(nParentId, sFileDatIni) bArrow = GetTopInfoPart(nParentId) Dim ProcsPrint As Process() = Process.GetProcessesByName(m_ZebraUtilitiesExe) If bArrow Then Process.Start(m_ZebraUtilitiesExe, m_TemplateFileArrowPrinter & " " & sFileDatIni) Else Process.Start(m_ZebraUtilitiesExe, m_TemplateFilePrinter & " " & sFileDatIni) End If Thread.Sleep(dTimerSleep) ' passo al pezzo successivo nParentId = EgtGetNextSelectedObj() End While ' attendo che sia generato il file Thread.Sleep(10) ReadFileErrorPrinter() End Sub ' creazione file ini dei dati pezzo per stampa etichetta Private Sub CreateFileData(nPartId As Integer, sFilePath As String) Dim FileText As New List(Of String) FileText.Add("[Main]") ' Recupero materiale Dim sMaterial As String = String.Empty EgtGetInfo(nPartId, INFO_CSV_MAT, sMaterial) FileText.Add("Var1=$ProjMat$," & sMaterial) ' Recupero path originale di carico Dim sCutPath As String = String.Empty EgtGetInfo(EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_PROJMARK), INFO_LOADPATH, sCutPath) FileText.Add("Var2=$LoadPath$," & sCutPath) ' recupero l'ordine del pezzo Dim sOrd As String = String.Empty EgtGetInfo(nPartId, INFO_CSV_ORD, sOrd) FileText.Add("Var3=$CsvOrd$," & sOrd) ' recupero la distointa del pezzo Dim sDist As String = String.Empty EgtGetInfo(nPartId, INFO_CSV_DIST, sDist) FileText.Add("Var4=$CsvDist$," & sDist) ' recupero il nome della componente Dim sName As String = String.Empty EgtGetInfo(nPartId, INFO_CSV_PART, sName) FileText.Add("Var5=$CsvPart$," & sName) ' nome della componente geometrica Dim sCompo As String = String.Empty EgtGetInfo(nPartId, "CMP", sCompo) FileText.Add("Var6=$CMP$," & sCompo) ' recupero dimensioni pezzo Dim sV1 As String = String.Empty EgtGetInfo(nPartId, INFO_CSV_V1, sV1) FileText.Add("Var7=$CsvV1$," & sV1) ' recupero dimensioni pezzo Dim sV2 As String = String.Empty EgtGetInfo(nPartId, INFO_CSV_V2, sV2) FileText.Add("Var8=$CsvV2$," & sV2) Try File.WriteAllLines(sFilePath, FileText) Catch ex As Exception EgtOutLog(ex.ToString) End Try End Sub Private Sub ReadFileErrorPrinter(Optional bReadFileError As Boolean = True) ' stringa che conterrà il mesasggio da stampare come errore Dim sErrorMsg As String = String.Empty ' se non leggo il messaggio di errore allora If Not bReadFileError Then sErrorMsg = EgtMsg(4 + 91460) ' leggo il messaggio di errore della stampante Else ' percorso del file di errore Dim sPathFileError As String = m_sDataRoot & "\Temp\" & "Error.txt" ' provo a recuperare il mesaggio di errore If File.Exists(sPathFileError) Then Dim sAllLines As String() = File.ReadAllLines(sPathFileError) ' verifico che ci sia almeno una riga nel file degli errori If sAllLines.Count > 0 Then ' verifico che la prima riga non sia vuota Dim Index As Integer = 0 While String.IsNullOrEmpty(sAllLines(Index)) Index += 1 If Index > sAllLines.Count Then EgtOutLog("Il messaggio di errore della stampante non è comprensibile: " & sAllLines(Index)) Return End If End While Dim sItems As String() = sAllLines(Index).Split("=") 'verifico che sia avvenuto lo split If sItems.Count > 1 Then ' verifico che il termine dopo il segno di uguale sia un numero Dim nErrorIndex As Integer = -1 Try nErrorIndex = CInt(sItems(1)) ' se nErrorIndex=0 significa che non ci sono errori If nErrorIndex < 1 Then Return End If Catch ex As Exception EgtOutLog("Il messaggio di errore della stampante non è comprensibile: " & sAllLines(Index)) Return End Try sErrorMsg = EgtMsg(nErrorIndex + 91460) End If End If End If End If ' eventualmente stampo il messaggio If Not String.IsNullOrEmpty(sErrorMsg) Then SetErrorMessage(sErrorMsg) End If ' Lancio timer per aggiornamento interfaccia Dim DelayTime As Integer = 4000 DelayTime = GetPrivateProfileInt(S_PRINTER, K_DELAYTIME, DelayTime, GetIniFile) m_DelayTimerMsg.Interval = TimeSpan.FromMilliseconds(DelayTime) m_DelayTimerMsg.Start() End Sub ' questa funzione viene eseguita dall'evento associato al m_DelayTimerMsg Private Sub RefreshErrorMsgPrinter() ClearMessage() m_DelayTimerMsg.Stop() End Sub ' cerco se esiste la definizione del "*TOP*" del pezzo Private Function GetTopInfoPart(nPartId As Integer) As Boolean Dim nRegion As Integer = EgtGetFirstNameInGroup(nPartId, NAME_REGION) If nRegion = GDB_ID.NULL Then Return False Dim nLayer As Integer = EgtGetFirstInGroup(nRegion) While nLayer <> GDB_ID.NULL Dim sMsg As String = String.Empty EgtTextGetContent(nLayer, sMsg) If Not String.IsNullOrEmpty(sMsg) AndAlso sMsg = "*TOP*" Then Return True nLayer = EgtGetNext(nLayer) End While Return False End Function Private Sub UpdateBtns() ' Per bottoni precedente e successivo progetto UpdatePrevNextBtns() ' Per bottoni pezzi e conferma ' Deve esistere file di lock Dim bEnable As Boolean = My.Computer.FileSystem.FileExists(m_sProjDir & "\" & CURR_PROJ_LOCK) ' Verifico presenza pezzi Dim bParts As Boolean = (m_vParts.Count() > 0) ' Verifico che i pezzi siano stati tutti settati Dim bConfirm As Boolean = True For Each nPartId As Integer In m_vParts If Not EgtExistsInfo(nPartId, INFO_PARTOK) Then bConfirm = False Exit For End If Next ' Verifico se già data conferma Dim bDone As Boolean = False If bConfirm Then EgtGetInfo(EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_PROJMARK), INFO_UNLOADSAVED, bDone) ' Imposto lo stato OkAllBtn.IsEnabled = bEnable And bParts And Not bDone OkPartBtn.IsEnabled = bEnable And bParts And Not bDone RuinedPartBtn.IsEnabled = bEnable And bParts And Not bDone ConfirmBtn.IsEnabled = bEnable And (m_nProjInd > 0) And bConfirm And Not bDone End Sub Private Sub UpdatePrevNextBtns() ' Per bottoni precedente e successivo progetto Dim bEnabled As Boolean = Not My.Computer.FileSystem.FileExists(m_sProjDir & "\" & CURR_PROJ_EPL) PrevBtn.IsEnabled = bEnabled NextBtn.IsEnabled = bEnabled End Sub Private Sub ConfirmBtn_Click(sender As Object, e As RoutedEventArgs) Handles ConfirmBtn.Click ' Deve esistere file di lock If Not My.Computer.FileSystem.FileExists(m_sProjDir & "\" & CURR_PROJ_LOCK) Then Return ' Non deve già essere stata data conferma Dim bDone As Boolean = False EgtGetInfo(EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_PROJMARK), INFO_UNLOADSAVED, bDone) If bDone Then Return ' Emetto stato pezzi If SavePartStatus() Then ' Dichiaro salvataggio stato pezzi effettuato EgtSetInfo(EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_PROJMARK), INFO_UNLOADSAVED, True) SaveProject() ' Scrivo file di cambio WriteChange(0) ' Se esiste, rimuovo file di lock If My.Computer.FileSystem.FileExists(m_sProjDir & "\" & CURR_PROJ_LOCK) Then My.Computer.FileSystem.DeleteFile(m_sProjDir & "\" & CURR_PROJ_LOCK) End If ' Aggiorno abilitazione bottoni UpdateBtns() End If End Sub Private Function SavePartStatus() As Boolean ' Gestione file Try ' Recupero materiale Dim sMaterial As String = String.Empty EgtGetInfo(EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_PROJMARK), INFO_PROJMAT, sMaterial) ' Recupero spessore Dim nSolidRawId As Integer = EgtGetFirstNameInGroup(EgtGetFirstRawPart(), NAME_RAW_SOLID) Dim b3RawBox As New BBox3d EgtGetBBoxGlob(nSolidRawId, GDB_BB.STANDARD, b3RawBox) Dim dThick As Double = If(b3RawBox.IsEmpty(), 0, b3RawBox.DimZ()) ' Recupero path originale di carico Dim sCutPath As String = String.Empty EgtGetInfo(EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_PROJMARK), INFO_LOADPATH, sCutPath) ' Apro i file Dim RuinedWrt As New IO.StreamWriter(m_sProjDir & "\" & CURR_PROJ_EPL, False) Dim ProdWrt As New IO.StreamWriter(m_sProjDir & "\" & CURR_PROJ_PPL, False) ' Intestazioni RuinedWrt.WriteLine("[General]") If String.IsNullOrEmpty(sCutPath) Then RuinedWrt.WriteLine("Path=*RuinedParts*") Else RuinedWrt.WriteLine("Path=" & sCutPath) End If ProdWrt.WriteLine("[General]") If String.IsNullOrEmpty(sCutPath) Then ProdWrt.WriteLine("Path=*ProducedParts*") Else ProdWrt.WriteLine("Path=" & sCutPath) End If ' Ciclo sui pezzi Dim nI As Integer = 0 Dim nJ As Integer = 0 For Each nPartId As Integer In m_vParts Dim nOk As Integer = 1 If EgtGetInfo(nPartId, INFO_PARTOK, nOk) And nOk = 0 Then nI += 1 RuinedWrt.WriteLine("[P" & nI.ToString() & "]") Dim sName As String = String.Empty EgtGetInfo(nPartId, INFO_CSV_PART, sName) RuinedWrt.WriteLine("Nam=" & sName) RuinedWrt.WriteLine("Mat=" & sMaterial) RuinedWrt.WriteLine("Act=1") RuinedWrt.WriteLine("Cnt=0") RuinedWrt.WriteLine("Add=1") RuinedWrt.WriteLine("ToN=1") Dim sCompo As String = String.Empty EgtGetInfo(nPartId, "CMP", sCompo) RuinedWrt.WriteLine("Rct=" & If(sCompo = "Rettangolo", "1", "0")) Dim dDimX As Double = 0 EgtGetInfo(nPartId, "V1", dDimX) RuinedWrt.WriteLine("DX=" & DoubleToString(dDimX, 4)) Dim dDimY As Double = 0 EgtGetInfo(nPartId, "V2", dDimY) RuinedWrt.WriteLine("DY=" & DoubleToString(dDimY, 4)) RuinedWrt.WriteLine("Th=" & DoubleToString(dThick, 4)) RuinedWrt.WriteLine("OIn=" & nI.ToString()) Else nJ += 1 ProdWrt.WriteLine("[P" & nJ.ToString() & "]") Dim sName As String = String.Empty EgtGetInfo(nPartId, INFO_CSV_PART, sName) ProdWrt.WriteLine("Nam=" & sName) ProdWrt.WriteLine("Mat=" & sMaterial) ProdWrt.WriteLine("Act=1") ProdWrt.WriteLine("Cnt=1") ProdWrt.WriteLine("Add=0") ProdWrt.WriteLine("ToN=0") Dim sCompo As String = String.Empty EgtGetInfo(nPartId, "CMP", sCompo) ProdWrt.WriteLine("Rct=" & If(sCompo = "Rettangolo", "1", "0")) Dim dDimX As Double = 0 EgtGetInfo(nPartId, "V1", dDimX) ProdWrt.WriteLine("DX=" & DoubleToString(dDimX, 4)) Dim dDimY As Double = 0 EgtGetInfo(nPartId, "V2", dDimY) ProdWrt.WriteLine("DY=" & DoubleToString(dDimY, 4)) ProdWrt.WriteLine("Th=" & DoubleToString(dThick, 4)) ProdWrt.WriteLine("OIn=" & nJ.ToString()) End If Next ' Terminatori RuinedWrt.WriteLine("[END]") ProdWrt.WriteLine("[END]") ' Chiudo i file RuinedWrt.Close() ProdWrt.Close() Return True ' Errore Catch ex As Exception EgtOutLog("Error writing epl file") Return False End Try End Function Private Sub PrevBtn_Click(sender As Object, e As RoutedEventArgs) Handles PrevBtn.Click ' Salvo il progetto If m_nProjInd > 0 Then SaveProject() ' Scrivo file di cambio WriteChange(-1) ' Se esiste, rimuovo file di lock If My.Computer.FileSystem.FileExists(m_sProjDir & "\" & CURR_PROJ_LOCK) Then My.Computer.FileSystem.DeleteFile(m_sProjDir & "\" & CURR_PROJ_LOCK) End If ' Aggiorno abilitazione bottoni UpdateBtns() End Sub Private Sub NextBtn_Click(sender As Object, e As RoutedEventArgs) Handles NextBtn.Click ' Salvo il progetto If m_nProjInd > 0 Then SaveProject() ' Scrivo file di cambio WriteChange(1) ' Se esiste, rimuovo file di lock If My.Computer.FileSystem.FileExists(m_sProjDir & "\" & CURR_PROJ_LOCK) Then My.Computer.FileSystem.DeleteFile(m_sProjDir & "\" & CURR_PROJ_LOCK) End If ' Aggiorno abilitazione bottoni UpdateBtns() End Sub Private Function WriteChange(nMove As Integer) As Boolean Try Dim ChangeWrt As New IO.StreamWriter(m_sProjDir & "\" & CURR_PROJ_CHANGE, False) ChangeWrt.WriteLine("Proj=" & m_nProjInd.ToString()) ChangeWrt.WriteLine("Move=" & nMove.ToString()) ChangeWrt.Close() Return True Catch Return False End Try End Function Private Sub OptionsBtn_Click(sender As Object, e As RoutedEventArgs) Handles OptionsBtn.Click Dim OptionPage As New OptionsPageUC(Me) Dim app As Application = Application.Current If (m_CurrTheme = 0) Then app.ChangeTheme(New Uri("/OmagVIEW;component/OmagVIEWDictionary.xaml", UriKind.Relative)) WritePrivateProfileString(S_GENERAL, K_THEME, 0, GetIniFile()) End If If (m_CurrTheme = 1) Then app.ChangeTheme(New Uri("/OmagView;component/OmagViewDarkDictionary.xaml", UriKind.Relative)) Application.Current.Resources("GroupBox_CornerRadius") = 3 Application.Current.Resources("Button_CornerRadius") = 3 Application.Current.Resources("EmptyBorder_CornerRadius") = New CornerRadius(3) WritePrivateProfileString(S_GENERAL, K_THEME, 1, GetIniFile()) End If End Sub Private Sub ExitBtn_Click(sender As Object, e As RoutedEventArgs) ' Salvo progetto SaveProject() ' Uscita MainWindow_Unloaded(sender, e) Me.Close() End Sub Private Sub MainWindow_Unloaded(sender As Object, e As RoutedEventArgs) Handles Me.Unloaded ' Terminazione generale di EgtInterface EgtExit() ' Rilascio mutex m_objMutex.Close() End Sub Private Sub MainWindow_ContentRendered(sender As Object, e As EventArgs) Handles Me.ContentRendered End Sub Private Sub EgtWPFInit() 'EgtBasicInfo EgtWPFLib.InitializeEgtWPFLib.EgtBasicInfo_Initialization("C:/EgtDev/OmagVIEW", 1280, 1024, 15, 12, "/#Century Gothic", "/gothic.ttf", Application.Current.FindResource("FontSize_UpperCaseCharacter"), Application.Current.FindResource("FontSize_LowerCaseCharacter")) ' EgtMessageBox EgtWPFLib.InitializeEgtWPFLib.EgtMsgBox_Initialization(Application.Current.FindResource("OmagCut_WindowBorder"), Application.Current.FindResource("OmagCut_WindowGrayTextButton"), Nothing, Application.Current.FindResource("FontSize_UpperCaseCharacter"), Application.Current.FindResource("FontSize_LowerCaseCharacter")) 'Inizializzazione della libreria EgtWPFLib.InitializeEgtWPFLib.EgtPaths_Initialization() End Sub ' Evento che apre AboutBox quando viene clickato il logo Private Sub LogoBrd_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles LogoBrd.MouseDown Dim AboutBox As New AboutBoxWD(Me) End Sub ' OnIdle Private Sub OnIdle() Dim sProjNew As String = m_sProjDir & "\" & CURR_PROJ_NEW ' Se c'è segnalazione di nuovo progetto ed è libera If My.Computer.FileSystem.FileExists(sProjNew) AndAlso Not FileInUse(sProjNew) Then ' Carico nuovo progetto If LoadProject() Then Dim sProjLock As String = m_sProjDir & "\" & CURR_PROJ_LOCK ' Rinomino segnalazione nuovo in segnalazione blocco My.Computer.FileSystem.MoveFile(sProjNew, sProjLock, True) Else NewProject() ' Rimuovo segnalazione di nuovo My.Computer.FileSystem.DeleteFile(sProjNew) End If ' Leggo stato progetto ReadStatus() ' Gestisco blocco su ultimo inviato UpdateLockOnLast() ' Aggiorno la visualizzazione EgtSetGenericView(0, (m_nTopViewRotStep - 1) * 90) EgtZoom(ZM.ALL) ' Aggiorno visualizzazione nome progetto ClearMessage() ' Aggiorno abilitazione bottoni UpdateBtns() Else ' Per bottoni precedente e successivo progetto UpdatePrevNextBtns() End If End Sub Private Function LoadProject() As Boolean ' Reset elenco pezzi e indice progetto m_vParts.Clear() m_nProjInd = 0 ' Carico il file If Not EgtOpenFile(m_sProjDir & "\" & CURR_PROJ_NAME) Then Return False ' Recupero l'indice di progetto Dim nMarkId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_PROJMARK) EgtGetInfo(nMarkId, INFO_PROJINDEX, m_nProjInd) ' Nascondo eventuali info su aree EgtSetStatus( nMarkId, GDB_ST.OFF) ' Rendo corrente il primo (e unico gruppo di lavoro) If Not EgtSetCurrMachGroup(EgtGetFirstMachGroup()) Then Return False ' Visualizzo solo la tavola della macchina EgtShowOnlyTable(True) ' Attivo ultima fase di lavorazione EgtSetCurrPhase(EgtGetPhaseCount()) ' Nascondo lavorazioni HideAllMachinings() ' Recupero elenco dei pezzi attivi nella fase MakePartList() ' Nascondo parti ausiliarie per nesting Dim nRawId = EgtGetFirstRawPart() Dim nSoId = EgtGetFirstNameInGroup(nRawId, NAME_OUTKERF_REG) EgtSetStatus(nSoId, GDB_ST.OFF) Dim nRrId = EgtGetFirstNameInGroup(nRawId, NAME_REF_REG) EgtSetStatus(nRrId, GDB_ST.OFF) ' Nascondo preview lavorazioni nei pezzi For Each nPartId As Integer In m_vParts Dim nPV = EgtGetFirstNameInGroup(nPartId, NAME_PREVIEW) If nPV <> GDB_ID.NULL Then EgtSetStatus(nPV, GDB_ST.OFF) End If Next ' Assegno colore blu ai pezzi non classificati Dim nInd As Integer = 0 While nInd < m_vParts.Count() Dim nPartId As Integer = m_vParts(nInd) ' Se pezzo già classificato, passo al successivo Dim nOk As Integer = -1 If EgtGetInfo(nPartId, INFO_PARTOK, nOk) Then nInd += 1 Continue While End If ' Cerco layer regione Dim nRegId = EgtGetFirstNameInGroup(nPartId, NAME_REGION) If nRegId = GDB_ID.NULL Then m_vParts.RemoveAt(nInd) Continue While End If ' Cerco prima regione nel layer Dim nId = EgtGetFirstInGroup(nRegId) While nId <> GDB_ID.NULL If EgtGetType(nId) = GDB_TY.SRF_FRGN Then EgtSetColor(nId, New Color3d(0, 255, 255, 80)) ' Aqua Exit While End If nId = EgtGetNext(nId) End While nInd += 1 End While Return True End Function Private Function NewProject() As Boolean ' Reset elenco pezzi m_vParts.Clear() ' Imposto il nuovo progetto EgtNewFile() ' Recupero nome macchina corrente Dim sMachine As String = String.Empty GetPrivateProfileString(S_MACH, K_CURRMACH, "", sMachine, m_sIniFile) ' Creo un gruppo di lavoro e carico la macchina corrente If EgtAddMachGroup(MACH_GROUP, sMachine) = GDB_ID.NULL Then Return False ' Imposto la tavola corrente If Not EgtSetTable(MAIN_TAB) Then Return False EgtShowOnlyTable(True) Return True End Function Private Function SaveProject() As Boolean ' Verifico non sia progetto vuoto If m_vParts.Count() = 0 Then Return True ' Salvo il file If Not EgtSaveFile(m_sProjDir & "\" & CURR_PROJ_NAME, NGE.CMPTEXT) Then Return False Return True End Function Private Function HideAllMachinings() As Boolean Dim nId As Integer = EgtGetFirstOperation() While nId <> GDB_ID.NULL If EgtGetOperationType(nId) <> MCH_OY.DISP Then EgtSetOperationStatus(nId, False) End If nId = EgtGetNextOperation(nId) End While Return True End Function Private Function MakePartList() As Boolean ' Ciclo su tutti i grezzi dell'ultima fase Dim nLastPhase = EgtGetPhaseCount() Dim nRawId As Integer = EgtGetFirstRawPart() While nRawId <> GDB_ID.NULL If EgtVerifyRawPartPhase(nRawId, nLastPhase) Then ' Ciclo su tutti i pezzi del grezzo Dim nPartId As Integer = EgtGetFirstPartInRawPart(nRawId) While nPartId <> GDB_ID.NULL m_vParts.Add(nPartId) nPartId = EgtGetNextPartInRawPart(nPartId) End While End If nRawId = EgtGetNextRawPart(nRawId) End While Return True End Function Private Function ReadStatus() As Boolean Try Dim NewRdr As New IO.StreamReader(m_sProjDir & "\" & CURR_PROJ_LOCK) Dim sStatus As String = NewRdr.ReadLine() NewRdr.Close() m_bLastProj = (String.Compare(sStatus, "Last", True) = 0) Return True Catch m_bLastProj = True Return False End Try End Function Private Function UpdateLockOnLast() As Boolean ' Se ultimo If m_bLastProj Then ' Verifico se già confermato Dim bDone As Boolean = False EgtGetInfo(EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_PROJMARK), INFO_UNLOADSAVED, bDone) ' Se già confermato, cancello flag di blocco (ritorno in modalità automatica) Dim sProjLock As String = m_sProjDir & "\" & CURR_PROJ_LOCK If bDone AndAlso My.Computer.FileSystem.FileExists(sProjLock) Then My.Computer.FileSystem.DeleteFile(sProjLock) End If End If Return True 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() If m_bLastProj Then OutMessageBrd.Background = Brushes.LightGreen Else OutMessageBrd.Background = Application.Current.FindResource("OmagCut_LightGray") End If If m_nProjInd > 0 Then OutMessageTxBl.Text = "Project : " & m_nProjInd.ToString() Else OutMessageTxBl.Text = "Project : ---" End If OutMessageBrd.Visibility = Windows.Visibility.Visible End Sub End Class