VERSION 5.00 Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX" Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX" Begin VB.MDIForm MDIForm1 BackColor = &H8000000C& Caption = "PetroGraph" ClientHeight = 4290 ClientLeft = 165 ClientTop = 735 ClientWidth = 10110 Icon = "MDIForm1.frx":0000 LinkTopic = "MDIForm1" LockControls = -1 'True StartUpPosition = 3 'Windows Default Visible = 0 'False WindowState = 1 'Minimized Begin MSComctlLib.Toolbar Toolbar1 Align = 1 'Align Top Height = 420 Left = 0 TabIndex = 1 Top = 0 Width = 10110 _ExtentX = 17833 _ExtentY = 741 ButtonWidth = 609 ButtonHeight = 582 Appearance = 1 ImageList = "ImageList1" _Version = 393216 BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} NumButtons = 26 BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} Style = 3 EndProperty BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} Object.ToolTipText = "Open (.PEG;.PRG) " ImageIndex = 15 EndProperty BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} Style = 3 EndProperty BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} Object.ToolTipText = "Import Data" ImageIndex = 12 EndProperty BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} Style = 3 EndProperty BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} Object.ToolTipText = "Save (.PEG;.PRG)" ImageIndex = 16 EndProperty BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} Style = 3 EndProperty BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} Object.ToolTipText = "New Binary Plot" ImageIndex = 3 EndProperty BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} Style = 3 EndProperty BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} Object.ToolTipText = "New Triangular Plot" ImageIndex = 4 EndProperty BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628} Style = 3 EndProperty BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628} Object.ToolTipText = "New Spider Plot" ImageIndex = 13 EndProperty BeginProperty Button13 {66833FEA-8583-11D1-B16A-00C0F0283628} Style = 3 EndProperty BeginProperty Button14 {66833FEA-8583-11D1-B16A-00C0F0283628} Object.ToolTipText = "New Diagram" ImageIndex = 14 EndProperty BeginProperty Button15 {66833FEA-8583-11D1-B16A-00C0F0283628} Style = 3 EndProperty BeginProperty Button16 {66833FEA-8583-11D1-B16A-00C0F0283628} Object.ToolTipText = "Mass Balance" ImageIndex = 17 EndProperty BeginProperty Button17 {66833FEA-8583-11D1-B16A-00C0F0283628} Style = 3 EndProperty BeginProperty Button18 {66833FEA-8583-11D1-B16A-00C0F0283628} Object.ToolTipText = "Legend" ImageIndex = 6 EndProperty BeginProperty Button19 {66833FEA-8583-11D1-B16A-00C0F0283628} Style = 3 EndProperty BeginProperty Button20 {66833FEA-8583-11D1-B16A-00C0F0283628} Object.ToolTipText = "Data Table" ImageIndex = 7 EndProperty BeginProperty Button21 {66833FEA-8583-11D1-B16A-00C0F0283628} Style = 3 EndProperty BeginProperty Button22 {66833FEA-8583-11D1-B16A-00C0F0283628} Object.ToolTipText = "Operation Window" ImageIndex = 11 EndProperty BeginProperty Button23 {66833FEA-8583-11D1-B16A-00C0F0283628} Style = 3 EndProperty BeginProperty Button24 {66833FEA-8583-11D1-B16A-00C0F0283628} Object.ToolTipText = "Arrange Windows" ImageIndex = 18 EndProperty BeginProperty Button25 {66833FEA-8583-11D1-B16A-00C0F0283628} Style = 3 EndProperty BeginProperty Button26 {66833FEA-8583-11D1-B16A-00C0F0283628} Object.ToolTipText = "About Petrograph" ImageIndex = 8 EndProperty EndProperty End Begin MSComctlLib.ImageList ImageList1 Left = 2640 Top = 1440 _ExtentX = 794 _ExtentY = 794 BackColor = -2147483643 ImageWidth = 16 ImageHeight = 16 MaskColor = 12632256 _Version = 393216 BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} NumListImages = 18 BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "MDIForm1.frx":058A Key = "" EndProperty BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "MDIForm1.frx":08DC Key = "" EndProperty BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "MDIForm1.frx":0C2E Key = "" EndProperty BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "MDIForm1.frx":0F80 Key = "" EndProperty BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "MDIForm1.frx":12D2 Key = "" EndProperty BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "MDIForm1.frx":1624 Key = "" EndProperty BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "MDIForm1.frx":1976 Key = "" EndProperty BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "MDIForm1.frx":1CC8 Key = "" EndProperty BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "MDIForm1.frx":201A Key = "" EndProperty BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "MDIForm1.frx":236C Key = "" EndProperty BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "MDIForm1.frx":26BE Key = "" EndProperty BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "MDIForm1.frx":2A10 Key = "" EndProperty BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "MDIForm1.frx":2D62 Key = "" EndProperty BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "MDIForm1.frx":30B4 Key = "" EndProperty BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "MDIForm1.frx":3406 Key = "" EndProperty BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "MDIForm1.frx":3758 Key = "" EndProperty BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "MDIForm1.frx":3AAA Key = "" EndProperty BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "MDIForm1.frx":3DFC Key = "" EndProperty EndProperty End Begin MSComctlLib.StatusBar StatusBar1 Align = 2 'Align Bottom Height = 270 Left = 0 TabIndex = 0 Top = 4020 Width = 10110 _ExtentX = 17833 _ExtentY = 476 _Version = 393216 BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} NumPanels = 3 BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} Object.Width = 10583 MinWidth = 10583 Text = "Campione:" TextSave = "Campione:" EndProperty BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} Object.Width = 5292 MinWidth = 5292 Text = "X=" TextSave = "X=" EndProperty BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} Object.Width = 5292 MinWidth = 5292 Text = "Y=" TextSave = "Y=" EndProperty EndProperty BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "Arial" Size = 10.5 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty End Begin MSComDlg.CommonDialog CommonDialog1 Left = 120 Top = 0 _ExtentX = 847 _ExtentY = 847 _Version = 393216 CancelError = -1 'True End Begin VB.Menu mnu_File Caption = "File" Begin VB.Menu opz1ope Caption = "Open" Begin VB.Menu opzProject Caption = "Project (.PRJ)" Visible = 0 'False End Begin VB.Menu opzFilePetrograph Caption = "file data file (.PEG)" End End Begin VB.Menu opzImport Caption = "Import" Begin VB.Menu opzopenxls Caption = "file ANALYSIS (.XLS)" Visible = 0 'False End Begin VB.Menu opzImportWSymbol Caption = "file Excel (.XLS)" End Begin VB.Menu opzRoc Caption = "file IgpetWin (.ROC)" End End Begin VB.Menu pp Caption = "-" End Begin VB.Menu opz1Sav Caption = "Save" Begin VB.Menu opzSaveproj Caption = "Project (.PRJ)" Visible = 0 'False End Begin VB.Menu opzSavePetrograph Caption = "data file (.PEG)" End End Begin VB.Menu pppp Caption = "-" End Begin VB.Menu opzExit Caption = "Exit" End End Begin VB.Menu mnu_plot Caption = "Plot" Begin VB.Menu opz_binaryPlot Caption = "Binary Plot" End Begin VB.Menu opzTriangularPlot Caption = "Triangular Plot" End Begin VB.Menu opzpider Caption = "Spider" Begin VB.Menu opzREE Caption = "REE" End Begin VB.Menu opzOtherSpi Caption = "Other Spider" End End Begin VB.Menu mnuDiagram Caption = "Diagram" Begin VB.Menu opzGenClass Caption = "General Classification" Begin VB.Menu opzClassBin Caption = "Binary" Begin VB.Menu opzQFANOR Caption = "[Q'(F')-ANOR] - volcanic -after Streckeisen & LeMaitre, 1979" End Begin VB.Menu opzPecceTaylor Caption = "[K2O-SiO2] - after Peccerillo and Taylor, 1976" End Begin VB.Menu opzMiddle Caption = "[K2O-SiO2] - after Middlemost, 1975" End Begin VB.Menu opzTASLeBas Caption = "[TAS Alkalies-Silica] - volcanic -after LeBas et al., 1986" End Begin VB.Menu opzAlkaliesSilicaCoxV Caption = "[TAS Alkalies-Silica] - volcanic - after Cox-Bell-Pank, 1979" End Begin VB.Menu opzAlkaliesSilicaCoxP Caption = "[TAS Alkalies-Silica] - plutonic - after Cox-Bell-Pank, 1979" End Begin VB.Menu opzAndesiteTypeaGill Caption = "[SiO2-K2O Andesite Types] - after Gill, 1981" End Begin VB.Menu opzSiO2FM Caption = "[SiO2-F/M] - after Miyashiro, 1974" End End Begin VB.Menu opzClassTriang Caption = "Triangular" Begin VB.Menu opzAFM Caption = "AFM" Begin VB.Menu opzAFM1968 Caption = "after Kuno,1968" End Begin VB.Menu opzAFM1971 Caption = "after Irvine & Baragar, 1971 " End End End End Begin VB.Menu opzBasalts Caption = "For Basalts" Begin VB.Menu opzBasBin Caption = "Binary" Begin VB.Menu opzTiZrBin Caption = "[Ti-Zr] - after Pearce & Cann,1973" End Begin VB.Menu opzTaYbThYb Caption = "[Ta/Yb-Th/Yb]- after Pearce, 1982" End Begin VB.Menu opzCrY Caption = "[Cr-Y] - modify from Pearce, 1982" End End Begin VB.Menu opzBasTri Caption = "Triangular" Begin VB.Menu opzTiZrY Caption = "[Ti-Zr-Y] - after Pearce & Cann, 1973" End Begin VB.Menu opzTiZrSr Caption = "[Ti-Zr-Sr] - afterPearce & Cann, 1973" End Begin VB.Menu opzNbZrY Caption = "[Nb-Zr-Y] - after Meschede, 1986" End Begin VB.Menu opzThHfTa Caption = "[Th-Hf-Ta] - after Wood, 1980" End End End Begin VB.Menu opzGranites Caption = "For Granites" Begin VB.Menu opzGranBin Caption = "Binary" Begin VB.Menu opzNbY Caption = "[Nb-Y] - after Pearce et al., 1984" End Begin VB.Menu opzTaYb Caption = "[Ta-Yb] - after Pearce et al., 1984" End Begin VB.Menu opzRbYNb Caption = "[Rb-(Y+Nb)] - after Pearce et al., 1984" End Begin VB.Menu opzRbYbTa Caption = "[Rb-(Yb+Ta)] - after Pearce et al., 1984" End End Begin VB.Menu opzGranTri Caption = "Triangular" End End Begin VB.Menu opzMantle Caption = "Mantle End-Members" Begin VB.Menu opz87Sr86SrVs143Nd144Nd Caption = "87Sr/86Sr Vs 143Nd/144Nd" End Begin VB.Menu opz206Pb204PbVs143Nd144Nd Caption = "206Pb/204Pb Vs 143Nd/144Nd" End Begin VB.Menu opz206Pb204PbVs87Sr86Sr Caption = "206Pb/204Pb Vs 87Sr/86Sr" End Begin VB.Menu opz206Pb204PbVs208Pb204Pb Caption = "206Pb/204Pb Vs 208Pb/204Pb" Visible = 0 'False End Begin VB.Menu opz206Pb204PbVs207Pb204Pb Caption = "206Pb/204Pb Vs 207Pb/204Pb" Visible = 0 'False End End End Begin VB.Menu opzleg Caption = "Legend" End End Begin VB.Menu mnuFinestre Caption = "Windows" Begin VB.Menu opzTable Caption = "DataTable" End Begin VB.Menu opzElabInput Caption = "Operation" End Begin VB.Menu opzCIPWTABLE Caption = "CIPW Table" End Begin VB.Menu opzREETable Caption = "REE Table" End Begin VB.Menu opzPartition Caption = "Partition Coefficent DB" End Begin VB.Menu opzMassBalance Caption = "Mass Balance" End Begin VB.Menu opzArrange Caption = "Arrange Windows" End Begin VB.Menu pppo Caption = "-" End Begin VB.Menu ozSplash Caption = "About..." End End Begin VB.Menu mnuPopupGraph Caption = "PopupGraph" Visible = 0 'False Begin VB.Menu opzleg1 Caption = "Show legend" End Begin VB.Menu opzCambiaSimbolo Caption = "Change Simbol/Color" End Begin VB.Menu opzmode Caption = "Insert Model" Begin VB.Menu opzModelEvsE Caption = "Models Generator" End Begin VB.Menu opzModIso Caption = "Mixing" End Begin VB.Menu opzModIsoAFC Caption = "Isotopic AFC" End End Begin VB.Menu opzCangeModel Caption = "Change Model" Visible = 0 'False End Begin VB.Menu opzEliminaMod Caption = "Clear Model" Begin VB.Menu opzultimo Caption = "last" End Begin VB.Menu opzTutti Caption = "all" End End Begin VB.Menu opzcopia Caption = "Copy Graph " Visible = 0 'False End Begin VB.Menu opzPick Caption = "Identify Sample on Graph" End Begin VB.Menu opzSalvaGrafico Caption = "Save Graph (.wmf)" Visible = 0 'False End Begin VB.Menu opzSpidermodels Caption = "Trace Elements Models" Visible = 0 'False End Begin VB.Menu opzModSpi Caption = "Modify Spider" End Begin VB.Menu opzArrange1 Caption = "Arrange Windows" End Begin VB.Menu opzAggiorna Caption = "Refresh" End End Begin VB.Menu mnuPopup1 Caption = "Popup1" Visible = 0 'False Begin VB.Menu opzCopiaSelezione Caption = "Copy Selection" End End Begin VB.Menu mnupopup2 Caption = "popup2" Visible = 0 'False Begin VB.Menu opzcopiasel2 Caption = "Copy Selection" End Begin VB.Menu opzCercaCamp Caption = "Search Sample in Data Table " End End Begin VB.Menu mnupopup3 Caption = "popup3" Visible = 0 'False Begin VB.Menu opzCopyStromer Caption = "copy" End End End Attribute VB_Name = "MDIForm1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Private Sub MDIForm_Click() frmSplash.Hide End Sub Private Sub MDIForm_Load() MDIForm1.StatusBar1.Panels(1).Text = "" MDIForm1.StatusBar1.Panels(2).Text = "" MDIForm1.StatusBar1.Panels(3).Text = "" Mod1 = False Fileopen = False CIPWyn = False REEOperation = False CambiaMod = False Colmodel = 0 ProgTrue = False 'caratteristiche dell'aera grafico Form1.Hide Form2.Hide Form3.Hide Form4.Hide Form5.Hide Form6.Hide Form7.Hide Form8.Hide Form9.Hide Form10.Hide Form11.Hide Form12.Hide Form13.Hide Form14.Hide Form16.Hide Form17.Hide Form18.Hide BackGrnd.Hide REE(1) = "La" REE(2) = "Ce" REE(3) = "Pr" REE(4) = "Nd" REE(5) = "Pm" REE(6) = "Sm" REE(7) = "Eu" REE(8) = "Gd" REE(9) = "Tb" REE(10) = "Dy" REE(11) = "Ho" REE(12) = "Er" REE(13) = "Tm" REE(14) = "Yb" REE(15) = "Lu" MDIForm1.WindowState = 2 End Sub Private Sub MDIForm_Unload(Cancel As Integer) On Error GoTo ee Unload frmSplash Unload frmAbout Unload Form15 ee: End Sub Private Sub opz_binaryPlot_Click() If Fileopen = False Then MsgBox "An Error Occurred: open an input file first" Exit Sub End If Form2.Combo1.Clear Form2.Combo2.Clear For i = 1 To Numelem Form2.Combo1.AddItem Elementi(i) Form2.Combo2.AddItem Elementi(i) Next i Form2.Show Form2.SetFocus End Sub Private Sub opz206Pb204PbVs143Nd144Nd_Click() DiagramType1 = "206Pb204PbVs143Nd144Nd" Form14.Text1.Text = 500 Form14.Text2.Text = 350 Form14.Show Form14.SetFocus End Sub Private Sub opz206Pb204PbVs207Pb204Pb_Click() DiagramType1 = "206Pb204PbVs207Pb204Pb" Form14.Text1.Text = 500 Form14.Text2.Text = 350 Form14.Show Form14.SetFocus End Sub Private Sub opz206Pb204PbVs208Pb204Pb_Click() DiagramType1 = "206Pb204PbVs208Pb204Pb" Form14.Text1.Text = 500 Form14.Text2.Text = 350 Form14.Show Form14.SetFocus End Sub Private Sub opz206Pb204PbVs87Sr86Sr_Click() DiagramType1 = "206Pb204PbVs87Sr86Sr" Form14.Text1.Text = 500 Form14.Text2.Text = 350 Form14.Show Form14.SetFocus End Sub Private Sub opz87Sr86SrVs143Nd144Nd_Click() DiagramType1 = "87Sr86SrVs143Nd144Nd" Form14.Text1.Text = 500 Form14.Text2.Text = 350 Form14.Show Form14.SetFocus End Sub Private Sub opzAFM1968_Click() DiagramType1 = "AFM-Kuno" Form1.Show Form1.SetFocus End Sub Private Sub opzAFM1971_Click() DiagramType1 = "AFM-Irvine" Form1.Show Form1.SetFocus End Sub Public Sub opzAggiorna_Clic() End Sub Private Sub opzAggiorna_Click() ttt = Indeks '------------------------------------------- For rrrr1 = 1 To Maxindeks Indeks = rrrr1 If OpenPic(rrrr1) = 1 Then '----------------------------------- picforms(rrrr1).Picture1.DrawWidth = 1 picforms(rrrr1).Picture2.DrawWidth = 1 '---------------- ' A-F-M '--------------- If DiagramType(rrrr1) = "AFM-Kuno" Or DiagramType(rrrr1) = "AFM-Irvine" Then 'determino la colonna di FeOtot (A) For i = 1 To Numelem If Elementi(i) = "FeOtot" Then numa = i End If Next i If numa = 101 Then 'cerco ferro 2 e 3 INP.Feototale Form2.Combo1.AddItem Elementi(Numelem) Form2.Combo2.AddItem Elementi(Numelem) Form3.Combo1.AddItem Elementi(Numelem) Form3.Combo2.AddItem Elementi(Numelem) Form3.Combo3.AddItem Elementi(Numelem) Form6.Combo1.AddItem Elementi(Numelem) Form6.Combo2.AddItem Elementi(Numelem) numa = Numelem End If 'determino la colonna di B INP.Addizione "Na2O", "K2O" numb = Numelem 'determino la colonna di c For i = 1 To Numelem If Elementi(i) = "MgO" Then numc = i End If Next i AxAa(rrrr1) = "F" AXB(rrrr1) = "A" AXC(rrrr1) = "M" binary(rrrr1) = False SPIDERREE(rrrr1) = False SPIDEROTHER(rrrr1) = False Triangular(rrrr1) = True MF1.NewTriplot (App.Path + "\data\g10" + Trim(Str(rrrr1))), TypeDim(rrrr1) MF1.Diagram For i = 1 To Numcamp1 BackGrnd.FG1.Row = i BackGrnd.FG1.col = 1 tipo = Val(BackGrnd.FG1) BackGrnd.FG1.Row = i BackGrnd.FG1.col = 3 tipo1 = Val(BackGrnd.FG1) BackGrnd.FG1.col = 2 col = BackGrnd.Picture1(BackGrnd.FG1 + 8).BackColor If DatiOrigine(i, numa) < 0 Or DatiOrigine(i, numb) < 0 Or DatiOrigine(i, numc) < 0 Or tipo = 0 Or tipo1 = 0 Or SimbFilter(i) = 0 Then GoTo eeer1 MF1.T_InsertPoint NomeCamp(i), DatiOrigine(i, numa), DatiOrigine(i, numb), DatiOrigine(i, numc), SimbDim(rrrr1), col, tipo eeer1: Next i MF1.TAssi (QBColor(1)) MF1.Finegraph GoTo wqer End If '------------------------------' ' Ti-Zr-Y Pearce & Cann ' '------------------------------' If DiagramType(rrrr1) = "TiZrY" Then AxAa(rrrr1) = "Ti/100" AXB(rrrr1) = "Zr" AXC(rrrr1) = "Y*3" 'determino la colonna di Ti (ppm) (A) For i = 1 To Numelem If Elementi(i) = "Ti" Then numa = i End If Next i If numa = 101 Then MsgBox "An Error Occurred: I'm not able to identify Ti", , "Error!" GoTo wqer End If INP.AsuConst "Ti", 100 numa = Numelem 'determino la colonna di Zr (B) For i = 1 To Numelem If Elementi(i) = "Zr" Then numb = i End If Next i If numb = 101 Then MsgBox "An Error Occurred: I'm not able to identify Zr", , "Error!" GoTo wqer End If 'determino la colonna di Y (C) For i = 1 To Numelem If Elementi(i) = "Y" Then numc = i End If Next i If numc = 101 Then MsgBox "An Error Occurred: I'm not able to identify Y", , "Error!" GoTo wqer End If INP.AxConst "Y", 3 numc = Numelem binary(rrrr1) = False SPIDERREE(rrrr1) = False SPIDEROTHER(rrrr1) = False Triangular(rrrr1) = True MF1.NewTriplot (App.Path + "\data\g10" + Trim(Str(rrrr1))), TypeDim(rrrr1) MF1.Diagram For i = 1 To Numcamp1 BackGrnd.FG1.Row = i BackGrnd.FG1.col = 1 tipo = Val(BackGrnd.FG1) BackGrnd.FG1.Row = i BackGrnd.FG1.col = 3 tipo1 = Val(BackGrnd.FG1) BackGrnd.FG1.col = 2 col = BackGrnd.Picture1(BackGrnd.FG1 + 8).BackColor If DatiOrigine(i, numa) < 0 Or DatiOrigine(i, numb) < 0 Or DatiOrigine(i, numc) < 0 Or tipo = 0 Or tipo1 = 0 Or SimbFilter(i) = 0 Then GoTo eeer2 MF1.T_InsertPoint NomeCamp(i), DatiOrigine(i, numa), DatiOrigine(i, numb), DatiOrigine(i, numc), SimbDim(rrrr1), col, tipo eeer2: Next i MF1.TAssi (QBColor(1)) MF1.Finegraph GoTo wqer End If '------------------------------' ' Ti-Zr-Sr Pearce & Cann ' '------------------------------' If DiagramType(rrrr1) = "TiZrSr" Then AxAa(rrrr1) = "Ti/100" AXB(rrrr1) = "Zr" AXC(rrrr1) = "Sr/2" 'determino la colonna di Ti (ppm) (A) For i = 1 To Numelem If Elementi(i) = "Ti" Then numa = i End If Next i If numa = 101 Then MsgBox "An Error Occurred: I'm not able to identify Ti", , "Errore!" GoTo wqer End If INP.AsuConst Elementi(numa), 100 numa = Numelem 'determino la colonna di Zr (B) For i = 1 To Numelem If Elementi(i) = "Zr" Then numb = i End If Next i If numb = 101 Then MsgBox "An Error Occurred: I'm not able to identify Zr", , "Errore!" GoTo wqer End If 'determino la colonna di Sr (C) For i = 1 To Numelem If Elementi(i) = "Sr" Then numc = i End If Next i If numc = 101 Then MsgBox "An Error Occurred: I'm not able to identify Sr", , "Error" GoTo wqer End If INP.AsuConst "Sr", 2 numc = Numelem binary(rrrr1) = False SPIDERREE(rrrr1) = False SPIDEROTHER(rrrr1) = False Triangular(rrrr1) = True MF1.NewTriplot (App.Path + "\data\g10" + Trim(Str(rrrr1))), TypeDim(rrrr1) MF1.Diagram For i = 1 To Numcamp1 BackGrnd.FG1.Row = i BackGrnd.FG1.col = 1 tipo = Val(BackGrnd.FG1) BackGrnd.FG1.Row = i BackGrnd.FG1.col = 3 tipo1 = Val(BackGrnd.FG1) BackGrnd.FG1.col = 2 col = BackGrnd.Picture1(BackGrnd.FG1 + 8).BackColor If DatiOrigine(i, numa) < 0 Or DatiOrigine(i, numb) < 0 Or DatiOrigine(i, numc) < 0 Or tipo = 0 Or tipo1 = 0 Or SimbFilter(i) = 0 Then GoTo eeer3 MF1.T_InsertPoint NomeCamp(i), DatiOrigine(i, numa), DatiOrigine(i, numb), DatiOrigine(i, numc), SimbDim(rrrr1), col, tipo eeer3: Next i MF1.TAssi (QBColor(1)) MF1.Finegraph GoTo wqer End If '-------------------------' ' Nb-Zr-Y Meschede ' '-------------------------' If DiagramType(rrrr1) = "NbZrY" Then AxAa(rrrr1) = "Nb*2" AXB(rrrr1) = "Zr/4" AXC(rrrr1) = "Y" 'determino la colonna di Nb (ppm) (A) For i = 1 To Numelem If Elementi(i) = "Nb" Then numa = i End If Next i If numa = 101 Then MsgBox "An Error Occurred: I'm not able to identify Nb", , "Error" GoTo wqer End If INP.AxConst "Nb", 2 numa = Numelem 'determino la colonna di Zr (B) For i = 1 To Numelem If Elementi(i) = "Zr" Then numb = i End If Next i If numb = 101 Then MsgBox "An Error Occurred: I'm not able to identify Ti", , "Error" GoTo wqer End If INP.AsuConst "Zr", 4 numb = Numelem 'determino la colonna di Y (C) For i = 1 To Numelem If Elementi(i) = "Y" Then numc = i End If Next i If numc = 101 Then MsgBox "An Error Occurred: I'm not able to identify Y", , "Error" GoTo wqer End If binary(rrrr1) = False SPIDERREE(rrrr1) = False SPIDEROTHER(rrrr1) = False Triangular(rrrr1) = True MF1.NewTriplot (App.Path + "\data\g10" + Trim(Str(rrrr1))), TypeDim(rrrr1) MF1.Diagram For i = 1 To Numcamp1 BackGrnd.FG1.Row = i BackGrnd.FG1.col = 1 tipo = Val(BackGrnd.FG1) BackGrnd.FG1.Row = i BackGrnd.FG1.col = 3 tipo1 = Val(BackGrnd.FG1) BackGrnd.FG1.col = 2 col = BackGrnd.Picture1(BackGrnd.FG1 + 8).BackColor If DatiOrigine(i, numa) < 0 Or DatiOrigine(i, numb) < 0 Or DatiOrigine(i, numc) < 0 Or tipo = 0 Or tipo1 = 0 Or SimbFilter(i) = 0 Then GoTo eeer4 MF1.T_InsertPoint NomeCamp(i), DatiOrigine(i, numa), DatiOrigine(i, numb), DatiOrigine(i, numc), SimbDim(rrrr1), col, tipo eeer4: Next i MF1.TAssi (QBColor(1)) MF1.Finegraph GoTo wqer End If '-------------------' ' Th-Hf-Ta Wood ' '-------------------' If DiagramType(rrrr1) = "ThHfTa" Then AxAa(rrrr1) = "Hf/3" AXB(rrrr1) = "Th" AXC(rrrr1) = "Ta" 'determino la colonna di Hf (ppm) (A) For i = 1 To Numelem If Elementi(i) = "Hf" Then numa = i End If Next i If numa = 101 Then MsgBox "An Error Occurred: I'm not able to identify Hf", , "Error" GoTo wqer End If INP.AsuConst "Hf", 3 numa = Numelem 'determino la colonna di Th (B) For i = 1 To Numelem If Elementi(i) = "Th" Then numb = i End If Next i If numb = 101 Then MsgBox "An Error Occurred: I'm not able to identify Th", , "Error" GoTo wqer End If 'determino la colonna di Ta (C) For i = 1 To Numelem If Elementi(i) = "Ta" Then numc = i End If Next i If numc = 101 Then MsgBox "An Error Occurred: I'm not able to identify Y", , "Error" GoTo wqer End If binary(rrrr1) = False SPIDERREE(rrrr1) = False SPIDEROTHER(rrrr1) = False Triangular(rrrr1) = True MF1.NewTriplot (App.Path + "\data\g10" + Trim(Str(rrrr1))), TypeDim(rrrr1) MF1.Diagram For i = 1 To Numcamp1 BackGrnd.FG1.Row = i BackGrnd.FG1.col = 1 tipo = Val(BackGrnd.FG1) BackGrnd.FG1.Row = i BackGrnd.FG1.col = 3 tipo1 = Val(BackGrnd.FG1) BackGrnd.FG1.col = 2 col = BackGrnd.Picture1(BackGrnd.FG1 + 8).BackColor If DatiOrigine(i, numa) < 0 Or DatiOrigine(i, numb) < 0 Or DatiOrigine(i, numc) < 0 Or tipo = 0 Or tipo1 = 0 Or SimbFilter(i) = 0 Then GoTo eeer5 MF1.T_InsertPoint NomeCamp(i), DatiOrigine(i, numa), DatiOrigine(i, numb), DatiOrigine(i, numc), SimbDim(rrrr1), col, tipo eeer5: Next i MF1.TAssi (QBColor(1)) MF1.Finegraph GoTo wqer End If 'strelematre '-------------------------------------------------------------------------- If DiagramType(rrrr1) = "Strelemaitre" Then picforms(rrrr1).Picture1.Cls picforms(rrrr1).Picture1.Cls Intx(rrrr1) = 10 Inty(rrrr1) = 9 binary(rrrr1) = True SPIDERREE(rrrr1) = False SPIDEROTHER(rrrr1) = False Triangular(rrrr1) = False tipoGraph(rrrr1) = "normx-normy" MF1.NewRectGraph (App.Path + "\data\g10" + Trim(Str(rrrr1))), Xgraph(rrrr1), Ygraph(rrrr1) MF1.assi CIPW.Norm CIPWyn = True MF1.Diagram Dim anor As Single Dim yt As Single For i = 1 To Numcamp1 If (DatiCIPW(i, 12) + DatiCIPW(i, 9)) <= 0 Then GoTo wqwq13 End If anor = 100 * DatiCIPW(i, 12) / (DatiCIPW(i, 12) + DatiCIPW(i, 9)) Q = 100 * DatiCIPW(i, 19) / (DatiCIPW(i, 19) + DatiCIPW(i, 12) + DatiCIPW(i, 9) + DatiCIPW(i, 10)) F = 100 * (DatiCIPW(i, 23) + DatiCIPW(i, 24) + DatiCIPW(i, 26)) / (DatiCIPW(i, 12) + DatiCIPW(i, 9) + DatiCIPW(i, 10) + DatiCIPW(i, 23) + DatiCIPW(i, 24) + DatiCIPW(i, 26)) If Q > F Then yt = Q End If If F > Q Then yt = -F End If BackGrnd.FG1.Row = i BackGrnd.FG1.col = 1 tipo = Val(BackGrnd.FG1) BackGrnd.FG1.Row = i BackGrnd.FG1.col = 3 tipo1 = Val(BackGrnd.FG1) If tipo = 0 Or tipo1 = 0 Or SimbFilter(i) = 0 Then GoTo wqwq13 If anor > MaxX(rrrr1) Or anor < MinX(rrrr1) Then Campione(i, rrrr1) = "" NumCamp(rrrr1) = NumCamp(rrrr1) + 1 aa = aa + 1 GoTo wqwq13 End If If yt > MaxY(rrrr1) Or yt < MinY(rrrr1) Then Campione(i, rrrr1) = "" NumCamp(rrrr1) = NumCamp(rrrr1) + 1 aa = aa + 1 GoTo wqwq13 End If BackGrnd.FG1.Row = i BackGrnd.FG1.col = 1 tipo = Val(BackGrnd.FG1) BackGrnd.FG1.Row = i BackGrnd.FG1.col = 3 tipo1 = Val(BackGrnd.FG1) BackGrnd.FG1.col = 2 col = BackGrnd.Picture1(BackGrnd.FG1 + 8).BackColor MF1.InsertPoint NomeCamp(i), anor, yt, SimbDim(rrrr1), col, tipo wqwq13: Next i If aa > 0 Then MsgBox "Attention! Some samples are positioned out of graph area", , "Attention" End If MF1.asseXTitle "ANOR", 10 MF1.asseYTitle "Q'-F'", 10 picforms(rrrr1).Caption = "Fig." + Trim(rrrr1) + ": QAPF" MF1.Finegraph MF1.MostraSpecifiche = True MF1.Evidenzia = True GoTo wqer End If 'binary '-------------------------------------------------------------- If binary(rrrr1) = True Then On Error GoTo ee Form2.Hide GoTo dopo If DiagramType(rrrr1) = "none" Then INP.SalvaABCamp Elementi(AXX(rrrr1)), Elementi(AXY(rrrr1)) INP.Max App.Path + "\data\datiinputx.txt" MaxX(rrrr1) = StatResult INP.Max App.Path + "\data\datiinputy.txt" MaxY(rrrr1) = StatResult INP.Min App.Path + "\data\datiinputx.txt" MinX(rrrr1) = StatResult logMinXX = Int(LOG10(MinX(rrrr1))) INP.Min App.Path + "\data\datiinputy.txt" MinY(rrrr1) = StatResult logMinYY = Int(LOG10(MinY(rrrr1))) xm = 0 ym = 0 'aggiungo e tolgo un epsilon ai valori massimi e minimi deltax1(rrrr1) = (MaxX(rrrr1) - MinX(rrrr1)) / 8 '10 10-10-02 deltay1(rrrr1) = (MaxY(rrrr1) - MinY(rrrr1)) / 8 '10 10-10-02 If deltax1(rrrr1) >= 1 Then deltax1(rrrr1) = Val(Format$(deltax1(rrrr1), "0")) MinX(rrrr1) = Val(Format$(MinX(rrrr1), "0")) - deltax1(rrrr1) MaxX(rrrr1) = Val(Format$(MaxX(rrrr1), "0")) + deltax1(rrrr1) End If If deltay1(rrrr1) >= 1 Then deltay1(rrrr1) = Val(Format$(deltay1(rrrr1), "0")) MinY(rrrr1) = Val(Format$(MinY(rrrr1), "0")) - deltay1(rrrr1) MaxY(rrrr1) = Val(Format$(MaxY(rrrr1), "0")) + deltay1(rrrr1) End If If deltax1(rrrr1) < 1 And deltax1(rrrr1) >= 0.1 Then deltax1(rrrr1) = Val(Format$(deltax1(rrrr1), "0.0")) MinX(rrrr1) = Val(Format$(MinX(rrrr1), "0.0")) - deltax1(rrrr1) MaxX(rrrr1) = Val(Format$(MaxX(rrrr1), "0.0")) + deltax1(rrrr1) End If If deltay1(rrrr1) < 1 And deltay1(rrrr1) >= 0.1 Then deltay1(rrrr1) = Val(Format$(deltay1(rrrr1), "0.0")) MinY(rrrr1) = Val(Format$(MinY(rrrr1), "0.0")) - deltay1(rrrr1) MaxY(rrrr1) = Val(Format$(MaxY(rrrr1), "0.0")) + deltay1(rrrr1) End If If deltax1(rrrr1) < 0.1 And deltax1(rrrr1) >= 0.01 Then deltax1(rrrr1) = Val(Format$(deltax1(rrrr1), "0.00")) MinX(rrrr1) = Val(Format$(MinX(rrrr1), "0.00")) - deltax1(rrrr1) MaxX(rrrr1) = Val(Format$(MaxX(rrrr1), "0.00")) + deltax1(rrrr1) End If If deltay1(rrrr1) < 0.1 And deltay1(rrrr1) >= 0.01 Then deltay1(rrrr1) = Val(Format$(deltay1(rrrr1), "0.00")) MinY(rrrr1) = Val(Format$(MinY(rrrr1), "0.00")) - deltay1(rrrr1) MaxY(rrrr1) = Val(Format$(MaxY(rrrr1), "0.00")) + deltay1(rrrr1) End If If deltax1(rrrr1) < 0.01 And deltax1(rrrr1) >= 0.001 Then deltax1(rrrr1) = Val(Format$(deltax1(rrrr1), "0.000")) MinX(rrrr1) = Val(Format$(MinX(rrrr1), "0.000")) - deltax1(rrrr1) MaxX(rrrr1) = Val(Format$(MaxX(rrrr1), "0.000")) + deltax1(rrrr1) End If If deltay1(rrrr1) < 0.01 And deltay1(rrrr1) >= 0.001 Then deltay1(rrrr1) = Val(Format$(deltay1(rrrr1), "0.000")) MinY(rrrr1) = Val(Format$(MinY(rrrr1), "0.000")) - deltay1(rrrr1) MaxY(rrrr1) = Val(Format$(MaxY(rrrr1), "0.000")) + deltay1(rrrr1) End If If deltax1(rrrr1) < 0.001 And deltax1(rrrr1) >= 0.0001 Then deltax1(rrrr1) = Val(Format$(deltax1(rrrr1), "0.0000")) MinX(rrrr1) = Val(Format$(MinX(rrrr1), "0.0000")) - deltax1(rrrr1) MaxX(rrrr1) = Val(Format$(MaxX(rrrr1), "0.0000")) + deltax1(rrrr1) End If If deltay1(rrrr1) < 0.001 And deltay1(rrrr1) >= 0.0001 Then deltay1(rrrr1) = Val(Format$(deltay1(rrrr1), "0.0000")) MinY(rrrr1) = Val(Format$(MinY(rrrr1), "0.0000")) - deltay1(rrrr1) MaxY(rrrr1) = Val(Format$(MaxY(rrrr1), "0.0000")) + deltay1(rrrr1) End If If deltax1(rrrr1) < 0.0001 And deltax1(rrrr1) >= 0.00001 Then deltax1(rrrr1) = Val(Format$(deltax1(rrrr1), "0.00000")) MinX(rrrr1) = Val(Format$(MinX(rrrr1), "0.00000")) - deltax1(rrrr1) MaxX(rrrr1) = Val(Format$(MaxX(rrrr1), "0.00000")) + deltax1(rrrr1) End If If deltay1(rrrr1) < 0.0001 And deltay1(rrrr1) >= 0.00001 Then deltay1(rrrr1) = Val(Format$(deltay1(rrrr1), "0.00000")) MinY(rrrr1) = Val(Format$(MinY(rrrr1), "0.00000")) - deltay1(rrrr1) MaxY(rrrr1) = Val(Format$(MaxY(rrrr1), "0.00000")) + deltay1(rrrr1) End If If deltax1(rrrr1) < 0.00001 And deltax1(rrrr1) >= 0.000001 Then deltax1(rrrr1) = Val(Format$(deltax1(rrrr1), "0.000000")) MinX(rrrr1) = Val(Format$(MinX(rrrr1), "0.000000")) - deltax1(rrrr1) MaxX(rrrr1) = Val(Format$(MaxX(rrrr1), "0.000000")) + deltax1(rrrr1) End If If deltay1(rrrr1) < 0.00001 And deltay1(rrrr1) >= 0.000001 Then deltay1(rrrr1) = Val(Format$(deltay1(rrrr1), "0.000000")) MinY(rrrr1) = Val(Format$(MinY(rrrr1), "0.000000")) - deltay1(rrrr1) MaxY(rrrr1) = Val(Format$(MaxY(rrrr1), "0.000000")) + deltay1(rrrr1) End If If deltax1(rrrr1) < 0.000001 And deltax1(rrrr1) >= 0.0000001 Then deltax1(rrrr1) = Val(Format$(deltax1(rrrr1), "0.0000000")) MinX(rrrr1) = Val(Format$(MinX(rrrr1), "0.0000000")) - deltax1(rrrr1) MaxX(rrrr1) = Val(Format$(MaxX(rrrr1), "0.0000000")) + deltax1(rrrr1) End If If deltay1(rrrr1) < 0.000001 And deltay1(rrrr1) >= 0.0000001 Then deltay1(rrrr1) = Val(Format$(deltay1(rrrr1), "0.0000000")) MinY(rrrr1) = Val(Format$(MinY(rrrr1), "0.0000000")) - deltay1(rrrr1) MaxY(rrrr1) = Val(Format$(MaxY(rrrr1), "0.0000000")) + deltay1(rrrr1) End If If deltax1(rrrr1) < 0.0000001 And deltax1(rrrr1) >= 0.00000001 Then deltax1(rrrr1) = Val(Format$(deltax1(rrrr1), "0.00000000")) MinX(rrrr1) = Val(Format$(MinX(rrrr1), "0.00000000")) - deltax1(rrrr1) MaxX(rrrr1) = Val(Format$(MaxX(rrrr1), "0.00000000")) + deltax1(rrrr1) End If If deltay1(rrrr1) < 0.0000001 And deltay1(rrrr1) >= 0.00000001 Then deltay1(rrrr1) = Val(Format$(deltay1(rrrr1), "0.00000000")) MinY(rrrr1) = Val(Format$(MinY(rrrr1), "0.00000000")) - deltay1(rrrr1) MaxY(rrrr1) = Val(Format$(MaxY(rrrr1), "0.00000000")) + deltay1(rrrr1) End If If MaxX(rrrr1) = MinX(rrrr1) Then MaxX(rrrr1) = MaxX(rrrr1) + 1 MinX(rrrr1) = MinX(rrrr1) - 1 End If If MaxY(rrrr1) = MinY(rrrr1) Then MaxY(rrrr1) = MaxY(rrrr1) + 1 MinY(rrrr1) = MinY(rrrr1) - 1 End If If deltay1(rrrr1) = 0 Then deltay1(rrrr1) = (MaxY(rrrr1) - MinY(rrrr1)) / 5 End If If deltax1(rrrr1) = 0 Then deltax1(rrrr1) = (MaxX(rrrr1) - MinX(rrrr1)) / 5 End If End If dopo: picforms(rrrr1).Picture1.Cls picforms(rrrr1).Picture2.Cls binary(rrrr1) = True Triangular(rrrr1) = False SPIDERREE(rrrr1) = False SPIDEROTHER(rrrr1) = False If tipoGraph(rrrr1) = "normx-normy" Then MF1.DisegnaNormXNormY End If If tipoGraph(rrrr1) = "normx-logy" Then '----------- pymax = Int(LOG10(MaxY(rrrr1))) + 1 If MinY(rrrr1) <= 0 Then pymin = logMinYY GoTo toto1 End If If MinY(rrrr1) > 1 Then pymin = Int(LOG10(MinY(rrrr1))) '- 1 '11/06/02 Else pymin = Int(LOG10(MinY(rrrr1))) - 1 '11/06/02 End If toto1: MaxY(rrrr1) = Val(EXP10(pymax)) - (10 ^ -10) MinY(rrrr1) = Val(EXP10(pymin)) + (10 ^ -10) '---------- MF1.DisegnaNormXLogY End If If tipoGraph(rrrr1) = "logx-normy" Then '----------- pxmax = Int(LOG10(MaxX(rrrr1))) + 1 If MinX(rrrr1) <= 0 Then pxmin = logMinXX GoTo toto2 End If If MinX(rrrr1) > 1 Then pxmin = Int(LOG10(MinX(rrrr1))) '- 1 '11/06/02 Else pxmin = Int(LOG10(MinX(rrrr1))) - 1 '11/06/02 End If toto2: MaxX(rrrr1) = Val(EXP10(pxmax)) - (10 ^ -10) MinX(rrrr1) = Val(EXP10(pxmin)) + (10 ^ -10) '---------- MF1.DisegnaLogXNormY End If If tipoGraph(rrrr1) = "logx-logy" Then '----------- pymax = Int(LOG10(MaxY(rrrr1))) + 1 If MinY(rrrr1) <= 0 Then pymin = logMinYY GoTo toto3 End If If MinY(rrrr1) > 1 Then pymin = Int(LOG10(MinY(rrrr1))) '- 1 '11/06/02 Else pymin = Int(LOG10(MinY(rrrr1))) '- 1 '11/06/02 End If toto3: MaxY(rrrr1) = Val(EXP10(pymax)) - (10 ^ -10) MinY(rrrr1) = Val(EXP10(pymin)) + (10 ^ -10) '---------- '----------- pxmax = Int(LOG10(MaxX(rrrr1))) + 1 If MinX(rrrr1) <= 0 Then pxmin = logMinXX GoTo toto4 End If If MinX(rrrr1) > 1 Then pxmin = Int(LOG10(MinX(rrrr1))) '- 1 '11/06/02 Else pxmin = Int(LOG10(MinX(rrrr1))) '- 1 '11/06/02 End If toto4: MaxX(rrrr1) = Val(EXP10(pxmax)) - (10 ^ -10) MinX(rrrr1) = Val(EXP10(pxmin)) + (10 ^ -10) '---------- MF1.DisegnaLogXLogY End If GoTo ee1 ee: MsgBox "An Error Occurred" GoTo wqer ee1: End If 'triangular '-------------------------------------------------------------- If Triangular(rrrr1) = True Then On Error GoTo ee2 Triangular(rrrr1) = True binary(rrrr1) = False SPIDERREE(rrrr1) = False SPIDEROTHER(rrrr1) = False DiagramType(rrrr1) = "none" NumCamp(rrrr1) = 0 MF1.NewTriplot (App.Path + "\data\g10" + Trim(Str(rrrr1))), Tp1(rrrr1) For i = 1 To Numcamp1 BackGrnd.FG1.Row = i BackGrnd.FG1.col = 1 tipo = Val(BackGrnd.FG1) BackGrnd.FG1.Row = i BackGrnd.FG1.col = 3 tipo1 = Val(BackGrnd.FG1) BackGrnd.FG1.col = 2 col = BackGrnd.Picture1(BackGrnd.FG1 + 8).BackColor If DatiOrigine(i, AxAa(rrrr1)) = -12345.67 Or DatiOrigine(i, AXB(rrrr1)) = -12345.67 Or DatiOrigine(i, AXC(rrrr1)) = -12345.67 Or DatiOrigine(i, AxAa(rrrr1)) < 0 Or DatiOrigine(i, AXB(rrrr1)) < 0 Or DatiOrigine(i, AXC(rrrr1)) < 0 Or tipo = 0 Or tipo1 = 0 Or SimbFilter(i) = 0 Then GoTo qswe8 MF1.T_InsertPoint NomeCamp(i), DatiOrigine(i, AxAa(rrrr1)), DatiOrigine(i, AXB(rrrr1)), DatiOrigine(i, AXC(rrrr1)), SimbDim(rrrr1), col, tipo qswe8: Next i MF1.TAssi (QBColor(1)) MF1.Finegraph Form3.Hide GoTo ee3 ee2: MsgBox "An Error Occurred" Form3.Hide GoTo wqer ee3: End If 'REEspider '----------------------------------------------------------- If SPIDERREE(rrrr1) = True Then 'Normalizzazione 'For i = 1 To 200 'Numcamp1 'For ii = 1 To 15 'Spiy(rrrr1, ii, i) = 0 'Next ii 'Next i file$ = App.Path + NormSP(rrrr1) Close #1 Open App.Path + "\data\spiderREECamp" + Trim(rrrr1) + ".txt" For Input As #1 tt = 2 For i = 1 To NumCampSpi(rrrr1) Input #1, aaa$ REEcamp1(i) = aaa$ Next i Close #1 If NumCampSpi(rrrr1) = 0 Then GoTo wqer End If Open file$ For Input As #1 For i = 1 To 15 Input #1, aa If aa = 1 Then NormREE(i) = 0 'Label33(i - 1).Caption = "/" GoTo rrrr1 End If NormREE(i) = aa 'Label33(i - 1).Caption = Str(aa) rrrr1: Next i Close #1 'On Error GoTo wewe picforms(rrrr1).Hide picforms(rrrr1).Picture2.Cls picforms(rrrr1).Picture1.Cls ind = NumCampSpi(rrrr1) SPIDERREE(rrrr1) = True SPIDEROTHER(rrrr1) = False binary(rrrr1) = False Triangular(rrrr1) = False DiagramType(rrrr1) = "none" SPI.DeterminaREEPresenti If REE1(1) = False Or REE1(6) = False Or REE1(7) = False Or REE1(14) = False Then MsgBox "An Error Occurred: La, Sm, Eu, Yb have to be present in data table", , "Error" GoTo wqer End If For i = 1 To 15 If REE1(i) = True Then Form8.Shape1(i - 1).FillColor = QBColor(2) REESelect(i - 1) = True End If If REE1(i) = False Then Form8.Shape1(i - 1).FillColor = QBColor(12) REESelect(i - 1) = False End If Next i 'MF1.REENewSpiderREEGraph App.Path + "\xx.emf", 500, 300 'determino massimo e minimo MaxREE1 = 0 MinREE1 = 1E+38 For i = 1 To ind 'cerco il campione aaa$ = REEcamp1(i) For ii = 1 To Numcamp1 If aaa$ = NomeCamp(ii) Then n11 = ii GoTo trt End If Next ii trt: CampioniSpi(rrrr1, i) = n11 SPI.DeterminaValoriREE n11 For iii = 1 To 15 If valREEn(iii) <= 0 Then GoTo www End If If valREEn(iii) > MaxREE1 Then MaxREE1 = valREEn(iii) End If If valREEn(iii) < MinREE1 Then MinREE1 = valREEn(iii) End If www: Next iii Next i '------------------------------- 'max e min con spider 'attenzione finire If NumModSpi(rrrr1) > 0 Then For i = 1 To NumModSpi(rrrr1) Close #1 Open App.Path + "\data\SpiMod_" + Trim(i) + ".txt" For Input As #1 Input #1, numgraph, C0, F, ModelLineSp, ModelLineCol, ModelSymb, ModelSymbSp, ModelSymbCol, ModelSymbWid While Not EOF(1) Input #1, ss, valss For ii = 1 To 15 If ss = REE(ii) Then If valss <= 0 Or NormREE(ii) <= 0 Then GoTo poii If valss / NormREE(ii) > MaxREE1 Then MaxREE1 = valss / NormREE(ii) End If poii: If valss <= 0 Or NormREE(ii) <= 0 Then GoTo poii1 If valss / NormREE(ii) < MaxREE1 Then MminREE1 = valss / NormREE(ii) End If poii1: End If Next ii Wend Next i End If '------------------------------ 'plotto miny1 = Int(LOG10(MinREE1)) - 1 maxy1 = Int(LOG10(MaxREE1)) + 1 Inty(rrrr1) = maxy1 - miny1 MinY(rrrr1) = EXP10(miny1) MaxY(rrrr1) = EXP10(maxy1) MinX(rrrr1) = 1 MaxX(rrrr1) = 15 DiagramType(rrrr1) = "none" MF1.REENewSpiderREEGraph (App.Path + "\data\g10" + Trim(Str(rrrr1))), Xgraph(rrrr1), Ygraph(rrrr1) MF1.REE_ASSI wwq = 0 For i = 1 To ind 'cerco il campione aaa$ = REEcamp1(i) SpiPlotted(rrrr1) = SpiPlotted(rrrr1) + Chr$(124) + aaa$ For ii = 1 To Numcamp1 If aaa$ = NomeCamp(ii) Then n11 = ii GoTo qqqq End If Next ii qqqq: SPI.DeterminaValoriREE n11 BackGrnd.FG1.Row = n11 BackGrnd.FG1.col = 1 tipo = Val(BackGrnd.FG1) BackGrnd.FG1.Row = n11 BackGrnd.FG1.col = 3 tipo1 = Val(BackGrnd.FG1) BackGrnd.FG1.col = 2 col = BackGrnd.Picture1(BackGrnd.FG1 + 8).BackColor 'MF1.REE_InsertPoint SimbDim(rrrr1), col, SPIlineCol, tipo If tipo > 0 And tipo1 > 0 And SimbFilter(i) <> 0 Then MF1.REE_InsertPoint n11, SimbDim(Indeks), col, col, tipo '04-06-2002 End If Next i 'For i = 1 To NumModSpi(rrrr1) 'MF1.REE_InsertPointMOD (i) 'Next i MF1.Finegraph Form8.Hide GoTo wewe1 wewe: MsgBox "An Error Occurred. Verify the input data", , "Error" wewe1: End If 'otherSpider '---------------------------------------------------------------------------------- If SPIDEROTHER(rrrr1) = True Then 'For i = 1 To 50 'For ii = 1 To NumCampSpi(rrrr1) 'Spiy(rrrr1, ii, i) = 0 'Next ii 'Next i file$ = NormSP(rrrr1) SPI1.CaricaNormalizzazioneSpider file$ Close #1 Open App.Path + "\data\spiderCamp" + Trim(rrrr1) + ".txt" For Input As #1 tt = 2 cc = NumCampSpi(rrrr1) For zz = 1 To cc Input #1, aaa$ REEcamp1(zz) = aaa$ Next zz Close #1 picforms(rrrr1).Hide picforms(rrrr1).Picture2.Cls picforms(rrrr1).Picture1.Cls If NumCampSpi(rrrr1) = 0 Then GoTo wqer End If ind = NumCampSpi(rrrr1) SPIDERREE(rrrr1) = False SPIDEROTHER(rrrr1) = True binary(rrrr1) = False Triangular(rrrr1) = False DiagramType(rrrr1) = "none" SPI1.DeterminaSpiderPresenti For i = 1 To NumSpider If Spider1(i) = False Then Form16.Label1(i - 1).Caption = EleMSpider(i) Form16.Shape2(i - 1).FillColor = QBColor(12) Form16.Shape2(i - 1).Visible = True Form16.Label1(i - 1).Visible = True End If If Spider1(i) = True Then Form16.Label1(i - 1).Caption = EleMSpider(i) Form16.Shape2(i - 1).FillColor = QBColor(2) Form16.Shape2(i - 1).Visible = True Form16.Label1(i - 1).Visible = True End If Next i 'MF1.REENewSpiderREEGraph App.Path + "\xx.emf", 500, 300 'determino massimo e minimo MaxSpider1 = 0 MinSpider1 = 1E+38 For i = 1 To ind 'cerco il campione aaa$ = REEcamp1(i) For ii = 1 To Numcamp1 If aaa$ = NomeCamp(ii) Then n11 = ii GoTo trt4 End If Next ii trt4: CampioniSpi(rrrr1, i) = n11 SPI1.DeterminaValoriSpider n11 For iii = 1 To NumSpider If ValSpiderNorm(iii) = 0 Then GoTo www6 End If If ValSpiderNorm(iii) > MaxSpider1 Then MaxSpider1 = ValSpiderNorm(iii) End If If ValSpiderNorm(iii) < MinSpider1 Then MinSpider1 = ValSpiderNorm(iii) End If www6: Next iii Next i 'plotto 'miny1 = Int(LOG10(MinSpider1)) - 1 'maxy1 = Int(LOG10(MaxSpider1)) + 1 'Inty(rrrr1) = maxy1 - miny1 'MinY(rrrr1) = EXP10(miny1) + (10 ^ -4) 'MaxY(rrrr1) = EXP10(maxy1) - (10 ^ -4) 'MinX(rrrr1) = 1 'MaxX(rrrr1) = NumSpider DiagramType(rrrr1) = "none" MF1.NewSpiderGraph (App.Path + "\data\g10" + Trim(Str(rrrr1))), Xgraph(rrrr1), Ygraph(rrrr1) MF1.SPIDER_ASSI wwq = 0 For i = 1 To ind 'cerco il campione aaa$ = REEcamp1(i) For ii = 1 To Numcamp1 If aaa$ = NomeCamp(ii) Then n11 = ii GoTo qqqq7 End If Next ii qqqq7: SPI1.DeterminaValoriSpider n11 BackGrnd.FG1.Row = n11 BackGrnd.FG1.col = 1 tipo = Val(BackGrnd.FG1) BackGrnd.FG1.Row = n11 BackGrnd.FG1.col = 3 tipo1 = Val(BackGrnd.FG1) BackGrnd.FG1.col = 2 col = BackGrnd.Picture1(BackGrnd.FG1 + 8).BackColor 'MF1.Spider_InsertPoint SimbDim(rrrr1), col, SPIlineCol, tipo If tipo > 0 And tipo1 > 0 And SimbFilter(i) <> 0 Then MF1.Spider_InsertPoint n11, SimbDim(rrrr1), col, col, tipo '04-06-2002 End If Next i MF1.Finegraph Form16.Hide GoTo wewe34 wewe44: MsgBox "An Error Occurred. Verify the input data", , "Error" wewe34: End If End If wqer: Next rrrr1 Indeks = ttt End Sub Private Sub opzAlkaliesSilicaCoxP_Click() DiagramType1 = "coxP" Form14.Text1.Text = 500 Form14.Text2.Text = 350 Form14.Show Form14.SetFocus End Sub Private Sub opzAlkaliesSilicaCoxV_Click() DiagramType1 = "coxV" Form14.Text1.Text = 500 Form14.Text2.Text = 350 Form14.Show Form14.SetFocus End Sub Private Sub opzAndesiteTypeaGill_Click() DiagramType1 = "gill" Form14.Text1.Text = 500 Form14.Text2.Text = 350 Form14.Show Form14.SetFocus End Sub Private Sub opzArrange_Click() xwin = 0 ywin = 0 For i = 1 To 15 If OpenPic(i) = 1 Then picforms(i).left = xwin picforms(i).top = ywin 'picforms(i).SetFocus xwin = xwin + 100 ywin = ywin + 300 End If Next i End Sub Private Sub opzArrange1_Click() xwin = 0 ywin = 0 For i = 1 To 15 On Error GoTo poi If OpenPic(i) = 1 Then picforms(i).left = xwin picforms(i).top = ywin 'picforms(i).SetFocus xwin = xwin + 100 ywin = ywin + 300 poi: End If Next i End Sub Private Sub opzCambiaSimbolo_Click() On Error GoTo yyyt 'attenzione 02/08/02 Form5.Picture1(22).Cls For i = 9 To 20 Form5.Picture1(i).BackColor = BackGrnd.Picture1(i).BackColor Next i Form5.Picture1(9).BackColor = QBColor(0) For i = 0 To 8 Form5.Picture1(i).Scale (1, 9)-(9, 1) Next i Form5.Picture1(23).Scale (1, 9)-(9, 1) Form5.Picture1(24).Scale (1, 9)-(9, 1) Form5.Picture1(25).Scale (1, 9)-(9, 1) Form5.Picture1(41).Scale (1, 9)-(9, 1) Form5.Picture1(22).Scale (1, 9)-(9, 1) 'picture(0) Form5.Picture1(0).FillColor = QBColor(0) Form5.Picture1(0).FillStyle = 0 Form5.Picture1(0).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B 'picture(1) Form5.Picture1(1).FillColor = QBColor(0) Form5.Picture1(1).FillStyle = 1 Form5.Picture1(1).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B 'picture(2) Form5.Picture1(2).FillColor = QBColor(0) Form5.Picture1(2).FillStyle = 0 Form5.Picture1(2).Circle (5, 5), 2, QBColor(0) 'picture(3) Form5.Picture1(3).FillColor = QBColor(0) Form5.Picture1(3).FillStyle = 1 Form5.Picture1(3).Circle (5, 5), 2, QBColor(0) 'picture(4) Form5.Picture1(4).FillStyle = 1 Form5.Picture1(4).Line (5 - 2, 5 - 2)-(5, 5 + 2), QBColor(0) Form5.Picture1(4).Line (5 - 2, 5 - 2)-(5 + 2, 5 - 2), QBColor(0) Form5.Picture1(4).Line (5 + 2, 5 - 2)-(5, 5 + 2), QBColor(0) 'picture(5) Form5.Picture1(5).FillStyle = 1 Form5.Picture1(5).Line (5 - 2, 5 + 2)-(5, 5 - 2), QBColor(0) Form5.Picture1(5).Line (5 - 2, 5 + 2)-(5 + 2, 5 + 2), QBColor(0) Form5.Picture1(5).Line (5 + 2, 5 + 2)-(5, 5 - 2), QBColor(0) 'picture(6) Form5.Picture1(6).FillStyle = 1 Form5.Picture1(6).Line (5 - 2, 5)-(5 + 2, 5), QBColor(0) Form5.Picture1(6).Line (5, 5 - 2)-(5, 5 + 2), QBColor(0) Form5.Picture1(6).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0) Form5.Picture1(6).Line (5 + 2, 5 - 2)-(5 - 2, 5 + 2), QBColor(0) 'picture(7) Form5.Picture1(7).FillStyle = 1 Form5.Picture1(7).Line (5 - 2, 5)-(5 + 2, 5), QBColor(0) Form5.Picture1(7).Line (5, 5 - 2)-(5, 5 + 2), QBColor(0) 'picture(8) Form5.Picture1(8).FillStyle = 1 Form5.Picture1(8).Line (5 - 2, 5)-(5, 5 + 4), QBColor(0) Form5.Picture1(8).Line (5, 5 + 4)-(5 + 2, 5), QBColor(0) Form5.Picture1(8).Line (5 + 2, 5)-(5, 5 - 4), QBColor(0) Form5.Picture1(8).Line (5, 5 - 4)-(5 - 2, 5), QBColor(0) 'picture(23) Form5.Picture1(23).FillStyle = 1 Form5.Picture1(23).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0) Form5.Picture1(23).Line (5 + 2, 5 - 2)-(5 - 2, 5 + 2), QBColor(0) 'picture(24) Form5.Picture1(24).FillStyle = 1 Form5.Picture1(24).Line (5 - 2, 5)-(5 + 2, 5), QBColor(0) 'picture(25) Form5.Picture1(25).FillStyle = 1 Form5.Picture1(25).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0) Form5.Picture1(25).Line (5 + 2, 5 - 2)-(5 - 2, 5 + 2), QBColor(0) Form5.Picture1(25).FillColor = QBColor(0) Form5.Picture1(25).FillStyle = 1 Form5.Picture1(25).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B For i = 1 To Numcamp1 If NomeCamp(i) = SelezCamp Then SelezCampCamB = SelezCamp RowSel = i RowSel1 = i GoTo ww End If Next i ww: BackGrnd.FG1.Row = RowSel BackGrnd.FG1.col = 2 OldCol = BackGrnd.FG1 BackGrnd.FG1.col = 1 OldSym = BackGrnd.FG1 If BackGrnd.FG1 = 1 Then Form5.Picture1(41).FillColor = QBColor(0) Form5.Picture1(41).FillStyle = 0 Form5.Picture1(41).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B Form5.Picture1(22).FillColor = QBColor(0) Form5.Picture1(22).FillStyle = 0 Form5.Picture1(22).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B End If If BackGrnd.FG1 = 2 Then Form5.Picture1(41).FillColor = QBColor(0) Form5.Picture1(41).FillStyle = 1 Form5.Picture1(41).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B Form5.Picture1(22).FillColor = QBColor(0) Form5.Picture1(22).FillStyle = 1 Form5.Picture1(22).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B End If If BackGrnd.FG1 = 3 Then Form5.Picture1(41).FillColor = QBColor(0) Form5.Picture1(41).FillStyle = 0 Form5.Picture1(41).Circle (5, 5), 2, QBColor(0) Form5.Picture1(22).FillColor = QBColor(0) Form5.Picture1(22).FillStyle = 0 Form5.Picture1(22).Circle (5, 5), 2, QBColor(0) End If If BackGrnd.FG1 = 4 Then Form5.Picture1(41).FillColor = QBColor(0) Form5.Picture1(41).FillStyle = 1 Form5.Picture1(41).Circle (5, 5), 2, QBColor(0) Form5.Picture1(22).FillColor = QBColor(0) Form5.Picture1(22).FillStyle = 1 Form5.Picture1(22).Circle (5, 5), 2, QBColor(0) End If If BackGrnd.FG1 = 5 Then Form5.Picture1(41).FillStyle = 1 Form5.Picture1(41).Line (5 - 2, 5 - 2)-(5, 5 + 2), QBColor(0) Form5.Picture1(41).Line (5 - 2, 5 - 2)-(5 + 2, 5 - 2), QBColor(0) Form5.Picture1(41).Line (5 + 2, 5 - 2)-(5, 5 + 2), QBColor(0) Form5.Picture1(22).FillStyle = 1 Form5.Picture1(22).Line (5 - 2, 5 - 2)-(5, 5 + 2), QBColor(0) Form5.Picture1(22).Line (5 - 2, 5 - 2)-(5 + 2, 5 - 2), QBColor(0) Form5.Picture1(22).Line (5 + 2, 5 - 2)-(5, 5 + 2), QBColor(0) End If If BackGrnd.FG1 = 6 Then Form5.Picture1(41).FillStyle = 1 Form5.Picture1(41).Line (5 - 2, 5 + 2)-(5, 5 - 2), QBColor(0) Form5.Picture1(41).Line (5 - 2, 5 + 2)-(5 + 2, 5 + 2), QBColor(0) Form5.Picture1(41).Line (5 + 2, 5 + 2)-(5, 5 - 2), QBColor(0) Form5.Picture1(22).FillStyle = 1 Form5.Picture1(22).Line (5 - 2, 5 + 2)-(5, 5 - 2), QBColor(0) Form5.Picture1(22).Line (5 - 2, 5 + 2)-(5 + 2, 5 + 2), QBColor(0) Form5.Picture1(22).Line (5 + 2, 5 + 2)-(5, 5 - 2), QBColor(0) End If If BackGrnd.FG1 = 7 Then Form5.Picture1(41).FillStyle = 1 Form5.Picture1(41).Line (5 - 2, 5)-(5 + 2, 5), QBColor(0) Form5.Picture1(41).Line (5, 5 - 2)-(5, 5 + 2), QBColor(0) Form5.Picture1(41).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0) Form5.Picture1(41).Line (5 + 2, 5 - 2)-(5 - 2, 5 + 2), QBColor(0) Form5.Picture1(22).FillStyle = 1 Form5.Picture1(22).Line (5 - 2, 5)-(5 + 2, 5), QBColor(0) Form5.Picture1(22).Line (5, 5 - 2)-(5, 5 + 2), QBColor(0) Form5.Picture1(22).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0) Form5.Picture1(22).Line (5 + 2, 5 - 2)-(5 - 2, 5 + 2), QBColor(0) End If If BackGrnd.FG1 = 8 Then Form5.Picture1(41).FillStyle = 1 Form5.Picture1(41).Line (5 - 2, 5)-(5 + 2, 5), QBColor(0) Form5.Picture1(41).Line (5, 5 - 2)-(5, 5 + 2), QBColor(0) Form5.Picture1(22).FillStyle = 1 Form5.Picture1(22).Line (5 - 2, 5)-(5 + 2, 5), QBColor(0) Form5.Picture1(22).Line (5, 5 - 2)-(5, 5 + 2), QBColor(0) End If If BackGrnd.FG1 = 9 Then Form5.Picture1(41).FillStyle = 1 Form5.Picture1(41).Line (5 - 2, 5)-(5, 5 + 4), QBColor(0) Form5.Picture1(41).Line (5, 5 + 4)-(5 + 2, 5), QBColor(0) Form5.Picture1(41).Line (5 + 2, 5)-(5, 5 - 4), QBColor(0) Form5.Picture1(41).Line (5, 5 - 4)-(5 - 2, 5), QBColor(0) Form5.Picture1(22).FillStyle = 1 Form5.Picture1(22).Line (5 - 2, 5)-(5, 5 + 4), QBColor(0) Form5.Picture1(22).Line (5, 5 + 4)-(5 + 2, 5), QBColor(0) Form5.Picture1(22).Line (5 + 2, 5)-(5, 5 - 4), QBColor(0) Form5.Picture1(22).Line (5, 5 - 4)-(5 - 2, 5), QBColor(0) End If BackGrnd.FG1.col = 2 Form5.Picture1(39).BackColor = BackGrnd.Picture1(Val(BackGrnd.FG1) + 8).BackColor Form5.Picture1(21).BackColor = BackGrnd.Picture1(Val(BackGrnd.FG1) + 8).BackColor Form5.Show yyyt: End Sub Private Sub opzCangeModel_Click() On Error GoTo poi1 Close #2 For iii = 1 To 15 aa$ = MDIForm1.StatusBar1.Panels(1).Text bb$ = "Sample: MODEL: " + Str(iii) If aa$ = bb$ Then MODiD = iii '---colori Form12.Picture1(21).BackColor = ColModLine(MODiD, Indeks) Form12.Picture1(39).BackColor = ColModSymb(MODiD, Indeks) '-------- Close #2 Open App.Path + "\data\" + Trim(Indeks) + "modelExplain" + Trim(iii) + ".txt" For Input As #2 Line Input #2, models$ 'MOD 'Form23.Label2 = Models Line Input #2, rrs 'R Line Input #2, rrs1 'R 'Form23.Label14 = rr Line Input #2, c01s 'C0 'Form23.Label4 = C01S Line Input #2, cas 'CA 'Form23.Label6 = CAS Line Input #2, c1s 'C1 'Form23.Label8 = C1S Line Input #2, c2s 'C2 'Line Input #2, c3s 'C2 'Form23.Label10 = C2S Line Input #2, cicl Line Input #2, stcicl Line Input #2, mmm0 Input #2, NumModelElemS For ii = 1 To NumModelElemS Input #2, ModElementi(ii) 'Form23.Label11(ii - 1) = ModElementi(ii) Next ii If models$ <> "Mixing(R-R)" Then For ii = 1 To NumModelElem Input #2, ModD(ii) 'Form23.Label12(ii - 1) = ModD(ii) Next ii End If Close #2 End If Next iii Form23.Hide If models$ <> "Mixing(R-R)" And models$ <> "Mixing(R-E)" And models$ <> "Mixing(R-1/E)" And models$ <> "AFCiso" Then Form12.Option2.Value = True Form12.Frame1.Visible = False Form12.Frame8.Visible = False Form12.Frame10.Visible = False Form12.Frame2.Visible = False Form12.Frame6.Visible = False Form12.Frame11.Visible = False Form12.Frame9.Visible = False Form12.frame7.Visible = False Form12.Frame12.Visible = False Form12.Frame13.Visible = False Form12.Frame14.Visible = False Form12.Frame23.Visible = False Form12.Frame22.Visible = False NumModelElem = 0 INP.RecuperoXY AXX(GraphSelect), AXY(GraphSelect) NumModelElem2(Indeks) = NumModelElem For i = 0 To 9 Form12.Text1(i).Visible = False Form12.Text1(i).Text = "0.00" Form12.Label1(i).Visible = False Next i For i = 0 To 8 Form12.Picture1(i).Scale (1, 9)-(9, 1) Next i Form12.Picture1(41).Scale (1, 9)-(9, 1) Form12.Picture1(41).FillColor = QBColor(0) Form12.Picture1(41).FillStyle = 0 Form12.Picture1(41).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B ModelSymb = 1 'picture(0) Form12.Picture1(0).FillColor = QBColor(0) Form12.Picture1(0).FillStyle = 0 Form12.Picture1(0).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B 'picture(1) Form12.Picture1(1).FillColor = QBColor(0) Form12.Picture1(1).FillStyle = 1 Form12.Picture1(1).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B 'picture(2) Form12.Picture1(2).FillColor = QBColor(0) Form12.Picture1(2).FillStyle = 0 Form12.Picture1(2).Circle (5, 5), 2, QBColor(0) 'picture(3) Form12.Picture1(3).FillColor = QBColor(0) Form12.Picture1(3).FillStyle = 1 Form12.Picture1(3).Circle (5, 5), 2, QBColor(0) 'picture(4) Form12.Picture1(4).FillStyle = 1 Form12.Picture1(4).Line (5 - 2, 5 - 2)-(5, 5 + 2), QBColor(0) Form12.Picture1(4).Line (5 - 2, 5 - 2)-(5 + 2, 5 - 2), QBColor(0) Form12.Picture1(4).Line (5 + 2, 5 - 2)-(5, 5 + 2), QBColor(0) 'picture(5) Form12.Picture1(5).FillStyle = 1 Form12.Picture1(5).Line (5 - 2, 5 + 2)-(5, 5 - 2), QBColor(0) Form12.Picture1(5).Line (5 - 2, 5 + 2)-(5 + 2, 5 + 2), QBColor(0) Form12.Picture1(5).Line (5 + 2, 5 + 2)-(5, 5 - 2), QBColor(0) 'picture(6) Form12.Picture1(6).FillStyle = 1 Form12.Picture1(6).Line (5 - 2, 5)-(5 + 2, 5), QBColor(0) Form12.Picture1(6).Line (5, 5 - 2)-(5, 5 + 2), QBColor(0) Form12.Picture1(6).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0) Form12.Picture1(6).Line (5 + 2, 5 - 2)-(5 - 2, 5 + 2), QBColor(0) 'picture(7) Form12.Picture1(7).FillStyle = 1 Form12.Picture1(7).Line (5 - 2, 5)-(5 + 2, 5), QBColor(0) Form12.Picture1(7).Line (5, 5 - 2)-(5, 5 + 2), QBColor(0) 'picture(8) Form12.Picture1(8).FillStyle = 1 Form12.Picture1(8).Line (5 - 2, 5)-(5, 5 + 4), QBColor(0) Form12.Picture1(8).Line (5, 5 + 4)-(5 + 2, 5), QBColor(0) Form12.Picture1(8).Line (5 + 2, 5)-(5, 5 - 4), QBColor(0) Form12.Picture1(8).Line (5, 5 - 4)-(5 - 2, 5), QBColor(0) If models$ <> "mixing (Elem Vs Elem)" And models$ <> "Batch melting(non modal)" Then For i = 1 To NumModelElem Form12.Label1(i - 1).Caption = "D for " + ModElementi(i) Form12.Text1(i - 1).Text = ModD(i) Form12.Label1(i - 1).Visible = True Form12.Text1(i - 1).Visible = True Next i End If If models$ = "mixing (Elem Vs Elem)" Or models$ = "Batch melting(non modal)" Then For i = 1 To NumModelElem Form12.Label1(i - 1).Caption = "D for " + ModElementi(i) Form12.Label1(i - 1).Visible = False Form12.Text1(i - 1).Text = ModD(i) Form12.Text1(i - 1).Visible = False Next i Form12.Show Form12.SetFocus End If '--------------------- If models$ = "RFT" Then Form12.Option1.Visible = False Form12.Option2.Visible = False Form12.Combo6 = "RFT(A)" If CambiaMod = False Then Form12.Option1.Visible = False Form12.Option2.Visible = False Else Form12.Option1.Visible = False Form12.Option2.Visible = False End If Form12.Frame1.Visible = False Form12.Frame2.Visible = False Form12.Frame6.Visible = False Form12.frame7.Visible = False Form12.Frame8.Visible = False Form12.Frame9.Visible = False Form12.Frame10.Visible = False Form12.Frame11.Visible = False Form12.Frame12.Visible = False Form12.Frame14.Visible = False Form12.Frame15.Visible = False Form12.Frame16.Visible = False Form12.Frame17.Visible = False Form12.Frame18.Visible = False Form12.Frame19.Visible = False Form12.Frame20.Visible = False Form12.Frame21.Visible = False Form12.Frame23.Visible = False Form12.Frame22.Visible = False Form12.Frame19.Visible = True Form12.Frame24.Visible = True Form12.Frame25.Visible = True Form12.Frame26.Visible = True Form12.Frame27.Visible = True Form12.Frame28.Visible = True Form12.Frame29.Visible = True Form12.Frame20.Visible = True Form12.Combo1.Text = "Select" For i = 1 To Numcamp1 If NomeCamp(i) = "c0" Or NomeCamp(i) = "C0" Or NomeCamp(i) = "cO" Or NomeCamp(i) = "CO" Or NomeCamp(i) = "Co" Or NomeCamp(i) = "co" Then Form12.Combo1.Text = NomeCamp(i) GoTo xx111: End If Next i Form12.Combo1.Text = C0M(Indeks) xx111: Form12.Text2(6) = c1s Form12.Text2(7) = c2s Form12.Text2(2) = rrs Form12.Text2(5) = rrs1 Form12.Text2(3) = cicl Form12.Text2(4) = stcicl Form12.Text5(9) = mmm0 Form12.Show Form12.SetFocus End If '---------------------------- If models$ = "RAFC" Then Form12.Option1.Visible = False Form12.Option2.Visible = False Form12.Combo6 = "RAFC" If CambiaMod = False Then Form12.Option1.Visible = False Form12.Option2.Visible = False Else Form12.Option1.Visible = False Form12.Option2.Visible = False End If Form12.Frame1.Visible = True Form12.Frame2.Visible = True Form12.Frame6.Visible = True Form12.frame7.Visible = False Form12.Frame8.Visible = False Form12.Frame9.Visible = False Form12.Frame10.Visible = False Form12.Frame11.Visible = False Form12.Frame12.Visible = False Form12.Frame13.Visible = False Form12.Frame14.Visible = False Form12.Frame15.Visible = False Form12.Frame16.Visible = False Form12.Frame17.Visible = False Form12.Frame18.Visible = False Form12.Frame19.Visible = False Form12.Frame20.Visible = False Form12.Frame21.Visible = False Form12.Frame23.Visible = True Form12.Frame22.Visible = True Form12.Frame19.Visible = False Form12.Frame24.Visible = False Form12.Frame25.Visible = False Form12.Frame26.Visible = False Form12.Frame27.Visible = False Form12.Frame28.Visible = False Form12.Frame29.Visible = False Form12.Frame20.Visible = False Form12.Combo1.Text = "Select" For i = 1 To Numcamp1 If NomeCamp(i) = "c0" Or NomeCamp(i) = "C0" Or NomeCamp(i) = "cO" Or NomeCamp(i) = "CO" Or NomeCamp(i) = "Co" Or NomeCamp(i) = "co" Then Form12.Combo1.Text = NomeCamp(i) GoTo xx1112: End If Next i Form12.Combo1.Text = c01s Form12.Combo9.Text = c2s Form12.Combo5.Text = cas xx1112: Form12.Text5(6) = rrs1 Form12.Text5(7) = rrs Form12.Text5(8) = c1s Form12.Text2(5) = rrs1 Form12.Show Form12.SetFocus End If '--------------------------- If models$ = "ISC" Then Form12.Option1.Visible = False Form12.Option2.Visible = False Form12.Combo6 = "In Situ C" Form12.Frame1.Visible = False Form12.Frame2.Visible = True Form12.Frame6.Visible = False Form12.frame7.Visible = False Form12.Frame8.Visible = False Form12.Frame9.Visible = False Form12.Frame10.Visible = False Form12.Frame11.Visible = False Form12.Frame12.Visible = False Form12.Frame13.Visible = False Form12.Frame14.Visible = False Form12.Frame15.Visible = True Form12.Frame16.Visible = True Form12.Frame17.Visible = True Form12.Frame18.Visible = False Form12.Frame19.Visible = False Form12.Frame20.Visible = False Form12.Frame21.Visible = False Form12.Combo1.Text = "Select" For i = 1 To Numcamp1 If NomeCamp(i) = "c0" Or NomeCamp(i) = "C0" Or NomeCamp(i) = "cO" Or NomeCamp(i) = "CO" Or NomeCamp(i) = "Co" Or NomeCamp(i) = "co" Then Form12.Combo1.Text = NomeCamp(i) GoTo xx43: End If Next i Form12.Combo1.Text = c01s xx43: Form12.Show Form12.SetFocus End If If models$ = "FC" Then Form12.Option1.Visible = False Form12.Option2.Visible = False Form12.Combo6 = "FC" Form12.Frame1.Visible = True Form12.Frame2.Visible = True Form12.Frame6.Visible = False Form12.frame7.Visible = False Form12.Frame8.Visible = False Form12.Frame9.Visible = False Form12.Frame10.Visible = False Form12.Frame11.Visible = False Form12.Frame12.Visible = False Form12.Frame13.Visible = False Form12.Frame14.Visible = False Form12.Frame15.Visible = False Form12.Frame16.Visible = False Form12.Frame17.Visible = False Form12.Frame18.Visible = False Form12.Frame19.Visible = False Form12.Frame20.Visible = False Form12.Frame21.Visible = False Form12.Combo1.Text = "Select" For i = 1 To Numcamp1 If NomeCamp(i) = "c0" Or NomeCamp(i) = "C0" Or NomeCamp(i) = "cO" Or NomeCamp(i) = "CO" Or NomeCamp(i) = "Co" Or NomeCamp(i) = "co" Then Form12.Combo1.Text = NomeCamp(i) GoTo xx: End If Next i Form12.Combo1.Text = c01s xx: Form12.Show Form12.SetFocus End If If models$ = "Batch melting(mod. D0 or DR)" Then Form12.Option1.Visible = False Form12.Option2.Visible = False Form12.Combo6 = "Batch melting(mod. D0 or DR)" Form12.Frame1.Visible = True Form12.Frame2.Visible = True Form12.Frame6.Visible = False Form12.frame7.Visible = False Form12.Frame8.Visible = False Form12.Frame9.Visible = False Form12.Frame10.Visible = False Form12.Frame11.Visible = False Form12.Frame12.Visible = False Form12.Frame13.Visible = False Form12.Frame14.Visible = False Form12.Frame15.Visible = False Form12.Frame16.Visible = False Form12.Frame17.Visible = False Form12.Frame18.Visible = False Form12.Frame19.Visible = False Form12.Frame20.Visible = False Form12.Frame21.Visible = False Form12.Combo1.Text = "Select" For i = 1 To Numcamp1 If NomeCamp(i) = "source" Or NomeCamp(i) = "Source" Or NomeCamp(i) = "SOURCE" Then Form12.Combo1.Text = NomeCamp(i) GoTo xx1 End If Next i Form12.Combo1.Text = c01s xx1: Form12.Show Form12.SetFocus End If '?????????????????????????????????????? If models$ = "Batch melting(non modal)" Then Form12.Option1.Visible = False Form12.Option2.Visible = False Form12.Combo6 = "Batch melting(non modal)" Form12.Frame1.Visible = True Form12.Frame2.Visible = True Form12.Frame6.Visible = False Form12.frame7.Visible = False Form12.Frame8.Visible = False Form12.Frame9.Visible = False Form12.Frame10.Visible = False Form12.Frame11.Visible = False Form12.Frame12.Visible = True Form12.Frame13.Visible = False Form12.Frame14.Visible = False Form12.Frame15.Visible = False Form12.Frame16.Visible = False Form12.Frame17.Visible = False Form12.Frame18.Visible = False Form12.Frame19.Visible = False Form12.Frame20.Visible = False Form12.Frame21.Visible = False Form12.Combo1.Text = "Select" For i = 1 To Numcamp1 If NomeCamp(i) = "source" Or NomeCamp(i) = "Source" Or NomeCamp(i) = "SOURCE" Then Form12.Combo1.Text = NomeCamp(i) GoTo xx2 End If Next i Form12.Combo1.Text = c01s xx2: Form12.Show Form12.SetFocus End If '?????????????????????????????????????? If models$ = "FM" Then Form12.Option1.Visible = False Form12.Option2.Visible = False Form12.Combo6 = "Fract melting" Form12.Frame1.Visible = True Form12.Frame2.Visible = True Form12.Frame6.Visible = False Form12.frame7.Visible = False Form12.Frame8.Visible = False Form12.Frame9.Visible = False Form12.Frame10.Visible = False Form12.Frame11.Visible = False Form12.Frame12.Visible = False Form12.Frame13.Visible = False Form12.Frame14.Visible = False Form12.Frame15.Visible = False Form12.Frame16.Visible = False Form12.Frame17.Visible = False Form12.Frame18.Visible = False Form12.Frame19.Visible = False Form12.Frame20.Visible = False Form12.Frame21.Visible = False Form12.Combo1.Text = "Select" For i = 1 To Numcamp1 If NomeCamp(i) = "source" Or NomeCamp(i) = "Source" Or NomeCamp(i) = "SOURCE" Then Form12.Combo1.Text = NomeCamp(i) AXX(Indeks) = i GoTo xx3 End If Next i Form12.Combo1.Text = c01s xx3: Form12.Show Form12.SetFocus End If If models$ = "CM" Then Form12.Option1.Visible = False Form12.Option2.Visible = False Form12.Combo6 = "Cont melting" Form12.Frame1.Visible = True Form12.Frame2.Visible = True Form12.Frame6.Visible = False Form12.frame7.Visible = False Form12.Frame8.Visible = False Form12.Frame9.Visible = False Form12.Frame10.Visible = False Form12.Frame11.Visible = False Form12.Frame12.Visible = False Form12.Frame13.Visible = False Form12.Frame14.Visible = True Form12.Frame15.Visible = False Form12.Frame16.Visible = False Form12.Frame17.Visible = False Form12.Frame18.Visible = False Form12.Frame19.Visible = False Form12.Frame20.Visible = False Form12.Frame21.Visible = False Form12.Combo1.Text = "Select" For i = 1 To Numcamp1 If NomeCamp(i) = "source" Or NomeCamp(i) = "Source" Or NomeCamp(i) = "SOURCE" Then Form12.Combo1.Text = NomeCamp(i) AXX(Indeks) = i GoTo xx32 End If Next i Form12.Combo1.Text = c01s xx32: Form12.Show Form12.SetFocus End If If models$ = "EC" Then Form12.Option1.Visible = False Form12.Option2.Visible = False Form12.Combo6 = "EC" Form12.Frame1.Visible = True Form12.Frame2.Visible = True Form12.Frame6.Visible = False Form12.frame7.Visible = False Form12.Frame8.Visible = False Form12.Frame9.Visible = False Form12.Frame10.Visible = False Form12.Frame11.Visible = False Form12.Frame12.Visible = False Form12.Frame13.Visible = False Form12.Frame14.Visible = False Form12.Frame15.Visible = False Form12.Frame16.Visible = False Form12.Frame17.Visible = False Form12.Frame18.Visible = False Form12.Frame19.Visible = False Form12.Frame20.Visible = False Form12.Frame21.Visible = False Form12.Combo1.Text = "Select" For i = 1 To Numcamp1 If NomeCamp(i) = "c0" Or NomeCamp(i) = "C0" Or NomeCamp(i) = "cO" Or NomeCamp(i) = "CO" Or NomeCamp(i) = "Co" Or NomeCamp(i) = "co" Then Form12.Combo1.Text = NomeCamp(i) GoTo xx4 End If Next i Form12.Combo1.Text = c01s xx4: Form12.Show Form12.SetFocus End If If models$ = "mixing (Elem Vs Elem)" Then Form12.Option1.Visible = False Form12.Option2.Visible = False Form12.Combo6 = "mixing (Elem Vs Elem)" Form12.Frame1.Visible = False Form12.Frame2.Visible = False Form12.Frame6.Visible = False Form12.frame7.Visible = False Form12.Frame8.Visible = False Form12.Frame9.Visible = True Form12.Frame10.Visible = True Form12.Frame11.Visible = False Form12.Frame12.Visible = False Form12.Frame13.Visible = False Form12.Frame14.Visible = False Form12.Frame15.Visible = False Form12.Frame16.Visible = False Form12.Frame17.Visible = False Form12.Frame18.Visible = False Form12.Frame19.Visible = False Form12.Frame20.Visible = False Form12.Frame21.Visible = False If C1M(Indeks) <> "" Then Form12.Combo8.Text = c1s Else Form12.Combo8.Text = "Select" End If If C2M(Indeks) <> "" Then Form12.Combo7.Text = c2s Else Form12.Combo7.Text = "Select" End If Form12.Show Form12.SetFocus End If If models$ = "AFC" Then Form12.Option1.Visible = False Form12.Option2.Visible = False Form12.Combo6 = "AFC" Form12.Frame1.Visible = True Form12.Frame2.Visible = True Form12.Frame6.Visible = True Form12.frame7.Visible = True Form12.Frame8.Visible = False Form12.Frame9.Visible = False Form12.Frame10.Visible = False Form12.Frame11.Visible = False Form12.Frame12.Visible = False Form12.Frame13.Visible = False Form12.Frame14.Visible = False Form12.Frame15.Visible = False Form12.Frame16.Visible = False Form12.Frame17.Visible = False Form12.Frame18.Visible = False Form12.Frame19.Visible = False Form12.Frame20.Visible = False Form12.Frame21.Visible = False Form12.Combo1.Text = "Select" For i = 1 To Numcamp1 If NomeCamp(i) = "c0" Or NomeCamp(i) = "C0" Or NomeCamp(i) = "cO" Or NomeCamp(i) = "CO" Or NomeCamp(i) = "Co" Or NomeCamp(i) = "co" Then Form12.Combo1.Text = NomeCamp(i) GoTo xxx1 End If Next i Form12.Combo1.Text = c01s xxx1: Form12.Combo5.Text = "Select" For i = 1 To Numcamp1 If NomeCamp(i) = "Ca" Or NomeCamp(i) = "cA" Or NomeCamp(i) = "Ca" Or NomeCamp(i) = "ca" Or NomeCamp(i) = "CA" Then Form12.Combo5.Text = NomeCamp(i) GoTo xxx2 End If Next i Form12.Combo5.Text = cas xxx2: Form12.Text5(1) = rrs Form12.Show Form12.SetFocus End If If models$ = "Zone Refining" Then Form12.Option1.Visible = False Form12.Option2.Visible = False Form12.Combo6 = "Zone Refining" Form12.Frame1.Visible = True Form12.Frame2.Visible = True Form12.Frame6.Visible = False Form12.frame7.Visible = False Form12.Frame8.Visible = True Form12.Frame9.Visible = False Form12.Frame10.Visible = False Form12.Frame11.Visible = False Form12.Frame12.Visible = False Form12.Frame13.Visible = False Form12.Frame14.Visible = False Form12.Frame15.Visible = False Form12.Frame16.Visible = False Form12.Frame17.Visible = False Form12.Frame18.Visible = False Form12.Frame19.Visible = False Form12.Frame20.Visible = False Form12.Frame21.Visible = False Form12.Combo1.Text = "Select" For i = 1 To Numcamp1 If NomeCamp(i) = "c0" Or NomeCamp(i) = "C0" Or NomeCamp(i) = "cO" Or NomeCamp(i) = "CO" Or NomeCamp(i) = "Co" Or NomeCamp(i) = "co" Then Form12.Combo1.Text = NomeCamp(i) GoTo xxx123 End If Next i Form12.Combo1.Text = c01s xxx123: Form12.Show Form12.SetFocus End If End If '--------------- If models$ = "Mixing(R-R)" Then 'Form26.Option1.Value = True '----------------------------------------------------------- Form26.Picture1(21).BackColor = ColModLine(MODiD, Indeks) Form26.Picture1(39).BackColor = ColModSymb(MODiD, Indeks) Form26.Text1.Text = rrs 'Form26.Text2.Text = c1s Form26.Text3.Text = rrs1 'Form26.Text4.Text = cicl 'Form26.Text5.Text = stcicl Form26.Text6.Text = cas 'Form26.Text7.Text = c2s Form26.Text8.Text = c01s Form26.Label27.Visible = True Form26.Label25.Visible = True Form26.Label24.Visible = True Form26.Label3.Visible = True Form26.Label4.Visible = True Form26.Label12.Visible = True 'Form26.Label13.Visible = True 'Form26.Label23.Visible = True Form26.Line8.Visible = True Form26.Line5.Visible = True 'Form26.Text2.Visible = True 'Form26.Text7.Visible = True 'Form26.Command7.Visible = True 'Form26.Command8.Visible = True 'Form26.Picture1(21).BackColor = QBColor(12) 'Form26.Picture1(39).BackColor = QBColor(12) 'ModelSymbCol = QBColor(12) 'ModelLineCol = QBColor(12) NumModelElem = 0 INP.RecuperoXY AXX(GraphSelect), AXY(GraphSelect) NumModelElem2(Indeks) = NumModelElem 'For i = 0 To 9 'Form26.Text1(i).Visible = False 'Form26.Text1(i).Text = "0.00" 'Form26.Label1(i).Visible = False 'Next i For i = 0 To 8 Form26.Picture1(i).Scale (1, 9)-(9, 1) Next i Form26.Picture1(41).Scale (1, 9)-(9, 1) Form26.Picture1(41).FillColor = QBColor(0) Form26.Picture1(41).FillStyle = 0 Form26.Picture1(41).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B ModelSymb = 1 'picture(0) Form26.Picture1(0).FillColor = QBColor(0) Form26.Picture1(0).FillStyle = 0 Form26.Picture1(0).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B 'picture(1) Form26.Picture1(1).FillColor = QBColor(0) Form26.Picture1(1).FillStyle = 1 Form26.Picture1(1).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B 'picture(2) Form26.Picture1(2).FillColor = QBColor(0) Form26.Picture1(2).FillStyle = 0 Form26.Picture1(2).Circle (5, 5), 2, QBColor(0) 'picture(3) Form26.Picture1(3).FillColor = QBColor(0) Form26.Picture1(3).FillStyle = 1 Form26.Picture1(3).Circle (5, 5), 2, QBColor(0) 'picture(4) Form26.Picture1(4).FillStyle = 1 Form26.Picture1(4).Line (5 - 2, 5 - 2)-(5, 5 + 2), QBColor(0) Form26.Picture1(4).Line (5 - 2, 5 - 2)-(5 + 2, 5 - 2), QBColor(0) Form26.Picture1(4).Line (5 + 2, 5 - 2)-(5, 5 + 2), QBColor(0) 'picture(5) Form26.Picture1(5).FillStyle = 1 Form26.Picture1(5).Line (5 - 2, 5 + 2)-(5, 5 - 2), QBColor(0) Form26.Picture1(5).Line (5 - 2, 5 + 2)-(5 + 2, 5 + 2), QBColor(0) Form26.Picture1(5).Line (5 + 2, 5 + 2)-(5, 5 - 2), QBColor(0) 'picture(6) Form26.Picture1(6).FillStyle = 1 Form26.Picture1(6).Line (5 - 2, 5)-(5 + 2, 5), QBColor(0) Form26.Picture1(6).Line (5, 5 - 2)-(5, 5 + 2), QBColor(0) Form26.Picture1(6).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0) Form26.Picture1(6).Line (5 + 2, 5 - 2)-(5 - 2, 5 + 2), QBColor(0) 'picture(7) Form26.Picture1(7).FillStyle = 1 Form26.Picture1(7).Line (5 - 2, 5)-(5 + 2, 5), QBColor(0) Form26.Picture1(7).Line (5, 5 - 2)-(5, 5 + 2), QBColor(0) 'picture(8) Form26.Picture1(8).FillStyle = 1 Form26.Picture1(8).Line (5 - 2, 5)-(5, 5 + 4), QBColor(0) Form26.Picture1(8).Line (5, 5 + 4)-(5 + 2, 5), QBColor(0) Form26.Picture1(8).Line (5 + 2, 5)-(5, 5 - 4), QBColor(0) Form26.Picture1(8).Line (5, 5 - 4)-(5 - 2, 5), QBColor(0) Indeks = GraphSelect Form26.Show Form26.SetFocus End If '---------------- '--------------- If models$ = "Mixing(R-E)" Then Form26.Picture1(21).BackColor = ColModLine(MODiD, Indeks) Form26.Picture1(39).BackColor = ColModSymb(MODiD, Indeks) 'Form26.Option2.Value = True Form26.Text1.Text = rrs 'Form26.Text2.Text = c1s Form26.Text3.Text = rrs1 'Form26.Text4.Text = cicl 'Form26.Text5.Text = stcicl Form26.Text6.Text = cas 'Form26.Text7.Text = c2s Form26.Text8.Text = c01s Form26.Label27.Visible = False Form26.Label25.Visible = False Form26.Label24.Visible = False Form26.Label3.Visible = False Form26.Label4.Visible = False Form26.Label12.Visible = False 'Form26.Label13.Visible = False 'Form26.Label23.Visible = False Form26.Line8.Visible = False Form26.Line5.Visible = False 'Form26.Text2.Visible = False 'Form26.Text7.Visible = False 'Form26.Command7.Visible = False 'Form26.Command8.Visible = False 'Form26.Picture1(21).BackColor = QBColor(12) 'Form26.Picture1(39).BackColor = QBColor(12) 'ModelSymbCol = QBColor(12) 'ModelLineCol = QBColor(12) NumModelElem = 0 INP.RecuperoXY AXX(GraphSelect), AXY(GraphSelect) NumModelElem2(Indeks) = NumModelElem 'For i = 0 To 9 'Form26.Text1(i).Visible = False 'Form26.Text1(i).Text = "0.00" 'Form26.Label1(i).Visible = False 'Next i For i = 0 To 8 Form26.Picture1(i).Scale (1, 9)-(9, 1) Next i Form26.Picture1(41).Scale (1, 9)-(9, 1) Form26.Picture1(41).FillColor = QBColor(0) Form26.Picture1(41).FillStyle = 0 Form26.Picture1(41).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B ModelSymb = 1 'picture(0) Form26.Picture1(0).FillColor = QBColor(0) Form26.Picture1(0).FillStyle = 0 Form26.Picture1(0).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B 'picture(1) Form26.Picture1(1).FillColor = QBColor(0) Form26.Picture1(1).FillStyle = 1 Form26.Picture1(1).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B 'picture(2) Form26.Picture1(2).FillColor = QBColor(0) Form26.Picture1(2).FillStyle = 0 Form26.Picture1(2).Circle (5, 5), 2, QBColor(0) 'picture(3) Form26.Picture1(3).FillColor = QBColor(0) Form26.Picture1(3).FillStyle = 1 Form26.Picture1(3).Circle (5, 5), 2, QBColor(0) 'picture(4) Form26.Picture1(4).FillStyle = 1 Form26.Picture1(4).Line (5 - 2, 5 - 2)-(5, 5 + 2), QBColor(0) Form26.Picture1(4).Line (5 - 2, 5 - 2)-(5 + 2, 5 - 2), QBColor(0) Form26.Picture1(4).Line (5 + 2, 5 - 2)-(5, 5 + 2), QBColor(0) 'picture(5) Form26.Picture1(5).FillStyle = 1 Form26.Picture1(5).Line (5 - 2, 5 + 2)-(5, 5 - 2), QBColor(0) Form26.Picture1(5).Line (5 - 2, 5 + 2)-(5 + 2, 5 + 2), QBColor(0) Form26.Picture1(5).Line (5 + 2, 5 + 2)-(5, 5 - 2), QBColor(0) 'picture(6) Form26.Picture1(6).FillStyle = 1 Form26.Picture1(6).Line (5 - 2, 5)-(5 + 2, 5), QBColor(0) Form26.Picture1(6).Line (5, 5 - 2)-(5, 5 + 2), QBColor(0) Form26.Picture1(6).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0) Form26.Picture1(6).Line (5 + 2, 5 - 2)-(5 - 2, 5 + 2), QBColor(0) 'picture(7) Form26.Picture1(7).FillStyle = 1 Form26.Picture1(7).Line (5 - 2, 5)-(5 + 2, 5), QBColor(0) Form26.Picture1(7).Line (5, 5 - 2)-(5, 5 + 2), QBColor(0) 'picture(8) Form26.Picture1(8).FillStyle = 1 Form26.Picture1(8).Line (5 - 2, 5)-(5, 5 + 4), QBColor(0) Form26.Picture1(8).Line (5, 5 + 4)-(5 + 2, 5), QBColor(0) Form26.Picture1(8).Line (5 + 2, 5)-(5, 5 - 4), QBColor(0) Form26.Picture1(8).Line (5, 5 - 4)-(5 - 2, 5), QBColor(0) Indeks = GraphSelect Form26.Show Form26.SetFocus End If '---------------- '--------------- If models$ = "Mixing(R-1/E)" Then Form26.Picture1(21).BackColor = ColModLine(MODiD, Indeks) Form26.Picture1(39).BackColor = ColModSymb(MODiD, Indeks) 'Form26.Option3.Value = True Form26.Text1.Text = rrs 'Form26.Text2.Text = c1s Form26.Text3.Text = rrs1 'Form26.Text4.Text = cicl 'Form26.Text5.Text = stcicl Form26.Text6.Text = cas 'Form26.Text7.Text = c2s Form26.Text8.Text = c01s Form26.Label27.Visible = False Form26.Label25.Visible = False Form26.Label24.Visible = False Form26.Label3.Visible = False Form26.Label4.Visible = False Form26.Label12.Visible = False 'Form26.Label13.Visible = False 'Form26.Label23.Visible = False Form26.Line8.Visible = False Form26.Line5.Visible = False 'Form26.Text2.Visible = False 'Form26.Text7.Visible = False 'Form26.Command7.Visible = False 'Form26.Command8.Visible = False Form26.Picture1(21).BackColor = QBColor(12) Form26.Picture1(39).BackColor = QBColor(12) ModelSymbCol = QBColor(12) ModelLineCol = QBColor(12) NumModelElem = 0 INP.RecuperoXY AXX(GraphSelect), AXY(GraphSelect) NumModelElem2(Indeks) = NumModelElem 'For i = 0 To 9 'Form26.Text1(i).Visible = False 'Form26.Text1(i).Text = "0.00" 'Form26.Label1(i).Visible = False 'Next i For i = 0 To 8 Form26.Picture1(i).Scale (1, 9)-(9, 1) Next i Form26.Picture1(41).Scale (1, 9)-(9, 1) Form26.Picture1(41).FillColor = QBColor(0) Form26.Picture1(41).FillStyle = 0 Form26.Picture1(41).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B ModelSymb = 1 'picture(0) Form26.Picture1(0).FillColor = QBColor(0) Form26.Picture1(0).FillStyle = 0 Form26.Picture1(0).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B 'picture(1) Form26.Picture1(1).FillColor = QBColor(0) Form26.Picture1(1).FillStyle = 1 Form26.Picture1(1).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B 'picture(2) Form26.Picture1(2).FillColor = QBColor(0) Form26.Picture1(2).FillStyle = 0 Form26.Picture1(2).Circle (5, 5), 2, QBColor(0) 'picture(3) Form26.Picture1(3).FillColor = QBColor(0) Form26.Picture1(3).FillStyle = 1 Form26.Picture1(3).Circle (5, 5), 2, QBColor(0) 'picture(4) Form26.Picture1(4).FillStyle = 1 Form26.Picture1(4).Line (5 - 2, 5 - 2)-(5, 5 + 2), QBColor(0) Form26.Picture1(4).Line (5 - 2, 5 - 2)-(5 + 2, 5 - 2), QBColor(0) Form26.Picture1(4).Line (5 + 2, 5 - 2)-(5, 5 + 2), QBColor(0) 'picture(5) Form26.Picture1(5).FillStyle = 1 Form26.Picture1(5).Line (5 - 2, 5 + 2)-(5, 5 - 2), QBColor(0) Form26.Picture1(5).Line (5 - 2, 5 + 2)-(5 + 2, 5 + 2), QBColor(0) Form26.Picture1(5).Line (5 + 2, 5 + 2)-(5, 5 - 2), QBColor(0) 'picture(6) Form26.Picture1(6).FillStyle = 1 Form26.Picture1(6).Line (5 - 2, 5)-(5 + 2, 5), QBColor(0) Form26.Picture1(6).Line (5, 5 - 2)-(5, 5 + 2), QBColor(0) Form26.Picture1(6).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0) Form26.Picture1(6).Line (5 + 2, 5 - 2)-(5 - 2, 5 + 2), QBColor(0) 'picture(7) Form26.Picture1(7).FillStyle = 1 Form26.Picture1(7).Line (5 - 2, 5)-(5 + 2, 5), QBColor(0) Form26.Picture1(7).Line (5, 5 - 2)-(5, 5 + 2), QBColor(0) 'picture(8) Form26.Picture1(8).FillStyle = 1 Form26.Picture1(8).Line (5 - 2, 5)-(5, 5 + 4), QBColor(0) Form26.Picture1(8).Line (5, 5 + 4)-(5 + 2, 5), QBColor(0) Form26.Picture1(8).Line (5 + 2, 5)-(5, 5 - 4), QBColor(0) Form26.Picture1(8).Line (5, 5 - 4)-(5 - 2, 5), QBColor(0) Indeks = GraphSelect Form26.Show Form26.SetFocus End If '---------------- '----------------- If models$ = "AFCiso" Then Form27.Picture1(21).BackColor = ColModLine(MODiD, Indeks) Form27.Picture1(39).BackColor = ColModSymb(MODiD, Indeks) NumModelElem = 0 Form27.Label1(0).Caption = "D for " + Elementi(AXX(Indeks)) Form27.Text1(0).Visible = True Form27.Text1(0).Text = ModD(1) Form27.Label1(0).Visible = True Form27.Combo1.Text = c01s Form27.Combo2.Text = cas Form27.Text5(1).Text = rrs For i = 0 To 8 Form27.Picture1(i).Scale (1, 9)-(9, 1) Next i Form27.Picture1(41).Scale (1, 9)-(9, 1) Form27.Picture1(41).FillColor = QBColor(0) Form27.Picture1(41).FillStyle = 0 Form27.Picture1(41).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B ModelSymb = 1 'picture(0) Form27.Picture1(0).FillColor = QBColor(0) Form27.Picture1(0).FillStyle = 0 Form27.Picture1(0).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B 'picture(1) Form27.Picture1(1).FillColor = QBColor(0) Form27.Picture1(1).FillStyle = 1 Form27.Picture1(1).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B 'picture(2) Form27.Picture1(2).FillColor = QBColor(0) Form27.Picture1(2).FillStyle = 0 Form27.Picture1(2).Circle (5, 5), 2, QBColor(0) 'picture(3) Form27.Picture1(3).FillColor = QBColor(0) Form27.Picture1(3).FillStyle = 1 Form27.Picture1(3).Circle (5, 5), 2, QBColor(0) 'picture(4) Form27.Picture1(4).FillStyle = 1 Form27.Picture1(4).Line (5 - 2, 5 - 2)-(5, 5 + 2), QBColor(0) Form27.Picture1(4).Line (5 - 2, 5 - 2)-(5 + 2, 5 - 2), QBColor(0) Form27.Picture1(4).Line (5 + 2, 5 - 2)-(5, 5 + 2), QBColor(0) 'picture(5) Form27.Picture1(5).FillStyle = 1 Form27.Picture1(5).Line (5 - 2, 5 + 2)-(5, 5 - 2), QBColor(0) Form27.Picture1(5).Line (5 - 2, 5 + 2)-(5 + 2, 5 + 2), QBColor(0) Form27.Picture1(5).Line (5 + 2, 5 + 2)-(5, 5 - 2), QBColor(0) 'picture(6) Form27.Picture1(6).FillStyle = 1 Form27.Picture1(6).Line (5 - 2, 5)-(5 + 2, 5), QBColor(0) Form27.Picture1(6).Line (5, 5 - 2)-(5, 5 + 2), QBColor(0) Form27.Picture1(6).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0) Form27.Picture1(6).Line (5 + 2, 5 - 2)-(5 - 2, 5 + 2), QBColor(0) 'picture(7) Form27.Picture1(7).FillStyle = 1 Form27.Picture1(7).Line (5 - 2, 5)-(5 + 2, 5), QBColor(0) Form27.Picture1(7).Line (5, 5 - 2)-(5, 5 + 2), QBColor(0) 'picture(8) Form27.Picture1(8).FillStyle = 1 Form27.Picture1(8).Line (5 - 2, 5)-(5, 5 + 4), QBColor(0) Form27.Picture1(8).Line (5, 5 + 4)-(5 + 2, 5), QBColor(0) Form27.Picture1(8).Line (5 + 2, 5)-(5, 5 - 4), QBColor(0) Form27.Picture1(8).Line (5, 5 - 4)-(5 - 2, 5), QBColor(0) Form27.Show Form27.SetFocus End If '------------------ CambiaMod = True poi1: End Sub Private Sub opzCercaCamp_Click() For i = 1 To Numcamp1 Form21.CB1.AddItem NomeCamp(i) Next i Form21.Show Form21.SetFocus End Sub Private Sub opzCIPWTABLE_Click() If Fileopen = False Then 'MsgBox "Non è possibile eseguire questa operazione se prima non si apre un file di dati" Exit Sub End If CIPW.Norm CIPWyn = True Form7.Show Form7.SetFocus End Sub Private Sub opzCopia_Click() Clipboard.Clear Indeks = IndexSel Dim obj As Picture On Error GoTo ene 'obj.AutoSize = True 'MF1.CloseMeta 'obj = LoadPicture(App.Path + "\data\g10" + Trim(Indeks) + ".wmf") Set obj = LoadPicture(App.Path + "\data\g10" + Trim(Indeks) + ".wmf") Clipboard.SetData obj '(vbcmetafile) Exit Sub ene: MF1.CloseMeta End Sub Private Sub opzcopiasel2_Click() If TipoCopia = "DATI" Then Clipboard.Clear Clipboard.SetText BackGrnd.FG1.Clip End If End Sub Private Sub opzCopiaSelezione_Click() If TipoCopia = "REE" Then Clipboard.Clear Clipboard.SetText Form9.MSFG1.Clip End If If TipoCopia = "DATI" Then Clipboard.Clear Clipboard.SetText BackGrnd.FG1.Clip End If If TipoCopia = "CIPW" Then Clipboard.Clear Clipboard.SetText Form7.Fl2.Clip End If End Sub Private Sub opzCopyStromer_Click() Clipboard.Clear Clipboard.SetText Form30.FG1.Clip End Sub Private Sub opzCrY_Click() DiagramType1 = "CrY" Form1.Show Form1.SetFocus End Sub Private Sub opzElabInput_Click() If Fileopen = True Then Form6.Show Form6.SetFocus End If If Fileopen = False Then 'MsgBox "Non è possibile eseguire questa operazione se prima non si apre un file di dati" End If End Sub Private Sub opzExit_Click() End End Sub Private Sub opzFilePetrograph_Click() Dim Symbol(5000) As Integer Dim Color(5000) As Integer On Error GoTo ere For ia = 1 To 15 NumModelli(ia) = 0 Next ia CommonDialog1.DialogTitle = "Open Data(.PEG) ..." CommonDialog1.Filter = "*.PEG" CommonDialog1.FileName = "*.PEG" CommonDialog1.ShowOpen file$ = CommonDialog1.FileName jj = Len(file$) Nomegruppo = left(file$, jj - 4) On Error GoTo ere1 Open file$ For Input As #1 Input #1, Numelem, Numcamp1, NumL Input #1, aa, bb, cc, dd For i = 1 To Numelem Input #1, aa Elementi(i) = aa Next i For i = 1 To Numcamp1 Input #1, aaa, aa, bb, cc, dd NomeCamp(i) = aa Symbol(i) = bb Color(i) = cc plot1(i) = dd For ii = 1 To Numelem Input #1, aa DatiOrigine(i, ii) = aa Next ii Next i On Error GoTo dopo11 Input #1, aa For i = 1 To NumL Input #1, aa, bb, cc SerieL(i) = aa ColS(i) = bb TipoS(i) = cc Next i Legen = True dopo11: Close #1 'Converto eventuali imperfezioni nelle notazioni For k = 1 To Numelem If Elementi(k) = "SiO[2]" Then Elementi(k) = "SiO2" GoTo rr End If If Elementi(k) = "TiO[2]" Then Elementi(k) = "TiO2" GoTo rr End If If Elementi(k) = "Al[2]O[3]" Then Elementi(k) = "Al2O3" GoTo rr End If If Elementi(k) = "Fe[2]O[3]" Then Elementi(k) = "Fe2O3" GoTo rr End If If Elementi(k) = "FeO" Then Elementi(k) = "FeO" GoTo rr End If If Elementi(k) = "MnO" Then Elementi(k) = "MnO" GoTo rr End If If Elementi(k) = "MgO" Then Elementi(k) = "MgO" GoTo rr End If If Elementi(k) = "CaO" Then Elementi(k) = "CaO" GoTo rr End If If Elementi(k) = "Na[2]O" Then Elementi(k) = "Na2O" GoTo rr End If If Elementi(k) = "K[2]O" Then Elementi(k) = "K2O" GoTo rr End If If Elementi(k) = "P[2]O[5]" Then Elementi(k) = "P2O5" GoTo rr End If If Elementi(k) = "H[2]O+" Then Elementi(k) = "H2O+" GoTo rr End If If Elementi(k) = "H2[O]-" Then Elementi(k) = "H2O-" k = k + 1 GoTo rr End If If Elementi(k) = "Cr[2]O[3]" Then Elementi(k) = "Cr2O3" GoTo rr End If If Elementi(k) = "NiO" Then Elementi(k) = "NiO" GoTo rr End If rr: Next k 'inserisco i dati nella tabella NumElem0 = Numelem NumElem1 = Numelem 'inserisco i dati nella flex grid BackGrnd.FG1.Rows = Numcamp1 + 1 BackGrnd.FG1.ColS = Numelem + 4 For i = 1 To Numelem + 2 BackGrnd.FG1.ColWidth(i) = 1500 Next i Form9.MSFG1.Rows = Numcamp1 + 2 Form9.MSFG1.Row = Numcamp1 + 1 Form9.MSFG1.col = 0 Form9.MSFG1.Text = "mean" For i = 4 To Numelem + 3 BackGrnd.FG1.Row = 0 BackGrnd.FG1.col = i BackGrnd.FG1.Text = Elementi(i - 3) Next i Form7.Fl2.Rows = Numcamp1 + 1 Form7.Fl2.ColS = 33 '28 ATTENZIONE For i = 1 To Numcamp1 Form12.Combo1.AddItem NomeCamp(i) Form12.Combo5.AddItem NomeCamp(i) Form12.Combo7.AddItem NomeCamp(i) Form12.Combo8.AddItem NomeCamp(i) Form8.Combo1.AddItem NomeCamp(i) BackGrnd.FG1.Row = i BackGrnd.FG1.col = 0 BackGrnd.FG1.Text = NomeCamp(i) Form7.Fl2.Row = i Form7.Fl2.col = 0 Form7.Fl2.Text = NomeCamp(i) Form9.MSFG1.col = 0 Form9.MSFG1.Row = i Form9.MSFG1.Text = NomeCamp(i) Next i For i = 1 To Numcamp1 For ii = 4 To Numelem + 3 BackGrnd.FG1.Row = i BackGrnd.FG1.col = ii If DatiOrigine(i, ii - 3) = -12345.67 Then BackGrnd.FG1.Text = "-" GoTo et End If BackGrnd.FG1.Text = DatiOrigine(i, ii - 3) et: Next ii Next i BackGrnd.FG1.Row = 0 BackGrnd.FG1.col = 1 BackGrnd.FG1.Text = "Symbol" BackGrnd.FG1.col = 2 BackGrnd.FG1.Text = "Color" BackGrnd.FG1.col = 3 BackGrnd.FG1.Text = "Plot (0-1)" For i = 1 To Numcamp1 BackGrnd.FG1.Row = i BackGrnd.FG1.col = 1 BackGrnd.FG1.Text = Symbol(i) BackGrnd.FG1.col = 2 BackGrnd.FG1.Text = Color(i) BackGrnd.FG1.col = 3 BackGrnd.FG1.Text = plot1(i) Next i INP.ResettaForm13 INP.InserisciInForm13Start BackGrnd.Show Form12.Hide Fileopen = True For i = 1 To Numcamp1 SimbFilter(i) = 1 Next i GoTo ere ere1: MsgBox "An Error Occurred", , "Error" Fileopen = False BackGrnd.Hide Form12.Hide Close #1 Close #2 Close #3 'GoTo ere1 ere: Form7.Hide End Sub Private Sub opzImportWSymbol_Click() Dim Symbol(5000) As Integer Dim Color(5000) As Integer On Error GoTo ere1 Dim a(105) For ia = 1 To 15 NumModelli(ia) = 0 Next ia 'caso in cui apro il primo file If Fileopen = False Then CommonDialog1.DialogTitle = "Open Analysis file(.XLS) ..." CommonDialog1.Filter = "*.XLS" CommonDialog1.FileName = "*.XLS" CommonDialog1.ShowOpen file$ = CommonDialog1.FileName jj = Len(file$) Nomegruppo = left(file$, jj - 4) On Error GoTo ere2 'resetto le variabili Erase DatiOrigine Erase Elementi Erase NomeCamp Erase KeyVal CIPWyn = False REEOperation = False Numelem = 0 Numcamp1 = 0 NumElem0 = 0 MDIForm1.StatusBar1.Panels(1).Text = "" MDIForm1.StatusBar1.Panels(2).Text = "" MDIForm1.StatusBar1.Panels(3).Text = "" BackGrnd.FG1.Clear BackGrnd.Hide Legen = False 'form2 Form2.Combo1.Clear Form2.Combo2.Clear 'form3 Form3.Combo1.Clear Form3.Combo2.Clear Form3.Combo3.Clear 'form6 Form6.Combo1.Clear Form6.Combo2.Clear Set MonXL = CreateObject("Excel.Application") MonXL.Workbooks.Open FileName:=file$ '1 '2 '3 '4 MonXL.range("E1").Select MonXL.selection.Copy a(4) = Clipboard.GetText Clipboard.Clear '5 MonXL.range("F1").Select MonXL.selection.Copy a(5) = Clipboard.GetText Clipboard.Clear '6 MonXL.range("G1").Select MonXL.selection.Copy a(6) = Clipboard.GetText Clipboard.Clear '7 MonXL.range("H1").Select MonXL.selection.Copy a(7) = Clipboard.GetText Clipboard.Clear '8 MonXL.range("I1").Select MonXL.selection.Copy a(8) = Clipboard.GetText Clipboard.Clear '9 MonXL.range("J1").Select MonXL.selection.Copy a(9) = Clipboard.GetText Clipboard.Clear '10 MonXL.range("K1").Select MonXL.selection.Copy a(10) = Clipboard.GetText Clipboard.Clear '11 MonXL.range("L1").Select MonXL.selection.Copy a(11) = Clipboard.GetText Clipboard.Clear '12 MonXL.range("M1").Select MonXL.selection.Copy a(12) = Clipboard.GetText Clipboard.Clear '13 MonXL.range("N1").Select MonXL.selection.Copy a(13) = Clipboard.GetText Clipboard.Clear '14 MonXL.range("O1").Select MonXL.selection.Copy a(14) = Clipboard.GetText Clipboard.Clear '15 MonXL.range("P1").Select MonXL.selection.Copy a(15) = Clipboard.GetText Clipboard.Clear '16 MonXL.range("Q1").Select MonXL.selection.Copy a(16) = Clipboard.GetText Clipboard.Clear '17 MonXL.range("R1").Select MonXL.selection.Copy a(17) = Clipboard.GetText Clipboard.Clear '18 MonXL.range("S1").Select MonXL.selection.Copy a(18) = Clipboard.GetText Clipboard.Clear '19 MonXL.range("T1").Select MonXL.selection.Copy a(19) = Clipboard.GetText Clipboard.Clear '20 MonXL.range("U1").Select MonXL.selection.Copy a(20) = Clipboard.GetText Clipboard.Clear '21 MonXL.range("V1").Select MonXL.selection.Copy a(21) = Clipboard.GetText Clipboard.Clear '22 MonXL.range("W1").Select MonXL.selection.Copy a(22) = Clipboard.GetText Clipboard.Clear '23 MonXL.range("X1").Select MonXL.selection.Copy a(23) = Clipboard.GetText Clipboard.Clear '24 MonXL.range("Y1").Select MonXL.selection.Copy a(24) = Clipboard.GetText Clipboard.Clear '25 MonXL.range("Z1").Select MonXL.selection.Copy a(25) = Clipboard.GetText Clipboard.Clear '26 MonXL.range("AA1").Select MonXL.selection.Copy a(26) = Clipboard.GetText Clipboard.Clear '27 MonXL.range("AB1").Select MonXL.selection.Copy a(27) = Clipboard.GetText Clipboard.Clear '28 MonXL.range("AC1").Select MonXL.selection.Copy a(28) = Clipboard.GetText Clipboard.Clear '29 MonXL.range("AD1").Select MonXL.selection.Copy a(29) = Clipboard.GetText Clipboard.Clear '30 MonXL.range("AE1").Select MonXL.selection.Copy a(30) = Clipboard.GetText Clipboard.Clear '31 MonXL.range("AF1").Select MonXL.selection.Copy a(31) = Clipboard.GetText Clipboard.Clear '32 MonXL.range("AG1").Select MonXL.selection.Copy a(32) = Clipboard.GetText Clipboard.Clear '33 MonXL.range("AH1").Select MonXL.selection.Copy a(33) = Clipboard.GetText Clipboard.Clear '34 MonXL.range("AI1").Select MonXL.selection.Copy a(34) = Clipboard.GetText Clipboard.Clear '35 MonXL.range("AJ1").Select MonXL.selection.Copy a(35) = Clipboard.GetText Clipboard.Clear '36 MonXL.range("AK1").Select MonXL.selection.Copy a(36) = Clipboard.GetText Clipboard.Clear '37 MonXL.range("AL1").Select MonXL.selection.Copy a(37) = Clipboard.GetText Clipboard.Clear '38 MonXL.range("AM1").Select MonXL.selection.Copy a(38) = Clipboard.GetText Clipboard.Clear '39 MonXL.range("AN1").Select MonXL.selection.Copy a(39) = Clipboard.GetText Clipboard.Clear '40 MonXL.range("AO1").Select MonXL.selection.Copy a(40) = Clipboard.GetText Clipboard.Clear '41 MonXL.range("AP1").Select MonXL.selection.Copy a(41) = Clipboard.GetText Clipboard.Clear '42 MonXL.range("AQ1").Select MonXL.selection.Copy a(42) = Clipboard.GetText Clipboard.Clear '43 MonXL.range("AR1").Select MonXL.selection.Copy a(43) = Clipboard.GetText Clipboard.Clear '44 MonXL.range("AS1").Select MonXL.selection.Copy a(44) = Clipboard.GetText Clipboard.Clear '45 MonXL.range("AT1").Select MonXL.selection.Copy a(45) = Clipboard.GetText Clipboard.Clear '46 MonXL.range("AU1").Select MonXL.selection.Copy a(46) = Clipboard.GetText Clipboard.Clear '47 MonXL.range("AV1").Select MonXL.selection.Copy a(47) = Clipboard.GetText Clipboard.Clear '48 MonXL.range("AW1").Select MonXL.selection.Copy a(48) = Clipboard.GetText Clipboard.Clear '49 MonXL.range("AX1").Select MonXL.selection.Copy a(49) = Clipboard.GetText Clipboard.Clear '50 MonXL.range("AY1").Select MonXL.selection.Copy a(50) = Clipboard.GetText Clipboard.Clear '51 MonXL.range("AZ1").Select MonXL.selection.Copy a(51) = Clipboard.GetText Clipboard.Clear '52 MonXL.range("BA1").Select MonXL.selection.Copy a(52) = Clipboard.GetText Clipboard.Clear '53 MonXL.range("BB1").Select MonXL.selection.Copy a(53) = Clipboard.GetText Clipboard.Clear '54 MonXL.range("BC1").Select MonXL.selection.Copy a(54) = Clipboard.GetText Clipboard.Clear '55 MonXL.range("BD1").Select MonXL.selection.Copy a(55) = Clipboard.GetText Clipboard.Clear '56 MonXL.range("BE1").Select MonXL.selection.Copy a(56) = Clipboard.GetText Clipboard.Clear '57 MonXL.range("BF1").Select MonXL.selection.Copy a(57) = Clipboard.GetText Clipboard.Clear '58 MonXL.range("BG1").Select MonXL.selection.Copy a(58) = Clipboard.GetText Clipboard.Clear '59 MonXL.range("BH1").Select MonXL.selection.Copy a(59) = Clipboard.GetText Clipboard.Clear '60 MonXL.range("BI1").Select MonXL.selection.Copy a(60) = Clipboard.GetText Clipboard.Clear '61 MonXL.range("BJ1").Select MonXL.selection.Copy a(61) = Clipboard.GetText Clipboard.Clear '62 MonXL.range("BK1").Select MonXL.selection.Copy a(62) = Clipboard.GetText Clipboard.Clear '63 MonXL.range("BL1").Select MonXL.selection.Copy a(63) = Clipboard.GetText Clipboard.Clear '64 MonXL.range("BM1").Select MonXL.selection.Copy a(64) = Clipboard.GetText Clipboard.Clear '65 MonXL.range("BN1").Select MonXL.selection.Copy a(65) = Clipboard.GetText Clipboard.Clear '66 MonXL.range("BO1").Select MonXL.selection.Copy a(66) = Clipboard.GetText Clipboard.Clear '67 MonXL.range("BP1").Select MonXL.selection.Copy a(67) = Clipboard.GetText Clipboard.Clear '68 MonXL.range("BQ1").Select MonXL.selection.Copy a(68) = Clipboard.GetText Clipboard.Clear '69 MonXL.range("BR1").Select MonXL.selection.Copy a(69) = Clipboard.GetText Clipboard.Clear '70 MonXL.range("BS1").Select MonXL.selection.Copy a(70) = Clipboard.GetText Clipboard.Clear '71 MonXL.range("BT1").Select MonXL.selection.Copy a(71) = Clipboard.GetText Clipboard.Clear '72 MonXL.range("BU1").Select MonXL.selection.Copy a(72) = Clipboard.GetText Clipboard.Clear '73 MonXL.range("BV1").Select MonXL.selection.Copy a(73) = Clipboard.GetText Clipboard.Clear '74 MonXL.range("BW1").Select MonXL.selection.Copy a(74) = Clipboard.GetText Clipboard.Clear '75 MonXL.range("BX1").Select MonXL.selection.Copy a(75) = Clipboard.GetText Clipboard.Clear '76 MonXL.range("BY1").Select MonXL.selection.Copy a(76) = Clipboard.GetText Clipboard.Clear '77 MonXL.range("BZ1").Select MonXL.selection.Copy a(77) = Clipboard.GetText Clipboard.Clear '78 MonXL.range("CA1").Select MonXL.selection.Copy a(78) = Clipboard.GetText Clipboard.Clear '79 MonXL.range("CB1").Select MonXL.selection.Copy a(79) = Clipboard.GetText Clipboard.Clear '80 MonXL.range("CC1").Select MonXL.selection.Copy a(80) = Clipboard.GetText Clipboard.Clear '81 MonXL.range("CD1").Select MonXL.selection.Copy a(81) = Clipboard.GetText Clipboard.Clear '82 MonXL.range("CE1").Select MonXL.selection.Copy a(82) = Clipboard.GetText Clipboard.Clear '83 MonXL.range("CF1").Select MonXL.selection.Copy a(83) = Clipboard.GetText Clipboard.Clear '82 MonXL.range("CG1").Select MonXL.selection.Copy a(84) = Clipboard.GetText Clipboard.Clear '85 MonXL.range("CH1").Select MonXL.selection.Copy a(85) = Clipboard.GetText Clipboard.Clear '86 MonXL.range("CI1").Select MonXL.selection.Copy a(86) = Clipboard.GetText Clipboard.Clear '87 MonXL.range("CJ1").Select MonXL.selection.Copy a(87) = Clipboard.GetText Clipboard.Clear '88 MonXL.range("CK1").Select MonXL.selection.Copy a(88) = Clipboard.GetText Clipboard.Clear '89 MonXL.range("CL1").Select MonXL.selection.Copy a(89) = Clipboard.GetText Clipboard.Clear '90 MonXL.range("CM1").Select MonXL.selection.Copy a(90) = Clipboard.GetText Clipboard.Clear '91 MonXL.range("CN1").Select MonXL.selection.Copy a(91) = Clipboard.GetText Clipboard.Clear '92 MonXL.range("CO1").Select MonXL.selection.Copy a(92) = Clipboard.GetText Clipboard.Clear '93 MonXL.range("CP1").Select MonXL.selection.Copy a(93) = Clipboard.GetText Clipboard.Clear '94 MonXL.range("CQ1").Select MonXL.selection.Copy a(94) = Clipboard.GetText Clipboard.Clear '95 MonXL.range("CR1").Select MonXL.selection.Copy a(95) = Clipboard.GetText Clipboard.Clear '96 MonXL.range("CS1").Select MonXL.selection.Copy a(96) = Clipboard.GetText Clipboard.Clear '97 MonXL.range("CT1").Select MonXL.selection.Copy a(97) = Clipboard.GetText Clipboard.Clear '98 MonXL.range("CU1").Select MonXL.selection.Copy a(98) = Clipboard.GetText Clipboard.Clear '99 MonXL.range("CV1").Select MonXL.selection.Copy a(99) = Clipboard.GetText Clipboard.Clear '100 MonXL.range("CW1").Select MonXL.selection.Copy a(100) = Clipboard.GetText Clipboard.Clear '100 MonXL.range("CX1").Select MonXL.selection.Copy a(101) = Clipboard.GetText Clipboard.Clear '100 MonXL.range("CY1").Select MonXL.selection.Copy a(102) = Clipboard.GetText Clipboard.Clear '100 MonXL.range("CZ1").Select MonXL.selection.Copy a(103) = Clipboard.GetText Clipboard.Clear 'Elementi Open App.Path + "\data\Elementi.txt" For Output As #1 '13-05 For i = 3 To 103 Print #1, a(i) Next i Close #1 Open App.Path + "\data\Elementi.txt" For Input As #1 k = 0 Do While Not EOF(1) ' Loop until end of file. Line Input #1, aa k = k + 1 If aa = "" Then k = k - 1 GoTo ww End If Elementi(k) = aa ' Combo1.AddItem aa Form2.Visible = False Form3.Visible = False Form2.Combo1.AddItem aa Form2.Combo2.AddItem aa Form3.Combo1.AddItem aa Form3.Combo2.AddItem aa Form3.Combo3.AddItem aa Form6.Combo1.AddItem aa Form6.Combo2.AddItem aa Form2.Visible = False Form3.Visible = False ww: Loop Numelem = k 'Label1.Caption = k Close #1 'CAMPIONI MonXL.range("A2:A5000").Select MonXL.selection.Copy bbb = Clipboard.GetText Open App.Path + "\data\Campioni.txt" For Output As #2 Print #2, bbb Close #2 Open App.Path + "\data\Campioni.txt" For Input As #2 k = 0 Do While Not EOF(2) ' Loop until end of file. Line Input #2, aa k = k + 1 If aa = "" Then k = k - 1 GoTo ww1 End If NomeCamp(k) = aa 'Combo2.AddItem aa ww1: Loop Close #2 NumElem0 = Numelem NumElem1 = Numelem 'simboli e colori 'Simboli MonXL.range("B2:B5000").Select MonXL.selection.Copy bbb = Clipboard.GetText Open App.Path + "\data\Key.txt" For Output As #2 Print #2, bbb Close #2 Open App.Path + "\data\Key.txt" For Input As #2 k = 0 Do While Not EOF(2) ' Loop until end of file. Line Input #2, aa k = k + 1 If aa = "" Then k = k - 1 GoTo ww45 End If KeyVal(k) = Abs(aa) ww45: Loop Close #2 Numcamp1 = k 'colori MonXL.range("C2:C5000").Select MonXL.selection.Copy bbb = Clipboard.GetText Open App.Path + "\data\Color.txt" For Output As #2 Print #2, bbb Close #2 Open App.Path + "\data\Color.txt" For Input As #2 k = 0 Do While Not EOF(2) ' Loop until end of file. Line Input #2, aa k = k + 1 If aa = "" Then k = k - 1 GoTo ww451 End If Color(k) = Abs(aa) ww451: Loop Close #2 '--------------------- 'plot si no MonXL.range("D2:D5000").Select MonXL.selection.Copy bbb = Clipboard.GetText Open App.Path + "\data\PotYN.txt" For Output As #2 Print #2, bbb Close #2 Open App.Path + "\data\PotYN.txt" For Input As #2 k = 0 Do While Not EOF(2) ' Loop until end of file. Line Input #2, aa k = k + 1 If aa = "" Then k = k - 1 GoTo ww451a End If plot1(k) = Abs(aa) ww451a: Loop Close #2 '--------------------- 'DATI Form15.Show Form15.ProgressBar1.Value = 0 Form15.Label1.Caption = "Importing file .XLS" Form15.ProgressBar1.Max = Numelem + 4 t0 = Timer nsecond = 2 Do While Timer - t0 < nsecond dummy = DoEvents() If Timer < t0 Then t0 = t0 - CLng(24) * CLng(60) * CLng(60) End If Loop MonXL.range("A2:CZ501").Select Set Intervallo = MonXL.selection.currentregion For i = 5 To Numelem + 4 'attenzione 24-11-03 For ii = 2 To Numcamp1 + 1 If Intervallo(ii, i) = "-" Then DatiOrigine(ii - 1, i - 4) = -12345.67 GoTo poiqq End If If Intervallo(ii, i) = "0" Then DatiOrigine(ii - 1, i - 4) = -12345.67 GoTo poiqq End If If Intervallo(ii, i) = "" Then DatiOrigine(ii - 1, i - 4) = -12345.67 GoTo poiqq End If If Intervallo(ii, i) = " " Then DatiOrigine(ii - 1, i - 4) = -12345.67 GoTo poiqq End If tt = left(Intervallo(ii, i), 1) If tt = "<" Then DatiOrigine(ii - 1, i - 4) = -12345.67 GoTo poiqq End If On Error GoTo poiqq DatiOrigine(ii - 1, i - 4) = Val(Intervallo(ii, i)) poiqq: Next Form15.ProgressBar1.Value = i Next 'For i = 1 To Numelem 'For ii = 1 To Numcamp1 'If DatiOrigine(ii, i) = 0 Then 'DatiOrigine(ii, i) = -12345.67 'End If 'Next 'Next On Error GoTo qwer12 Clipboard.Clear MonXL.activeWorkbook.Close SaveChanges:=False qwer12: MonXL.quit Set MonXL = Nothing 'Converto eventuali imperfezioni nelle notazioni For k = 1 To Numelem If Elementi(k) = "SiO[2]" Then Elementi(k) = "SiO2" GoTo rr End If If Elementi(k) = "TiO[2]" Then Elementi(k) = "TiO2" GoTo rr End If If Elementi(k) = "Al[2]O[3]" Then Elementi(k) = "Al2O3" GoTo rr End If If Elementi(k) = "Fe[2]O[3]" Then Elementi(k) = "Fe2O3" GoTo rr End If If Elementi(k) = "FeO" Then Elementi(k) = "FeO" GoTo rr End If If Elementi(k) = "MnO" Then Elementi(k) = "MnO" GoTo rr End If If Elementi(k) = "MgO" Then Elementi(k) = "MgO" GoTo rr End If If Elementi(k) = "CaO" Then Elementi(k) = "CaO" GoTo rr End If If Elementi(k) = "Na[2]O" Then Elementi(k) = "Na2O" GoTo rr End If If Elementi(k) = "K[2]O" Then Elementi(k) = "K2O" GoTo rr End If If Elementi(k) = "P[2]O[5]" Then Elementi(k) = "P2O5" GoTo rr End If If Elementi(k) = "H[2]O+" Then Elementi(k) = "H2O+" GoTo rr End If If Elementi(k) = "H2[O]-" Then Elementi(k) = "H2O-" k = k + 1 GoTo rr End If If Elementi(k) = "Cr[2]O[3]" Then Elementi(k) = "Cr2O3" GoTo rr End If If Elementi(k) = "NiO" Then Elementi(k) = "NiO" GoTo rr End If rr: Next k 'inserisco i dati nella flex grid BackGrnd.FG1.Rows = Numcamp1 + 1 BackGrnd.FG1.ColS = Numelem + 4 Form7.Fl2.Rows = Numcamp1 + 1 Form7.Fl2.ColS = 33 '28 Form9.MSFG1.Rows = Numcamp1 + 2 Form9.MSFG1.Row = Numcamp1 + 1 Form9.MSFG1.col = 0 Form9.MSFG1.Text = "mean" For i = 4 To Numelem + 3 BackGrnd.FG1.Row = 0 BackGrnd.FG1.col = i BackGrnd.FG1.Text = Elementi(i - 3) Next i For i = 1 To Numcamp1 Form12.Combo1.AddItem NomeCamp(i) Form12.Combo5.AddItem NomeCamp(i) Form12.Combo7.AddItem NomeCamp(i) Form12.Combo8.AddItem NomeCamp(i) Form8.Combo1.AddItem NomeCamp(i) Form27.Combo1.AddItem NomeCamp(i) Form27.Combo5.AddItem NomeCamp(i) BackGrnd.FG1.Row = i BackGrnd.FG1.col = 0 BackGrnd.FG1.Text = NomeCamp(i) Form7.Fl2.Row = i Form7.Fl2.col = 0 Form7.Fl2.Text = NomeCamp(i) Form9.MSFG1.col = 0 Form9.MSFG1.Row = i Form9.MSFG1.Text = NomeCamp(i) Next i For i = 1 To Numcamp1 For ii = 4 To Numelem + 3 BackGrnd.FG1.Row = i BackGrnd.FG1.col = ii If DatiOrigine(i, ii - 3) = -12345.67 Then BackGrnd.FG1.Text = "-" GoTo et End If BackGrnd.FG1.Text = DatiOrigine(i, ii - 3) et: Next ii Next i BackGrnd.FG1.Row = 0 BackGrnd.FG1.col = 1 BackGrnd.FG1.Text = "Symbol" BackGrnd.FG1.col = 2 BackGrnd.FG1.Text = "Color" BackGrnd.FG1.col = 3 BackGrnd.FG1.Text = "Plot (0-1)" For i = 1 To Numcamp1 BackGrnd.FG1.Row = i BackGrnd.FG1.col = 1 BackGrnd.FG1.Text = KeyVal(i) BackGrnd.FG1.col = 2 BackGrnd.FG1.Text = Color(i) BackGrnd.FG1.col = 3 BackGrnd.FG1.Text = plot1(i) Next i 'converto in ppm gli eventuali ossidi di elementi utili in traccia sw = 0 nw = 0 For i = 1 To Numelem If Elementi(i) = "FeO" Then sw = 1 End If If Elementi(i) = "Fe2O3" Then nw = 1 End If Next i If sw = 1 And nw = 1 Then INP.Feototale End If For i = 1 To Numelem If Elementi(i) = "TiO2" Then INP.ConvertiPPM "Ti", i End If If Elementi(i) = "P2O5" Then INP.ConvertiPPM "P", i End If If Elementi(i) = "Zr2O5" Then INP.ConvertiPPM "Zr", i End If If Elementi(i) = "K2O" Then INP.ConvertiPPM "K", i End If If Elementi(i) = "MnO" Then INP.ConvertiPPM "Mn", i End If If Elementi(i) = "FeOtot" Then INP.ConvertiPPM "Fe", i End If Next i INP.ResettaForm13 INP.InserisciInForm13Start BackGrnd.Show Form12.Hide Form27.Hide Form15.Hide Fileopen = True For i = 1 To Numcamp1 SimbFilter(i) = 1 Next i Exit Sub End If '----------------------- 'caso in cui aggiungo un file If Fileopen = True Then '-------------------------- 'prima salvo il file aperto For i = 1 To Numcamp1 BackGrnd.FG1.col = 1 BackGrnd.FG1.Row = i Symbol(i) = Val(BackGrnd.FG1.Text) BackGrnd.FG1.col = 2 BackGrnd.FG1.Row = i Color(i) = Val(BackGrnd.FG1.Text) Next i On Error GoTo ere2 file$ = App.Path + "\data\backup.peg" On Error GoTo ere1 Open file$ For Output As #1 Write #1, Numelem, Numcamp1, NumL; Write #1, Write #1, "SAMPLE", "SYMBOL", "COLOR"; For i = 1 To Numelem Write #1, Elementi(i); Next i Write #1, For i = 1 To Numcamp1 aa = NomeCamp(i) bb = Symbol(i) cc = Color(i) Write #1, aa, bb, cc; For ii = 1 To Numelem Write #1, DatiOrigine(i, ii); Next ii Write #1, Next i For i = 1 To NumL Write #1, SerieL(i) Next i Close #1 '--------------------------------------------------- 'acquisisco CommonDialog1.DialogTitle = "Open Analysis file(.XLS) ..." CommonDialog1.Filter = "*.XLS" CommonDialog1.FileName = "*.XLS" CommonDialog1.ShowOpen file$ = CommonDialog1.FileName jj = Len(file$) Nomegruppo = left(file$, jj - 4) On Error GoTo ere12 MDIForm1.StatusBar1.Panels(1).Text = "" MDIForm1.StatusBar1.Panels(2).Text = "" MDIForm1.StatusBar1.Panels(3).Text = "" Set MonXL = CreateObject("Excel.Application") MonXL.Workbooks.Open FileName:=file$ '1 '3 MonXL.range("D1").Select MonXL.selection.Copy a(3) = Clipboard.GetText Clipboard.Clear '4 MonXL.range("E1").Select MonXL.selection.Copy a(4) = Clipboard.GetText Clipboard.Clear '5 MonXL.range("F1").Select MonXL.selection.Copy a(5) = Clipboard.GetText Clipboard.Clear '6 MonXL.range("G1").Select MonXL.selection.Copy a(6) = Clipboard.GetText Clipboard.Clear '7 MonXL.range("H1").Select MonXL.selection.Copy a(7) = Clipboard.GetText Clipboard.Clear '8 MonXL.range("I1").Select MonXL.selection.Copy a(8) = Clipboard.GetText Clipboard.Clear '9 MonXL.range("J1").Select MonXL.selection.Copy a(9) = Clipboard.GetText Clipboard.Clear '10 MonXL.range("K1").Select MonXL.selection.Copy a(10) = Clipboard.GetText Clipboard.Clear '11 MonXL.range("L1").Select MonXL.selection.Copy a(11) = Clipboard.GetText Clipboard.Clear '12 MonXL.range("M1").Select MonXL.selection.Copy a(12) = Clipboard.GetText Clipboard.Clear '13 MonXL.range("N1").Select MonXL.selection.Copy a(13) = Clipboard.GetText Clipboard.Clear '14 MonXL.range("O1").Select MonXL.selection.Copy a(14) = Clipboard.GetText Clipboard.Clear '15 MonXL.range("P1").Select MonXL.selection.Copy a(15) = Clipboard.GetText Clipboard.Clear '16 MonXL.range("Q1").Select MonXL.selection.Copy a(16) = Clipboard.GetText Clipboard.Clear '17 MonXL.range("R1").Select MonXL.selection.Copy a(17) = Clipboard.GetText Clipboard.Clear '18 MonXL.range("S1").Select MonXL.selection.Copy a(18) = Clipboard.GetText Clipboard.Clear '19 MonXL.range("T1").Select MonXL.selection.Copy a(19) = Clipboard.GetText Clipboard.Clear '20 MonXL.range("U1").Select MonXL.selection.Copy a(20) = Clipboard.GetText Clipboard.Clear '21 MonXL.range("V1").Select MonXL.selection.Copy a(21) = Clipboard.GetText Clipboard.Clear '22 MonXL.range("W1").Select MonXL.selection.Copy a(22) = Clipboard.GetText Clipboard.Clear '23 MonXL.range("X1").Select MonXL.selection.Copy a(23) = Clipboard.GetText Clipboard.Clear '24 MonXL.range("Y1").Select MonXL.selection.Copy a(24) = Clipboard.GetText Clipboard.Clear '25 MonXL.range("Z1").Select MonXL.selection.Copy a(25) = Clipboard.GetText Clipboard.Clear '26 MonXL.range("AA1").Select MonXL.selection.Copy a(26) = Clipboard.GetText Clipboard.Clear '27 MonXL.range("AB1").Select MonXL.selection.Copy a(27) = Clipboard.GetText Clipboard.Clear '28 MonXL.range("AC1").Select MonXL.selection.Copy a(28) = Clipboard.GetText Clipboard.Clear '29 MonXL.range("AD1").Select MonXL.selection.Copy a(29) = Clipboard.GetText Clipboard.Clear '30 MonXL.range("AE1").Select MonXL.selection.Copy a(30) = Clipboard.GetText Clipboard.Clear '31 MonXL.range("AF1").Select MonXL.selection.Copy a(31) = Clipboard.GetText Clipboard.Clear '32 MonXL.range("AG1").Select MonXL.selection.Copy a(32) = Clipboard.GetText Clipboard.Clear '33 MonXL.range("AH1").Select MonXL.selection.Copy a(33) = Clipboard.GetText Clipboard.Clear '34 MonXL.range("AI1").Select MonXL.selection.Copy a(34) = Clipboard.GetText Clipboard.Clear '35 MonXL.range("AJ1").Select MonXL.selection.Copy a(35) = Clipboard.GetText Clipboard.Clear '36 MonXL.range("AK1").Select MonXL.selection.Copy a(36) = Clipboard.GetText Clipboard.Clear '37 MonXL.range("AL1").Select MonXL.selection.Copy a(37) = Clipboard.GetText Clipboard.Clear '38 MonXL.range("AM1").Select MonXL.selection.Copy a(38) = Clipboard.GetText Clipboard.Clear '39 MonXL.range("AN1").Select MonXL.selection.Copy a(39) = Clipboard.GetText Clipboard.Clear '40 MonXL.range("AO1").Select MonXL.selection.Copy a(40) = Clipboard.GetText Clipboard.Clear '41 MonXL.range("AP1").Select MonXL.selection.Copy a(41) = Clipboard.GetText Clipboard.Clear '42 MonXL.range("AQ1").Select MonXL.selection.Copy a(42) = Clipboard.GetText Clipboard.Clear '43 MonXL.range("AR1").Select MonXL.selection.Copy a(43) = Clipboard.GetText Clipboard.Clear '44 MonXL.range("AS1").Select MonXL.selection.Copy a(44) = Clipboard.GetText Clipboard.Clear '45 MonXL.range("AT1").Select MonXL.selection.Copy a(45) = Clipboard.GetText Clipboard.Clear '46 MonXL.range("AU1").Select MonXL.selection.Copy a(46) = Clipboard.GetText Clipboard.Clear '47 MonXL.range("AV1").Select MonXL.selection.Copy a(47) = Clipboard.GetText Clipboard.Clear '48 MonXL.range("AW1").Select MonXL.selection.Copy a(48) = Clipboard.GetText Clipboard.Clear '49 MonXL.range("AX1").Select MonXL.selection.Copy a(49) = Clipboard.GetText Clipboard.Clear '50 MonXL.range("AY1").Select MonXL.selection.Copy a(50) = Clipboard.GetText Clipboard.Clear '51 MonXL.range("AZ1").Select MonXL.selection.Copy a(51) = Clipboard.GetText Clipboard.Clear '52 MonXL.range("BA1").Select MonXL.selection.Copy a(52) = Clipboard.GetText Clipboard.Clear '53 MonXL.range("BB1").Select MonXL.selection.Copy a(53) = Clipboard.GetText Clipboard.Clear '54 MonXL.range("BC1").Select MonXL.selection.Copy a(54) = Clipboard.GetText Clipboard.Clear '55 MonXL.range("BD1").Select MonXL.selection.Copy a(55) = Clipboard.GetText Clipboard.Clear '56 MonXL.range("BE1").Select MonXL.selection.Copy a(56) = Clipboard.GetText Clipboard.Clear '57 MonXL.range("BF1").Select MonXL.selection.Copy a(57) = Clipboard.GetText Clipboard.Clear '58 MonXL.range("BG1").Select MonXL.selection.Copy a(58) = Clipboard.GetText Clipboard.Clear '59 MonXL.range("BH1").Select MonXL.selection.Copy a(59) = Clipboard.GetText Clipboard.Clear '60 MonXL.range("BI1").Select MonXL.selection.Copy a(60) = Clipboard.GetText Clipboard.Clear '61 MonXL.range("BJ1").Select MonXL.selection.Copy a(61) = Clipboard.GetText Clipboard.Clear '62 MonXL.range("BK1").Select MonXL.selection.Copy a(62) = Clipboard.GetText Clipboard.Clear '63 MonXL.range("BL1").Select MonXL.selection.Copy a(63) = Clipboard.GetText Clipboard.Clear '64 MonXL.range("BM1").Select MonXL.selection.Copy a(64) = Clipboard.GetText Clipboard.Clear '65 MonXL.range("BN1").Select MonXL.selection.Copy a(65) = Clipboard.GetText Clipboard.Clear '66 MonXL.range("BO1").Select MonXL.selection.Copy a(66) = Clipboard.GetText Clipboard.Clear '67 MonXL.range("BP1").Select MonXL.selection.Copy a(67) = Clipboard.GetText Clipboard.Clear '68 MonXL.range("BQ1").Select MonXL.selection.Copy a(68) = Clipboard.GetText Clipboard.Clear '69 MonXL.range("BR1").Select MonXL.selection.Copy a(69) = Clipboard.GetText Clipboard.Clear '70 MonXL.range("BS1").Select MonXL.selection.Copy a(70) = Clipboard.GetText Clipboard.Clear '71 MonXL.range("BT1").Select MonXL.selection.Copy a(71) = Clipboard.GetText Clipboard.Clear '72 MonXL.range("BU1").Select MonXL.selection.Copy a(72) = Clipboard.GetText Clipboard.Clear '73 MonXL.range("BV1").Select MonXL.selection.Copy a(73) = Clipboard.GetText Clipboard.Clear '74 MonXL.range("BW1").Select MonXL.selection.Copy a(74) = Clipboard.GetText Clipboard.Clear '75 MonXL.range("BX1").Select MonXL.selection.Copy a(75) = Clipboard.GetText Clipboard.Clear '76 MonXL.range("BY1").Select MonXL.selection.Copy a(76) = Clipboard.GetText Clipboard.Clear '77 MonXL.range("BZ1").Select MonXL.selection.Copy a(77) = Clipboard.GetText Clipboard.Clear '78 MonXL.range("CA1").Select MonXL.selection.Copy a(78) = Clipboard.GetText Clipboard.Clear '79 MonXL.range("CB1").Select MonXL.selection.Copy a(79) = Clipboard.GetText Clipboard.Clear '80 MonXL.range("CC1").Select MonXL.selection.Copy a(80) = Clipboard.GetText Clipboard.Clear '81 MonXL.range("CD1").Select MonXL.selection.Copy a(81) = Clipboard.GetText Clipboard.Clear '82 MonXL.range("CE1").Select MonXL.selection.Copy a(82) = Clipboard.GetText Clipboard.Clear '83 MonXL.range("CF1").Select MonXL.selection.Copy a(83) = Clipboard.GetText Clipboard.Clear '82 MonXL.range("CG1").Select MonXL.selection.Copy a(84) = Clipboard.GetText Clipboard.Clear '85 MonXL.range("CH1").Select MonXL.selection.Copy a(85) = Clipboard.GetText Clipboard.Clear '86 MonXL.range("CI1").Select MonXL.selection.Copy a(86) = Clipboard.GetText Clipboard.Clear '87 MonXL.range("CJ1").Select MonXL.selection.Copy a(87) = Clipboard.GetText Clipboard.Clear '88 MonXL.range("CK1").Select MonXL.selection.Copy a(88) = Clipboard.GetText Clipboard.Clear '89 MonXL.range("CL1").Select MonXL.selection.Copy a(89) = Clipboard.GetText Clipboard.Clear '90 MonXL.range("CM1").Select MonXL.selection.Copy a(90) = Clipboard.GetText Clipboard.Clear '91 MonXL.range("CN1").Select MonXL.selection.Copy a(91) = Clipboard.GetText Clipboard.Clear '92 MonXL.range("CO1").Select MonXL.selection.Copy a(92) = Clipboard.GetText Clipboard.Clear '93 MonXL.range("CP1").Select MonXL.selection.Copy a(93) = Clipboard.GetText Clipboard.Clear '94 MonXL.range("CQ1").Select MonXL.selection.Copy a(94) = Clipboard.GetText Clipboard.Clear '95 MonXL.range("CR1").Select MonXL.selection.Copy a(95) = Clipboard.GetText Clipboard.Clear '96 MonXL.range("CS1").Select MonXL.selection.Copy a(96) = Clipboard.GetText Clipboard.Clear '97 MonXL.range("CT1").Select MonXL.selection.Copy a(97) = Clipboard.GetText Clipboard.Clear '98 MonXL.range("CU1").Select MonXL.selection.Copy a(98) = Clipboard.GetText Clipboard.Clear '99 MonXL.range("CV1").Select MonXL.selection.Copy a(99) = Clipboard.GetText Clipboard.Clear '100 MonXL.range("CW1").Select MonXL.selection.Copy a(100) = Clipboard.GetText Clipboard.Clear 'Elementi Open App.Path + "\data\Elementi.txt" For Output As #1 '13-05 For i = 3 To 100 Print #1, a(i) Next i Close #1 Open App.Path + "\data\Elementi.txt" For Input As #1 k = 0 Do While Not EOF(1) ' Loop until end of file. Line Input #1, aa k = k + 1 If aa = "" Then k = k - 1 GoTo ww34 End If ElementiAgg(k) = aa ww34: Loop NumelemAgg = k 'Label1.Caption = k Close #1 'CAMPIONI MonXL.range("A2:A5000").Select MonXL.selection.Copy bbb = Clipboard.GetText Open App.Path + "\data\Campioni.txt" For Output As #2 Print #2, bbb Close #2 Open App.Path + "\data\Campioni.txt" For Input As #2 k = 0 Do While Not EOF(2) ' Loop until end of file. Line Input #2, aa k = k + 1 If aa = "" Then k = k - 1 GoTo ww178 End If NomeCamp(k + Numcamp1) = aa 'Combo2.AddItem aa ww178: Loop Close #2 'NumElem0 = Numelem 'NumElem1 = Numelem 'simboli MonXL.range("B2:B5000").Select MonXL.selection.Copy bbb = Clipboard.GetText Open App.Path + "\data\Key.txt" For Output As #2 Print #2, bbb Close #2 Open App.Path + "\data\Key.txt" For Input As #2 k = 0 Do While Not EOF(2) ' Loop until end of file. Line Input #2, aa k = k + 1 If aa = "" Then k = k - 1 GoTo ww459 End If KeyVal(k) = Abs(aa) ww459: Loop Close #2 Numcampagg = k 'colori MonXL.range("C2:C5000").Select MonXL.selection.Copy bbb = Clipboard.GetText Open App.Path + "\data\Color.txt" For Output As #2 Print #2, bbb Close #2 Open App.Path + "\data\Color.txt" For Input As #2 k = 0 Do While Not EOF(2) ' Loop until end of file. Line Input #2, aa k = k + 1 If aa = "" Then k = k - 1 GoTo ww452 End If Color(k) = Abs(aa) ww452: Loop Close #2 'DATI Form15.Show Form15.ProgressBar1.Value = 0 Form15.Label1.Caption = "Importing file .XLS" Form15.ProgressBar1.Max = NumelemAgg + 3 t0 = Timer nsecond = 2 Do While Timer - t0 < nsecond dummy = DoEvents() If Timer < t0 Then t0 = t0 - CLng(24) * CLng(60) * CLng(60) End If Loop 'Converto eventuali imperfezioni nelle notazioni For k = 1 To NumelemAgg If ElementiAgg(k) = "SiO[2]" Then ElementiAgg(k) = "SiO2" GoTo rrt End If If ElementiAgg(k) = "TiO[2]" Then ElementiAgg(k) = "TiO2" GoTo rrt End If If ElementiAgg(k) = "Al[2]O[3]" Then ElementiAgg(k) = "Al2O3" GoTo rrt End If If ElementiAgg(k) = "Fe[2]O[3]" Then ElementiAgg(k) = "Fe2O3" GoTo rrt End If If ElementiAgg(k) = "FeO" Then ElementiAgg(k) = "FeO" GoTo rrt End If If ElementiAgg(k) = "MnO" Then ElementiAgg(k) = "MnO" GoTo rrt End If If ElementiAgg(k) = "MgO" Then ElementiAgg(k) = "MgO" GoTo rrt End If If Elementi(k) = "CaO" Then Elementi(k) = "CaO" GoTo rrt End If If ElementiAgg(k) = "Na[2]O" Then ElementiAgg(k) = "Na2O" GoTo rrt End If If ElementiAgg(k) = "K[2]O" Then ElementiAgg(k) = "K2O" GoTo rrt End If If ElementiAgg(k) = "P[2]O[5]" Then ElementiAgg(k) = "P2O5" GoTo rrt End If If ElementiAgg(k) = "H[2]O+" Then Elementi(k) = "H2O+" GoTo rrt End If If ElementiAgg(k) = "H2[O]-" Then ElementiAgg(k) = "H2O-" k = k + 1 GoTo rrt End If If Elementi(k) = "Cr[2]O[3]" Then Elementi(k) = "Cr2O3" GoTo rrt End If If ElementiAgg(k) = "NiO" Then ElementiAgg(k) = "NiO" GoTo rrt End If rrt: Next k MonXL.range("A2:CZ501").Select Set Intervallo = MonXL.selection.currentregion For i = 4 To NumelemAgg + 3 For ss = 1 To NumElem1 If Elementi(ss) = ElementiAgg(i - 3) Then For ii = Numcamp1 + 1 To Numcampagg + Numcamp1 + 1 DatiOrigine(ii, i - 3) = Val(Intervallo(ii - Numcamp1 + 1, i)) Next End If Next ss Form15.ProgressBar1.Value = i Next Numcamp1 = Numcampagg + Numcamp1 For i = 1 To NumElem1 For ii = 1 To Numcamp1 If DatiOrigineAgg(ii, i) = 0 Then DatiOrigineAgg(ii, i) = -12345.67 End If Next Next On Error GoTo qwer12yu Clipboard.Clear MonXL.activeWorkbook.Close SaveChanges:=False qwer12yu: MonXL.quit Set MonXL = Nothing 'inserisco i dati nella flex grid BackGrnd.FG1.Rows = Numcamp1 + 1 BackGrnd.FG1.ColS = Numelem + 3 Form7.Fl2.Rows = Numcamp1 + 1 Form7.Fl2.ColS = 33 '28ATTENZIONE Form9.MSFG1.Rows = Numcamp1 + 2 Form9.MSFG1.Row = Numcamp1 + 1 Form9.MSFG1.col = 0 Form9.MSFG1.Text = "mean" For i = 3 To Numelem + 2 BackGrnd.FG1.Row = 0 BackGrnd.FG1.col = i BackGrnd.FG1.Text = Elementi(i - 2) Next i For i = 1 To Numcamp1 Form12.Combo1.AddItem NomeCamp(i) Form12.Combo5.AddItem NomeCamp(i) Form12.Combo7.AddItem NomeCamp(i) Form12.Combo8.AddItem NomeCamp(i) Form8.Combo1.AddItem NomeCamp(i) Form27.Combo1.AddItem NomeCamp(i) Form27.Combo5.AddItem NomeCamp(i) BackGrnd.FG1.Row = i BackGrnd.FG1.col = 0 BackGrnd.FG1.Text = NomeCamp(i) Form7.Fl2.Row = i Form7.Fl2.col = 0 Form7.Fl2.Text = NomeCamp(i) Form9.MSFG1.col = 0 Form9.MSFG1.Row = i Form9.MSFG1.Text = NomeCamp(i) Next i For i = 1 To Numcamp1 For ii = 3 To Numelem + 2 BackGrnd.FG1.Row = i BackGrnd.FG1.col = ii If DatiOrigine(i, ii - 2) = -12345.67 Then BackGrnd.FG1.Text = "-" GoTo etuy End If BackGrnd.FG1.Text = DatiOrigine(i, ii - 2) etuy: Next ii Next i BackGrnd.FG1.Row = 0 BackGrnd.FG1.col = 1 BackGrnd.FG1.Text = "Symbol" BackGrnd.FG1.col = 2 BackGrnd.FG1.Text = "Color" For i = 1 To Numcampagg BackGrnd.FG1.Row = i + Numcamp1 - Numcampagg BackGrnd.FG1.col = 1 BackGrnd.FG1.Text = KeyVal(i) BackGrnd.FG1.col = 2 BackGrnd.FG1.Text = Color(i) Next i 'converto in ppm gli eventuali ossidi di elementi utili in traccia sw = 0 nw = 0 For i = 1 To Numelem If Elementi(i) = "FeO" Then sw = 1 End If If Elementi(i) = "Fe2O3" Then nw = 1 End If Next i If sw = 1 And nw = 1 Then INP.Feototale End If For i = 1 To Numelem If Elementi(i) = "TiO2" Then INP.ConvertiPPM "Ti", i End If If Elementi(i) = "P2O5" Then INP.ConvertiPPM "P", i End If If Elementi(i) = "Zr2O5" Then INP.ConvertiPPM "Zr", i End If If Elementi(i) = "K2O" Then INP.ConvertiPPM "K", i End If If Elementi(i) = "MnO" Then INP.ConvertiPPM "Mn", i End If If Elementi(i) = "FeOtot" Then INP.ConvertiPPM "Fe", i End If Next i INP.ResettaForm13 INP.InserisciInForm13Start BackGrnd.Show Form12.Hide Form15.Hide Form27.Hide Fileopen = True For i = 1 To Numcamp1 SimbFilter(i) = 1 Next i Exit Sub End If '------------------------ GoTo ere1 ere12: On Error GoTo ere file$ = App.Path + "\data\backup.peg" Open file$ For Input As #1 Input #1, Numelem, Numcamp1, NumL Input #1, aa, bb, cc, dd For i = 1 To Numelem Input #1, aa Elementi(i) = aa Next i For i = 1 To Numcamp1 Input #1, aaa, aa, bb, cc NomeCamp(i) = aa Symbol(i) = bb Color(i) = cc For ii = 1 To Numelem Input #1, aa DatiOrigine(i, ii) = aa Next ii Next i Input #1, aa For i = 1 To NumL Input #1, aa SerieL(i) = aa Next i Legen = True Close #1 'Converto eventuali imperfezioni nelle notazioni For k = 1 To Numelem If Elementi(k) = "SiO[2]" Then Elementi(k) = "SiO2" GoTo rrb End If If Elementi(k) = "TiO[2]" Then Elementi(k) = "TiO2" GoTo rrb End If If Elementi(k) = "Al[2]O[3]" Then Elementi(k) = "Al2O3" GoTo rrb End If If Elementi(k) = "Fe[2]O[3]" Then Elementi(k) = "Fe2O3" GoTo rrb End If If Elementi(k) = "FeO" Then Elementi(k) = "FeO" GoTo rrb End If If Elementi(k) = "MnO" Then Elementi(k) = "MnO" GoTo rrb End If If Elementi(k) = "MgO" Then Elementi(k) = "MgO" GoTo rrb End If If Elementi(k) = "CaO" Then Elementi(k) = "CaO" GoTo rrb End If If Elementi(k) = "Na[2]O" Then Elementi(k) = "Na2O" GoTo rrb End If If Elementi(k) = "K[2]O" Then Elementi(k) = "K2O" GoTo rrb End If If Elementi(k) = "P[2]O[5]" Then Elementi(k) = "P2O5" GoTo rrb End If If Elementi(k) = "H[2]O+" Then Elementi(k) = "H2O+" GoTo rrb End If If Elementi(k) = "H2[O]-" Then Elementi(k) = "H2O-" k = k + 1 GoTo rrb End If If Elementi(k) = "Cr[2]O[3]" Then Elementi(k) = "Cr2O3" GoTo rrb End If If Elementi(k) = "NiO" Then Elementi(k) = "NiO" GoTo rrb End If rrb: Next k 'inserisco i dati nella tabella NumElem0 = Numelem NumElem1 = Numelem 'inserisco i dati nella flex grid BackGrnd.FG1.Rows = Numcamp1 + 1 BackGrnd.FG1.ColS = Numelem + 3 For i = 1 To Numelem + 2 BackGrnd.FG1.ColWidth(i) = 1500 Next i Form9.MSFG1.Rows = Numcamp1 + 2 Form9.MSFG1.Row = Numcamp1 + 1 Form9.MSFG1.col = 0 Form9.MSFG1.Text = "mean" For i = 3 To Numelem + 2 BackGrnd.FG1.Row = 0 BackGrnd.FG1.col = i BackGrnd.FG1.Text = Elementi(i - 2) Next i Form7.Fl2.Rows = Numcamp1 + 1 Form7.Fl2.ColS = 33 'ATTENZIONE28 For i = 1 To Numcamp1 Form12.Combo1.AddItem NomeCamp(i) Form12.Combo5.AddItem NomeCamp(i) Form12.Combo7.AddItem NomeCamp(i) Form12.Combo8.AddItem NomeCamp(i) Form8.Combo1.AddItem NomeCamp(i) Form27.Combo1.AddItem NomeCamp(i) Form27.Combo5.AddItem NomeCamp(i) BackGrnd.FG1.Row = i BackGrnd.FG1.col = 0 BackGrnd.FG1.Text = NomeCamp(i) Form7.Fl2.Row = i Form7.Fl2.col = 0 Form7.Fl2.Text = NomeCamp(i) Form9.MSFG1.col = 0 Form9.MSFG1.Row = i Form9.MSFG1.Text = NomeCamp(i) Next i For i = 1 To Numcamp1 For ii = 3 To Numelem + 2 BackGrnd.FG1.Row = i BackGrnd.FG1.col = ii If DatiOrigine(i, ii - 2) = -12345.67 Then BackGrnd.FG1.Text = "-" GoTo et54 End If BackGrnd.FG1.Text = DatiOrigine(i, ii - 2) et54: Next ii Next i BackGrnd.FG1.Row = 0 BackGrnd.FG1.col = 1 BackGrnd.FG1.Text = "Symbol" BackGrnd.FG1.col = 2 BackGrnd.FG1.Text = "Color" For i = 1 To Numcamp1 BackGrnd.FG1.Row = i BackGrnd.FG1.col = 1 BackGrnd.FG1.Text = Symbol(i) BackGrnd.FG1.col = 2 BackGrnd.FG1.Text = Color(i) Next i INP.ResettaForm13 INP.InserisciInForm13Start BackGrnd.Show Form12.Hide Form27.Hide Fileopen = True For i = 1 To Numcamp1 SimbFilter(i) = 1 Next i Exit Sub '------------------------------------ GoTo ere1 ere2: MsgBox "An Error Occurred: I'm not able to open this file", , "Error" ere: Fileopen = False BackGrnd.Hide Form12.Hide Form27.Hide Close #1 Close #2 Close #3 Clipboard.Clear ere1: Form15.Hide Form7.Hide Clipboard.Clear 'MonXL.activeWorkbook.Close SaveChanges:=False 'MonXL.quit Set MonXL = Nothing End Sub Private Sub opzLeg_Click() On Error GoTo sere If Fileopen = False Then GoTo sere1 End If Form20.Text1.Visible = False For i = 1 To Numcamp1 BackGrnd.FG1.Row = i BackGrnd.FG1.col = 1 aa = Val(BackGrnd.FG1.Text) If aa <> 0 Then indL = i GoTo vai End If Next i vai: TipoL(1) = aa BackGrnd.FG1.col = 2 BackGrnd.FG1.Row = indL ColL(1) = Val(BackGrnd.FG1.Text) If Legen = False Then 'SerieL(1) = NomeCamp(indL) End If numseries = 1 For i = 1 To Numcamp1 If numseries > 29 Then GoTo dopo End If If numseries > 29 Then GoTo dopo End If For ii = 1 To numseries BackGrnd.FG1.Row = i BackGrnd.FG1.col = 1 aa = Val(BackGrnd.FG1.Text) If aa <= 0 Then GoTo dopo End If cc = Val(BackGrnd.FG1.Text) If TipoL(ii) = cc Then BackGrnd.FG1.col = 2 cc = Val(BackGrnd.FG1.Text) If ColL(ii) = cc Then GoTo dopo End If End If Next ii numseries = numseries + 1 BackGrnd.FG1.col = 1 aa = BackGrnd.FG1.Text TipoL(numseries) = Val(aa) BackGrnd.FG1.col = 2 bb = BackGrnd.FG1.Text ColL(numseries) = Val(bb) If Legen = False Then 'SerieL(numseries) = NomeCamp(i) End If dopo: Next i Open App.Path + "\legend.txt" For Output As #1 For i = 1 To numseries Write #1, TipoL(i), ColL(i), SerieL(i) Next i Close #1 Legen = True For i = 1 To 30 Form20.Label1(i - 1).Visible = False Form20.Label1(i - 1).Caption = "" Form20.Picture1(i - 1).Visible = False Form20.Label1(60 - i).Visible = False Form20.Picture1(i - 1).Cls Next i If numseries < 11 Then Form20.Width = 1890 End If If numseries > 10 And numseries < 21 Then Form20.Width = 3700 End If If numseries > 20 And numseries < 31 Then Form20.Width = 5590 End If NumL = numseries For i = 1 To numseries '----------------------- colorl = BackGrnd.Picture1(ColL(i) + 8).BackColor 'Form20.Label1(i - 1).Caption = SerieL(i) If TipoL(i) = 1 Then Form20.Label1(i - 1).Visible = True Form20.Picture1(i - 1).Visible = True Form20.Picture1(i - 1).FillColor = colorl Form20.Picture1(i - 1).FillStyle = 0 Form20.Picture1(i - 1).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), colorl, B Form20.Label1(60 - i).Caption = Str(TipoL(i)) + "-" + Trim(Str(ColL(i))) Form20.Label1(60 - i).Visible = True End If If TipoL(i) = 2 Then Form20.Label1(i - 1).Visible = True Form20.Picture1(i - 1).Visible = True Form20.Picture1(i - 1).FillColor = colorl Form20.Picture1(i - 1).FillStyle = 1 Form20.Picture1(i - 1).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), colorl, B Form20.Label1(60 - i).Caption = Str(TipoL(i)) + "-" + Trim(Str(ColL(i))) Form20.Label1(60 - i).Visible = True End If If TipoL(i) = 3 Then Form20.Label1(i - 1).Visible = True Form20.Picture1(i - 1).Visible = True Form20.Picture1(i - 1).FillColor = colorl Form20.Picture1(i - 1).FillStyle = 0 Form20.Picture1(i - 1).Circle (5, 5), 2, colorl Form20.Label1(60 - i).Caption = Str(TipoL(i)) + "-" + Trim(Str(ColL(i))) Form20.Label1(60 - i).Visible = True End If If TipoL(i) = 4 Then Form20.Label1(i - 1).Visible = True Form20.Picture1(i - 1).Visible = True Form20.Picture1(i - 1).FillColor = colorl Form20.Picture1(i - 1).FillStyle = 1 Form20.Picture1(i - 1).Circle (5, 5), 2, colorl Form20.Label1(60 - i).Caption = Str(TipoL(i)) + "-" + Trim(Str(ColL(i))) Form20.Label1(60 - i).Visible = True End If If TipoL(i) = 5 Then Form20.Label1(i - 1).Visible = True Form20.Picture1(i - 1).Visible = True Form20.Picture1(i - 1).FillStyle = 1 Form20.Picture1(i - 1).Line (5 - 2, 5 - 2)-(5, 5 + 2), colorl Form20.Picture1(i - 1).Line (5 - 2, 5 - 2)-(5 + 2, 5 - 2), colorl Form20.Picture1(i - 1).Line (5 + 2, 5 - 2)-(5, 5 + 2), colorl Form20.Label1(60 - i).Caption = Str(TipoL(i)) + "-" + Trim(Str(ColL(i))) Form20.Label1(60 - i).Visible = True End If If TipoL(i) = 6 Then Form20.Label1(i - 1).Visible = True Form20.Picture1(i - 1).Visible = True Form20.Picture1(i - 1).FillStyle = 1 Form20.Picture1(i - 1).Line (5 - 2, 5 + 2)-(5, 5 - 2), colorl Form20.Picture1(i - 1).Line (5 - 2, 5 + 2)-(5 + 2, 5 + 2), colorl Form20.Picture1(i - 1).Line (5 + 2, 5 + 2)-(5, 5 - 2), colorl Form20.Label1(60 - i).Caption = Str(TipoL(i)) + "-" + Trim(Str(ColL(i))) Form20.Label1(60 - i).Visible = True End If If TipoL(i) = 7 Then Form20.Label1(i - 1).Visible = True Form20.Picture1(i - 1).Visible = True Form20.Picture1(i - 1).FillStyle = 1 Form20.Picture1(i - 1).Line (5 - 2, 5)-(5 + 2, 5), colorl Form20.Picture1(i - 1).Line (5, 5 - 2)-(5, 5 + 2), colorl Form20.Picture1(i - 1).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), colorl Form20.Picture1(i - 1).Line (5 + 2, 5 - 2)-(5 - 2, 5 + 2), colorl Form20.Label1(60 - i).Caption = Str(TipoL(i)) + "-" + Trim(Str(ColL(i))) Form20.Label1(60 - i).Visible = True End If If TipoL(i) = 8 Then Form20.Label1(i - 1).Visible = True Form20.Picture1(i - 1).Visible = True Form20.Picture1(i - 1).FillStyle = 1 Form20.Picture1(i - 1).Line (5 - 2, 5)-(5 + 2, 5), colorl Form20.Picture1(i - 1).Line (5, 5 - 2)-(5, 5 + 2), colorl Form20.Label1(60 - i).Caption = Str(TipoL(i)) + "-" + Trim(Str(ColL(i))) Form20.Label1(60 - i).Visible = True End If If TipoL(i) = 9 Then Form20.Label1(i - 1).Visible = True Form20.Picture1(i - 1).Visible = True Form20.Picture1(i - 1).FillStyle = 1 Form20.Picture1(i - 1).Line (5 - 2, 5)-(5, 5 + 4), colorl Form20.Picture1(i - 1).Line (5, 5 + 4)-(5 + 2, 5), colorl Form20.Picture1(i - 1).Line (5 + 2, 5)-(5, 5 - 4), colorl Form20.Picture1(i - 1).Line (5, 5 - 4)-(5 - 2, 5), colorl Form20.Label1(60 - i).Caption = Str(TipoL(i)) + "-" + Trim(Str(ColL(i))) Form20.Label1(60 - i).Visible = True End If If TipoL(i) = 10 Then Form20.Label1(i - 1).Visible = True Form20.Picture1(i - 1).Visible = True Form20.Picture1(i - 1).FillStyle = 1 Form20.Picture1(i - 1).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), colorl Form20.Picture1(i - 1).Line (5 + 2, 5 - 2)-(5 - 2, 5 + 2), colorl Form20.Label1(60 - i).Caption = Str(TipoL(i)) + "-" + Trim(Str(ColL(i))) Form20.Label1(60 - i).Visible = True End If If TipoL(i) = 11 Then Form20.Label1(i - 1).Visible = True Form20.Picture1(i - 1).Visible = True Form20.Picture1(i - 1).FillStyle = 1 Form20.Picture1(i - 1).Line (5 - 2, 5)-(5 + 2, 5), colorl Form20.Label1(60 - i).Caption = Str(TipoL(i)) + "-" + Trim(Str(ColL(i))) Form20.Label1(60 - i).Visible = True End If If TipoL(i) = 12 Then Form20.Label1(i - 1).Visible = True Form20.Picture1(i - 1).Visible = True Form20.Picture1(i - 1).FillStyle = 1 Form20.Picture1(i - 1).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), colorl Form20.Picture1(i - 1).Line (5 + 2, 5 - 2)-(5 - 2, 5 + 2), colorl Form20.Picture1(i - 1).FillColor = colorl Form20.Picture1(i - 1).FillStyle = 1 Form20.Picture1(i - 1).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), colorl, B Form20.Label1(60 - i).Caption = Str(TipoL(i)) + "-" + Trim(Str(ColL(i))) Form20.Label1(60 - i).Visible = True End If Next i For i = 1 To 30 For ii = 1 To 30 If ColS(ii) = ColL(i) And TipoS(ii) = TipoL(i) Then Form20.Label1(i - 1).Caption = SerieL(ii) GoTo poi1 End If Next ii poi1: Next i '--------------------------- If numseries > 29 Then MsgBox "Attention. More then 30 symbol are present.", , "Attention" End If Form20.Show Form20.SetFocus GoTo sere1 sere: MsgBox "An Error Occurred", , "Error" sere1: End Sub Private Sub opzleg1_Click() opzLeg_Click End Sub Private Sub opzMassBalance_Click() StroMagma = False For ia = 1 To 11 Form30.Label1(ia).Visible = False Next ia For ia = 1 To 11 Form30.Text1(ia).Visible = False Form30.Text2(ia).Visible = False Form30.Text3(ia).Visible = False Form30.Text4(ia).Visible = False Form30.Text5(ia).Visible = False Form30.Text6(ia).Visible = False Form30.Text7(ia).Visible = False Form30.Text8(ia).Visible = False Form30.Text9(ia).Visible = False Form30.Text10(ia).Visible = False Next ia Form30.Label2.Visible = False Form30.Label3(0).Visible = False For ia = 1 To 8 Form30.Label4(ia).Visible = False Form30.Label4(ia).Caption = "" Next ia Form30.Width = 9075 Form30.Height = 8940 Form30.Show Form30.SetFocus End Sub Private Sub opzMiddle_Click() DiagramType1 = "Middle" Form14.Text1.Text = 500 Form14.Text2.Text = 350 Form14.Show Form14.SetFocus End Sub Private Sub opzModelEvsE_Click() CambiaMod = False Form12.Option1.Visible = False Form12.Option2.Visible = False If NumModelli(Indeks) > 25 Then MsgBox "more than 25 models are not allowed" Exit Sub End If Colmodel = NumModelli(Indeks) + 1 If Colmodel > 14 Then Colmodel = Colmodel - 13 End If Form12.Picture1(21).BackColor = QBColor(Colmodel) Form12.Picture1(39).BackColor = QBColor(Colmodel) ModelSymbCol = QBColor(Colmodel) ModelLineCol = QBColor(Colmodel) Form12.Option2.Value = True Form12.Combo6.Text = "Select" Form12.Frame1.Visible = False Form12.Frame8.Visible = False Form12.Frame10.Visible = False Form12.Frame2.Visible = False Form12.Frame6.Visible = False Form12.Frame11.Visible = False Form12.Frame9.Visible = False Form12.frame7.Visible = False Form12.Frame12.Visible = False Form12.Frame13.Visible = False Form12.Frame14.Visible = False Form12.Frame15.Visible = False Form12.Frame16.Visible = False Form12.Frame17.Visible = False Form12.Frame18.Visible = False Form12.Frame19.Visible = False Form12.Frame20.Visible = False Form12.Frame21.Visible = False Form12.Frame23.Visible = False Form12.Frame22.Visible = False Form12.Frame19.Visible = False Form12.Frame24.Visible = False Form12.Frame25.Visible = False Form12.Frame26.Visible = False Form12.Frame27.Visible = False Form12.Frame28.Visible = False Form12.Frame29.Visible = False Form12.Frame20.Visible = False NumModelElem = 0 INP.RecuperoXY AXX(GraphSelect), AXY(GraphSelect) NumModelElem2(Indeks) = NumModelElem For i = 0 To 9 Form12.Text1(i).Visible = False Form12.Text1(i).Text = "0.00" Form12.Label1(i).Visible = False Next i For i = 0 To 8 Form12.Picture1(i).Scale (1, 9)-(9, 1) Next i Form12.Picture1(41).Scale (1, 9)-(9, 1) Form12.Picture1(41).FillColor = QBColor(0) Form12.Picture1(41).FillStyle = 0 Form12.Picture1(41).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B ModelSymb = 1 'picture(0) Form12.Picture1(0).FillColor = QBColor(0) Form12.Picture1(0).FillStyle = 0 Form12.Picture1(0).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B 'picture(1) Form12.Picture1(1).FillColor = QBColor(0) Form12.Picture1(1).FillStyle = 1 Form12.Picture1(1).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B 'picture(2) Form12.Picture1(2).FillColor = QBColor(0) Form12.Picture1(2).FillStyle = 0 Form12.Picture1(2).Circle (5, 5), 2, QBColor(0) 'picture(3) Form12.Picture1(3).FillColor = QBColor(0) Form12.Picture1(3).FillStyle = 1 Form12.Picture1(3).Circle (5, 5), 2, QBColor(0) 'picture(4) Form12.Picture1(4).FillStyle = 1 Form12.Picture1(4).Line (5 - 2, 5 - 2)-(5, 5 + 2), QBColor(0) Form12.Picture1(4).Line (5 - 2, 5 - 2)-(5 + 2, 5 - 2), QBColor(0) Form12.Picture1(4).Line (5 + 2, 5 - 2)-(5, 5 + 2), QBColor(0) 'picture(5) Form12.Picture1(5).FillStyle = 1 Form12.Picture1(5).Line (5 - 2, 5 + 2)-(5, 5 - 2), QBColor(0) Form12.Picture1(5).Line (5 - 2, 5 + 2)-(5 + 2, 5 + 2), QBColor(0) Form12.Picture1(5).Line (5 + 2, 5 + 2)-(5, 5 - 2), QBColor(0) 'picture(6) Form12.Picture1(6).FillStyle = 1 Form12.Picture1(6).Line (5 - 2, 5)-(5 + 2, 5), QBColor(0) Form12.Picture1(6).Line (5, 5 - 2)-(5, 5 + 2), QBColor(0) Form12.Picture1(6).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0) Form12.Picture1(6).Line (5 + 2, 5 - 2)-(5 - 2, 5 + 2), QBColor(0) 'picture(7) Form12.Picture1(7).FillStyle = 1 Form12.Picture1(7).Line (5 - 2, 5)-(5 + 2, 5), QBColor(0) Form12.Picture1(7).Line (5, 5 - 2)-(5, 5 + 2), QBColor(0) 'picture(8) Form12.Picture1(8).FillStyle = 1 Form12.Picture1(8).Line (5 - 2, 5)-(5, 5 + 4), QBColor(0) Form12.Picture1(8).Line (5, 5 + 4)-(5 + 2, 5), QBColor(0) Form12.Picture1(8).Line (5 + 2, 5)-(5, 5 - 4), QBColor(0) Form12.Picture1(8).Line (5, 5 - 4)-(5 - 2, 5), QBColor(0) Indeks = GraphSelect Form12.Show Form12.SetFocus End Sub Private Sub opzModIso_Click() 'Form26.Option1.Value = True Form26.Text1.Text = "nd" 'Form26.Text2.Text = "nd" Form26.Text3.Text = "nd" 'Form26.Text4.Text = "nd" 'Form26.Text5.Text = "nd" Form26.Text6.Text = "nd" 'Form26.Text7.Text = "nd" Form26.Text8.Text = "nd" Form26.Label27.Visible = True Form26.Label25.Visible = True Form26.Label24.Visible = True Form26.Label3.Visible = True Form26.Label4.Visible = True Form26.Label12.Visible = True 'Form26.Label13.Visible = True 'Form26.Label23.Visible = True Form26.Line8.Visible = True Form26.Line5.Visible = True 'Form26.Text2.Visible = True 'form26.Text7.Visible = True 'Form26.Command7.Visible = True 'Form26.Command8.Visible = True CambiaMod = False If NumModelli(Indeks) > 25 Then MsgBox "more than 25 models are not allowed" Exit Sub End If Colmodel = NumModelli(Indeks) + 1 If Colmodel > 14 Then Colmodel = Colmodel - 13 End If Form26.Picture1(21).BackColor = QBColor(Colmodel) Form26.Picture1(39).BackColor = QBColor(Colmodel) ModelSymbCol = QBColor(Colmodel) ModelLineCol = QBColor(Colmodel) NumModelElem = 0 INP.RecuperoXY AXX(GraphSelect), AXY(GraphSelect) NumModelElem2(Indeks) = NumModelElem 'For i = 0 To 9 'Form26.Text1(i).Visible = False 'Form26.Text1(i).Text = "0.00" 'Form26.Label1(i).Visible = False 'Next i For i = 0 To 8 Form26.Picture1(i).Scale (1, 9)-(9, 1) Next i Form26.Picture1(41).Scale (1, 9)-(9, 1) Form26.Picture1(41).FillColor = QBColor(0) Form26.Picture1(41).FillStyle = 0 Form26.Picture1(41).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B ModelSymb = 1 'picture(0) Form26.Picture1(0).FillColor = QBColor(0) Form26.Picture1(0).FillStyle = 0 Form26.Picture1(0).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B 'picture(1) Form26.Picture1(1).FillColor = QBColor(0) Form26.Picture1(1).FillStyle = 1 Form26.Picture1(1).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B 'picture(2) Form26.Picture1(2).FillColor = QBColor(0) Form26.Picture1(2).FillStyle = 0 Form26.Picture1(2).Circle (5, 5), 2, QBColor(0) 'picture(3) Form26.Picture1(3).FillColor = QBColor(0) Form26.Picture1(3).FillStyle = 1 Form26.Picture1(3).Circle (5, 5), 2, QBColor(0) 'picture(4) Form26.Picture1(4).FillStyle = 1 Form26.Picture1(4).Line (5 - 2, 5 - 2)-(5, 5 + 2), QBColor(0) Form26.Picture1(4).Line (5 - 2, 5 - 2)-(5 + 2, 5 - 2), QBColor(0) Form26.Picture1(4).Line (5 + 2, 5 - 2)-(5, 5 + 2), QBColor(0) 'picture(5) Form26.Picture1(5).FillStyle = 1 Form26.Picture1(5).Line (5 - 2, 5 + 2)-(5, 5 - 2), QBColor(0) Form26.Picture1(5).Line (5 - 2, 5 + 2)-(5 + 2, 5 + 2), QBColor(0) Form26.Picture1(5).Line (5 + 2, 5 + 2)-(5, 5 - 2), QBColor(0) 'picture(6) Form26.Picture1(6).FillStyle = 1 Form26.Picture1(6).Line (5 - 2, 5)-(5 + 2, 5), QBColor(0) Form26.Picture1(6).Line (5, 5 - 2)-(5, 5 + 2), QBColor(0) Form26.Picture1(6).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0) Form26.Picture1(6).Line (5 + 2, 5 - 2)-(5 - 2, 5 + 2), QBColor(0) 'picture(7) Form26.Picture1(7).FillStyle = 1 Form26.Picture1(7).Line (5 - 2, 5)-(5 + 2, 5), QBColor(0) Form26.Picture1(7).Line (5, 5 - 2)-(5, 5 + 2), QBColor(0) 'picture(8) Form26.Picture1(8).FillStyle = 1 Form26.Picture1(8).Line (5 - 2, 5)-(5, 5 + 4), QBColor(0) Form26.Picture1(8).Line (5, 5 + 4)-(5 + 2, 5), QBColor(0) Form26.Picture1(8).Line (5 + 2, 5)-(5, 5 - 4), QBColor(0) Form26.Picture1(8).Line (5, 5 - 4)-(5 - 2, 5), QBColor(0) Indeks = GraphSelect Form26.Show Form26.SetFocus End Sub Private Sub opzModIsoAFC_Click() Indeks = GraphSelect CambiaMod = False If NumModelli(Indeks) > 25 Then MsgBox "more than 25 models are not allowed" Exit Sub End If Colmodel = NumModelli(Indeks) + 1 If Colmodel > 14 Then Colmodel = Colmodel - 13 End If Form27.Picture1(21).BackColor = QBColor(Colmodel) Form27.Picture1(39).BackColor = QBColor(Colmodel) ModelSymbCol = QBColor(Colmodel) ModelLineCol = QBColor(Colmodel) NumModelElem = 0 Form27.Label1(0).Caption = "D for " + Elementi(AXX(Indeks)) Form27.Text1(0).Visible = True Form27.Text1(0).Text = "nd" Form27.Label1(0).Visible = True For i = 0 To 8 Form27.Picture1(i).Scale (1, 9)-(9, 1) Next i Form27.Picture1(41).Scale (1, 9)-(9, 1) Form27.Picture1(41).FillColor = QBColor(0) Form27.Picture1(41).FillStyle = 0 Form27.Picture1(41).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B ModelSymb = 1 'picture(0) Form27.Picture1(0).FillColor = QBColor(0) Form27.Picture1(0).FillStyle = 0 Form27.Picture1(0).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B 'picture(1) Form27.Picture1(1).FillColor = QBColor(0) Form27.Picture1(1).FillStyle = 1 Form27.Picture1(1).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B 'picture(2) Form27.Picture1(2).FillColor = QBColor(0) Form27.Picture1(2).FillStyle = 0 Form27.Picture1(2).Circle (5, 5), 2, QBColor(0) 'picture(3) Form27.Picture1(3).FillColor = QBColor(0) Form27.Picture1(3).FillStyle = 1 Form27.Picture1(3).Circle (5, 5), 2, QBColor(0) 'picture(4) Form27.Picture1(4).FillStyle = 1 Form27.Picture1(4).Line (5 - 2, 5 - 2)-(5, 5 + 2), QBColor(0) Form27.Picture1(4).Line (5 - 2, 5 - 2)-(5 + 2, 5 - 2), QBColor(0) Form27.Picture1(4).Line (5 + 2, 5 - 2)-(5, 5 + 2), QBColor(0) 'picture(5) Form27.Picture1(5).FillStyle = 1 Form27.Picture1(5).Line (5 - 2, 5 + 2)-(5, 5 - 2), QBColor(0) Form27.Picture1(5).Line (5 - 2, 5 + 2)-(5 + 2, 5 + 2), QBColor(0) Form27.Picture1(5).Line (5 + 2, 5 + 2)-(5, 5 - 2), QBColor(0) 'picture(6) Form27.Picture1(6).FillStyle = 1 Form27.Picture1(6).Line (5 - 2, 5)-(5 + 2, 5), QBColor(0) Form27.Picture1(6).Line (5, 5 - 2)-(5, 5 + 2), QBColor(0) Form27.Picture1(6).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0) Form27.Picture1(6).Line (5 + 2, 5 - 2)-(5 - 2, 5 + 2), QBColor(0) 'picture(7) Form27.Picture1(7).FillStyle = 1 Form27.Picture1(7).Line (5 - 2, 5)-(5 + 2, 5), QBColor(0) Form27.Picture1(7).Line (5, 5 - 2)-(5, 5 + 2), QBColor(0) 'picture(8) Form27.Picture1(8).FillStyle = 1 Form27.Picture1(8).Line (5 - 2, 5)-(5, 5 + 4), QBColor(0) Form27.Picture1(8).Line (5, 5 + 4)-(5 + 2, 5), QBColor(0) Form27.Picture1(8).Line (5 + 2, 5)-(5, 5 - 4), QBColor(0) Form27.Picture1(8).Line (5, 5 - 4)-(5 - 2, 5), QBColor(0) Form27.Show Form27.SetFocus End Sub Public Sub opzModSpi_Click() 'REE '------------------------------------------------------------ If SPIDERREE(Indeks) = True Then sssss1 = NumCampSpi(Indeks) Form8.Label36.Caption = sssss1 file$ = NormSP(Indeks) If file$ = "\data\normREE-IDMS-Masuda1973.txt" Then Form8.Combo2.Text = "COND-Masuda et al.(1973)" End If If file$ = "\data\normREE-Nakamura1974.txt" Then Form8.Combo2.Text = "COND-Nakamura (1974)" End If If file$ = "\data\normREE-NAA-Haskin1968.txt" Then Form8.Combo2.Text = "COND-Haskin et al.(1968)" End If If file$ = "\data\normREE-IDMS-Boynton1984.txt" Then Form8.Combo2.Text = "COND-Boynton (1984)" End If If file$ = "\data\normREE-SunandMcD1989.txt" Then Form8.Combo2.Text = "COND-Sun & McDonald (1989)" End If If file$ = "\data\normREE-NASC-Haskin&Frey1966.txt" Then Form8.Combo2.Text = "NASC-Haskin & Frey(1966)" End If If file$ = "\data\normREE-NASC-Haskin&Haskin1966.txt" Then Form8.Combo2.Text = "NASC-Haskin & Haskin(1966)" End If tt = 2 For i = 1 To NumCampSpi(Indeks) For ii = tt To tt + 100 aa = Mid(SpiPlotted(Indeks), ii, 1) If aa = Chr$(124) Or aa = "" Then REEcamp1(i) = Mid(SpiPlotted(Indeks), tt, ii - tt) tt = ii + 1 GoTo rr34 End If Next ii rr34: Next i Form8.List1.Clear For i = 1 To NumCampSpi(Indeks) Form8.List1.AddItem REEcamp1(i) Next i SpiNew = True Form8.Show Form8.SetFocus End If 'OTHER SPIDER '------------------------------------------------------------ If SPIDEROTHER(Indeks) = True Then 'sssss1 = SpiPlotted(Index) 'Form8.Label36.Caption = sssss1 file$ = NormSP(Indeks) If file$ = "\data\SPIDER-PrimordialMantle-Wood&al1979a.txt" Then Form16.Combo1.Text = "Primordial mantle-Wood et al. (1979a)" End If If file$ = "\data\SPIDER-PrimordialMantle-McDonough&al1992.txt" Then Form16.Combo1.Text = "Primordial mantle-McDonough et al. (1992)" End If If file$ = "\data\SPIDER-PrimordialMantle-Taylor&McLennan1985.txt" Then Form16.Combo1.Text = "Primordial mantle-Taylor & McLennan (1985)" End If If file$ = "\data\SPIDER-Condrite-Wood&al1979b.txt" Then Form16.Combo1.Text = "Condrite-Wood et al. (1979b)" End If If file$ = "\data\SPIDER-MORB-Bevins&al1984.txt" Then Form16.Combo1.Text = "MORB-Bevins et al. (1984)" End If If file$ = "\data\SPIDER-UpperContCrust-Taylor&McLennan1981.txt" Then Form16.Combo1.Text = "Upper cont. crust-Taylor & McLennan (1981)" End If If file$ = "\data\SPIDER-LowerContCrust-Weaver&Tarney1984.txt" Then Form16.Combo1.Text = "Lower cont.crust-Weaver & Tarney (1984)" End If If file$ = "\data\SPIDER-AverageContCrust-Weaver&Tarney1984.txt" Then Form16.Combo1.Text = "Average cont crust-Weaver & Tarney (1984)" End If If file$ = "\data\SPIDER-AverageNtMORB-Saunders&Tarney1984.txt" Then Form16.Combo1.Text = "Average N-type MORB-Saunders & Tarney (1984);Sun (1980)" End If If file$ = "\data\SPIDER-AverageOIB-Sun1980.txt" Then Form16.Combo1.Text = "Average OIB-Sun (1980)" End If tt = 2 For i = 1 To NumCampSpi(Indeks) For ii = tt To tt + 100 aa = Mid(SpiPlotted(Indeks), ii, 1) If aa = Chr$(124) Or aa = "" Then REEcamp1(i) = Mid(SpiPlotted(Indeks), tt, ii - tt) tt = ii + 1 GoTo rr341 End If Next ii rr341: Next i Form16.List1.Clear For i = 1 To NumCampSpi(Indeks) Form16.List1.AddItem REEcamp1(i) Next i sssss1 = NumCampSpi(Indeks) Form16.Label3.Caption = sssss1 SpiNew = True Form16.Show Form16.SetFocus End If End Sub Private Sub opzNbY_Click() DiagramType1 = "NbY" Form1.Show Form1.SetFocus End Sub Private Sub opzNbZrY_Click() DiagramType1 = "NbZrY" Form1.Show Form1.SetFocus End Sub Private Sub opzopenxls_Click() On Error GoTo ere1 CommonDialog1.DialogTitle = "Open Analysis file(.XLS) ..." CommonDialog1.Filter = "*.XLS" CommonDialog1.FileName = "*.XLS" CommonDialog1.ShowOpen file$ = CommonDialog1.FileName jj = Len(file$) Nomegruppo = left(file$, jj - 4) On Error GoTo ere2 'resetto le variabili Erase DatiOrigine Erase Elementi Erase NomeCamp CIPWyn = False REEOperation = False Numelem = 0 Numcamp1 = 0 NumElem0 = 0 MDIForm1.StatusBar1.Panels(1).Text = "" MDIForm1.StatusBar1.Panels(2).Text = "" MDIForm1.StatusBar1.Panels(3).Text = "" BackGrnd.FG1.Clear BackGrnd.Hide Legen = False 'form2 Form2.Combo1.Clear Form2.Combo2.Clear 'form3 Form3.Combo1.Clear Form3.Combo2.Clear Form3.Combo3.Clear 'form6 Form6.Combo1.Clear Form6.Combo2.Clear Dim a(100) Set MonXL = CreateObject("Excel.Application") MonXL.Workbooks.Open FileName:=file$ '1 MonXL.range("B1").Select MonXL.selection.Copy a(1) = Clipboard.GetText Clipboard.Clear '2 MonXL.range("C1").Select MonXL.selection.Copy a(2) = Clipboard.GetText Clipboard.Clear '3 MonXL.range("D1").Select MonXL.selection.Copy a(3) = Clipboard.GetText Clipboard.Clear '4 MonXL.range("E1").Select MonXL.selection.Copy a(4) = Clipboard.GetText Clipboard.Clear '5 MonXL.range("F1").Select MonXL.selection.Copy a(5) = Clipboard.GetText Clipboard.Clear '6 MonXL.range("G1").Select MonXL.selection.Copy a(6) = Clipboard.GetText Clipboard.Clear '7 MonXL.range("H1").Select MonXL.selection.Copy a(7) = Clipboard.GetText Clipboard.Clear '8 MonXL.range("I1").Select MonXL.selection.Copy a(8) = Clipboard.GetText Clipboard.Clear '9 MonXL.range("J1").Select MonXL.selection.Copy a(9) = Clipboard.GetText Clipboard.Clear '10 MonXL.range("K1").Select MonXL.selection.Copy a(10) = Clipboard.GetText Clipboard.Clear '11 MonXL.range("L1").Select MonXL.selection.Copy a(11) = Clipboard.GetText Clipboard.Clear '12 MonXL.range("M1").Select MonXL.selection.Copy a(12) = Clipboard.GetText Clipboard.Clear '13 MonXL.range("N1").Select MonXL.selection.Copy a(13) = Clipboard.GetText Clipboard.Clear '14 MonXL.range("O1").Select MonXL.selection.Copy a(14) = Clipboard.GetText Clipboard.Clear '15 MonXL.range("P1").Select MonXL.selection.Copy a(15) = Clipboard.GetText Clipboard.Clear '16 MonXL.range("Q1").Select MonXL.selection.Copy a(16) = Clipboard.GetText Clipboard.Clear '17 MonXL.range("R1").Select MonXL.selection.Copy a(17) = Clipboard.GetText Clipboard.Clear '18 MonXL.range("S1").Select MonXL.selection.Copy a(18) = Clipboard.GetText Clipboard.Clear '19 MonXL.range("T1").Select MonXL.selection.Copy a(19) = Clipboard.GetText Clipboard.Clear '20 MonXL.range("U1").Select MonXL.selection.Copy a(20) = Clipboard.GetText Clipboard.Clear '21 MonXL.range("V1").Select MonXL.selection.Copy a(21) = Clipboard.GetText Clipboard.Clear '22 MonXL.range("W1").Select MonXL.selection.Copy a(22) = Clipboard.GetText Clipboard.Clear '23 MonXL.range("X1").Select MonXL.selection.Copy a(23) = Clipboard.GetText Clipboard.Clear '24 MonXL.range("Y1").Select MonXL.selection.Copy a(24) = Clipboard.GetText Clipboard.Clear '25 MonXL.range("Z1").Select MonXL.selection.Copy a(25) = Clipboard.GetText Clipboard.Clear '26 MonXL.range("AA1").Select MonXL.selection.Copy a(26) = Clipboard.GetText Clipboard.Clear '27 MonXL.range("AB1").Select MonXL.selection.Copy a(27) = Clipboard.GetText Clipboard.Clear '28 MonXL.range("AC1").Select MonXL.selection.Copy a(28) = Clipboard.GetText Clipboard.Clear '29 MonXL.range("AD1").Select MonXL.selection.Copy a(29) = Clipboard.GetText Clipboard.Clear '30 MonXL.range("AE1").Select MonXL.selection.Copy a(30) = Clipboard.GetText Clipboard.Clear '31 MonXL.range("AF1").Select MonXL.selection.Copy a(31) = Clipboard.GetText Clipboard.Clear '32 MonXL.range("AG1").Select MonXL.selection.Copy a(32) = Clipboard.GetText Clipboard.Clear '33 MonXL.range("AH1").Select MonXL.selection.Copy a(33) = Clipboard.GetText Clipboard.Clear '34 MonXL.range("AI1").Select MonXL.selection.Copy a(34) = Clipboard.GetText Clipboard.Clear '35 MonXL.range("AJ1").Select MonXL.selection.Copy a(35) = Clipboard.GetText Clipboard.Clear '36 MonXL.range("AK1").Select MonXL.selection.Copy a(36) = Clipboard.GetText Clipboard.Clear '37 MonXL.range("AL1").Select MonXL.selection.Copy a(37) = Clipboard.GetText Clipboard.Clear '38 MonXL.range("AM1").Select MonXL.selection.Copy a(38) = Clipboard.GetText Clipboard.Clear '39 MonXL.range("AN1").Select MonXL.selection.Copy a(39) = Clipboard.GetText Clipboard.Clear '40 MonXL.range("AO1").Select MonXL.selection.Copy a(40) = Clipboard.GetText Clipboard.Clear '41 MonXL.range("AP1").Select MonXL.selection.Copy a(41) = Clipboard.GetText Clipboard.Clear '42 MonXL.range("AQ1").Select MonXL.selection.Copy a(42) = Clipboard.GetText Clipboard.Clear '43 MonXL.range("AR1").Select MonXL.selection.Copy a(43) = Clipboard.GetText Clipboard.Clear '44 MonXL.range("AS1").Select MonXL.selection.Copy a(44) = Clipboard.GetText Clipboard.Clear '45 MonXL.range("AT1").Select MonXL.selection.Copy a(45) = Clipboard.GetText Clipboard.Clear '46 MonXL.range("AU1").Select MonXL.selection.Copy a(46) = Clipboard.GetText Clipboard.Clear '47 MonXL.range("AV1").Select MonXL.selection.Copy a(47) = Clipboard.GetText Clipboard.Clear '48 MonXL.range("AW1").Select MonXL.selection.Copy a(48) = Clipboard.GetText Clipboard.Clear '49 MonXL.range("AX1").Select MonXL.selection.Copy a(49) = Clipboard.GetText Clipboard.Clear '50 MonXL.range("AY1").Select MonXL.selection.Copy a(50) = Clipboard.GetText Clipboard.Clear '51 MonXL.range("AZ1").Select MonXL.selection.Copy a(51) = Clipboard.GetText Clipboard.Clear '52 MonXL.range("BA1").Select MonXL.selection.Copy a(52) = Clipboard.GetText Clipboard.Clear '53 MonXL.range("BB1").Select MonXL.selection.Copy a(53) = Clipboard.GetText Clipboard.Clear '54 MonXL.range("BC1").Select MonXL.selection.Copy a(54) = Clipboard.GetText Clipboard.Clear '55 MonXL.range("BD1").Select MonXL.selection.Copy a(55) = Clipboard.GetText Clipboard.Clear '56 MonXL.range("BE1").Select MonXL.selection.Copy a(56) = Clipboard.GetText Clipboard.Clear '57 MonXL.range("BF1").Select MonXL.selection.Copy a(57) = Clipboard.GetText Clipboard.Clear '58 MonXL.range("BG1").Select MonXL.selection.Copy a(58) = Clipboard.GetText Clipboard.Clear '59 MonXL.range("BH1").Select MonXL.selection.Copy a(59) = Clipboard.GetText Clipboard.Clear '60 MonXL.range("BI1").Select MonXL.selection.Copy a(60) = Clipboard.GetText Clipboard.Clear '61 MonXL.range("BJ1").Select MonXL.selection.Copy a(61) = Clipboard.GetText Clipboard.Clear '62 MonXL.range("BK1").Select MonXL.selection.Copy a(62) = Clipboard.GetText Clipboard.Clear '63 MonXL.range("BL1").Select MonXL.selection.Copy a(63) = Clipboard.GetText Clipboard.Clear '64 MonXL.range("BM1").Select MonXL.selection.Copy a(64) = Clipboard.GetText Clipboard.Clear '65 MonXL.range("BN1").Select MonXL.selection.Copy a(65) = Clipboard.GetText Clipboard.Clear '66 MonXL.range("BO1").Select MonXL.selection.Copy a(66) = Clipboard.GetText Clipboard.Clear '67 MonXL.range("BP1").Select MonXL.selection.Copy a(67) = Clipboard.GetText Clipboard.Clear '68 MonXL.range("BQ1").Select MonXL.selection.Copy a(68) = Clipboard.GetText Clipboard.Clear '69 MonXL.range("BR1").Select MonXL.selection.Copy a(69) = Clipboard.GetText Clipboard.Clear '70 MonXL.range("BS1").Select MonXL.selection.Copy a(70) = Clipboard.GetText Clipboard.Clear '71 MonXL.range("BT1").Select MonXL.selection.Copy a(71) = Clipboard.GetText Clipboard.Clear '72 MonXL.range("BU1").Select MonXL.selection.Copy a(72) = Clipboard.GetText Clipboard.Clear '73 MonXL.range("BV1").Select MonXL.selection.Copy a(73) = Clipboard.GetText Clipboard.Clear '74 MonXL.range("BW1").Select MonXL.selection.Copy a(74) = Clipboard.GetText Clipboard.Clear '75 MonXL.range("BX1").Select MonXL.selection.Copy a(75) = Clipboard.GetText Clipboard.Clear '76 MonXL.range("BY1").Select MonXL.selection.Copy a(76) = Clipboard.GetText Clipboard.Clear '77 MonXL.range("BZ1").Select MonXL.selection.Copy a(77) = Clipboard.GetText Clipboard.Clear '78 MonXL.range("CA1").Select MonXL.selection.Copy a(78) = Clipboard.GetText Clipboard.Clear '79 MonXL.range("CB1").Select MonXL.selection.Copy a(79) = Clipboard.GetText Clipboard.Clear '80 MonXL.range("CC1").Select MonXL.selection.Copy a(80) = Clipboard.GetText Clipboard.Clear '81 MonXL.range("CD1").Select MonXL.selection.Copy a(81) = Clipboard.GetText Clipboard.Clear '82 MonXL.range("CE1").Select MonXL.selection.Copy a(82) = Clipboard.GetText Clipboard.Clear '83 MonXL.range("CF1").Select MonXL.selection.Copy a(83) = Clipboard.GetText Clipboard.Clear '82 MonXL.range("CG1").Select MonXL.selection.Copy a(84) = Clipboard.GetText Clipboard.Clear '85 MonXL.range("CH1").Select MonXL.selection.Copy a(85) = Clipboard.GetText Clipboard.Clear '86 MonXL.range("CI1").Select MonXL.selection.Copy a(86) = Clipboard.GetText Clipboard.Clear '87 MonXL.range("CJ1").Select MonXL.selection.Copy a(87) = Clipboard.GetText Clipboard.Clear '88 MonXL.range("CK1").Select MonXL.selection.Copy a(88) = Clipboard.GetText Clipboard.Clear '89 MonXL.range("CL1").Select MonXL.selection.Copy a(89) = Clipboard.GetText Clipboard.Clear '90 MonXL.range("CM1").Select MonXL.selection.Copy a(90) = Clipboard.GetText Clipboard.Clear '91 MonXL.range("CN1").Select MonXL.selection.Copy a(91) = Clipboard.GetText Clipboard.Clear '92 MonXL.range("CO1").Select MonXL.selection.Copy a(92) = Clipboard.GetText Clipboard.Clear '93 MonXL.range("CP1").Select MonXL.selection.Copy a(93) = Clipboard.GetText Clipboard.Clear '94 MonXL.range("CQ1").Select MonXL.selection.Copy a(94) = Clipboard.GetText Clipboard.Clear '95 MonXL.range("CR1").Select MonXL.selection.Copy a(95) = Clipboard.GetText Clipboard.Clear '96 MonXL.range("CS1").Select MonXL.selection.Copy a(96) = Clipboard.GetText Clipboard.Clear '97 MonXL.range("CT1").Select MonXL.selection.Copy a(97) = Clipboard.GetText Clipboard.Clear '98 MonXL.range("CU1").Select MonXL.selection.Copy a(98) = Clipboard.GetText Clipboard.Clear '99 MonXL.range("CV1").Select MonXL.selection.Copy a(99) = Clipboard.GetText Clipboard.Clear '100 MonXL.range("CW1").Select MonXL.selection.Copy a(100) = Clipboard.GetText Clipboard.Clear 'Elementi Open App.Path + "\data\Elementi.txt" For Output As #1 '13-05 For i = 1 To 100 Print #1, a(i) Next i Close #1 Open App.Path + "\data\Elementi.txt" For Input As #1 k = 0 Do While Not EOF(1) ' Loop until end of file. Input #1, aa k = k + 1 If aa = "" Then k = k - 1 GoTo ww End If Elementi(k) = aa ' Combo1.AddItem aa Form2.Visible = False Form3.Visible = False Form2.Combo1.AddItem aa Form2.Combo2.AddItem aa Form3.Combo1.AddItem aa Form3.Combo2.AddItem aa Form3.Combo3.AddItem aa Form6.Combo1.AddItem aa Form6.Combo2.AddItem aa Form2.Visible = False Form3.Visible = False ww: Loop Numelem = k 'Label1.Caption = k Close #1 'CAMPIONI MonXL.range("A2:A500").Select MonXL.selection.Copy bbb = Clipboard.GetText Open App.Path + "\data\Campioni.txt" For Output As #2 Print #2, bbb Close #2 Open App.Path + "\data\Campioni.txt" For Input As #2 k = 0 Do While Not EOF(2) ' Loop until end of file. Line Input #2, aa k = k + 1 If aa = "" Then k = k - 1 GoTo ww1 End If NomeCamp(k) = aa 'Combo2.AddItem aa ww1: Loop Close #2 NumElem0 = Numelem NumElem1 = Numelem Numcamp1 = k 'DATI Form15.Show Form15.ProgressBar1.Value = 0 Form15.Label1.Caption = "Importing file .XLS" Form15.ProgressBar1.Max = Numelem + 1 t0 = Timer nsecond = 2 Do While Timer - t0 < nsecond dummy = DoEvents() If Timer < t0 Then t0 = t0 - CLng(24) * CLng(60) * CLng(60) End If Loop MonXL.range("E2:CZ501").Select Set Intervallo = MonXL.selection.currentregion For i = 2 To Numelem + 1 For ii = 2 To Numcamp1 + 1 DatiOrigine(ii - 1, i - 1) = Val(Intervallo(ii, i)) Next Form15.ProgressBar1.Value = i Next For i = 1 To Numelem For ii = 1 To Numcamp1 If DatiOrigine(ii, i) = 0 Then DatiOrigine(ii, i) = -12345.67 End If Next Next On Error GoTo qwer12 Clipboard.Clear MonXL.activeWorkbook.Close SaveChanges:=False qwer12: MonXL.quit Set MonXL = Nothing 'Converto eventuali imperfezioni nelle notazioni For k = 1 To Numelem If Elementi(k) = "SiO[2]" Then Elementi(k) = "SiO2" GoTo rr End If If Elementi(k) = "TiO[2]" Then Elementi(k) = "TiO2" GoTo rr End If If Elementi(k) = "Al[2]O[3]" Then Elementi(k) = "Al2O3" GoTo rr End If If Elementi(k) = "Fe[2]O[3]" Then Elementi(k) = "Fe2O3" GoTo rr End If If Elementi(k) = "FeO" Then Elementi(k) = "FeO" GoTo rr End If If Elementi(k) = "MnO" Then Elementi(k) = "MnO" GoTo rr End If If Elementi(k) = "MgO" Then Elementi(k) = "MgO" GoTo rr End If If Elementi(k) = "CaO" Then Elementi(k) = "CaO" GoTo rr End If If Elementi(k) = "Na[2]O" Then Elementi(k) = "Na2O" GoTo rr End If If Elementi(k) = "K[2]O" Then Elementi(k) = "K2O" GoTo rr End If If Elementi(k) = "P[2]O[5]" Then Elementi(k) = "P2O5" GoTo rr End If If Elementi(k) = "H[2]O+" Then Elementi(k) = "H2O+" GoTo rr End If If Elementi(k) = "H2[O]-" Then Elementi(k) = "H2O-" k = k + 1 GoTo rr End If If Elementi(k) = "Cr[2]O[3]" Then Elementi(k) = "Cr2O3" GoTo rr End If If Elementi(k) = "NiO" Then Elementi(k) = "NiO" GoTo rr End If rr: Next k 'inserisco i dati nella flex grid BackGrnd.FG1.Rows = Numcamp1 + 1 BackGrnd.FG1.ColS = Numelem + 3 Form7.Fl2.Rows = Numcamp1 + 1 Form7.Fl2.ColS = 33 'ATTENZIONE 28 Form9.MSFG1.Rows = Numcamp1 + 2 Form9.MSFG1.Row = Numcamp1 + 1 Form9.MSFG1.col = 0 Form9.MSFG1.Text = "mean" For i = 3 To Numelem + 2 BackGrnd.FG1.Row = 0 BackGrnd.FG1.col = i BackGrnd.FG1.Text = Elementi(i - 2) Next i For i = 1 To Numcamp1 Form12.Combo1.AddItem NomeCamp(i) Form12.Combo5.AddItem NomeCamp(i) Form12.Combo7.AddItem NomeCamp(i) Form12.Combo8.AddItem NomeCamp(i) Form8.Combo1.AddItem NomeCamp(i) Form27.Combo1.AddItem NomeCamp(i) Form27.Combo5.AddItem NomeCamp(i) BackGrnd.FG1.Row = i BackGrnd.FG1.col = 0 BackGrnd.FG1.Text = NomeCamp(i) Form7.Fl2.Row = i Form7.Fl2.col = 0 Form7.Fl2.Text = NomeCamp(i) Form9.MSFG1.col = 0 Form9.MSFG1.Row = i Form9.MSFG1.Text = NomeCamp(i) Next i For i = 1 To Numcamp1 For ii = 3 To Numelem + 2 BackGrnd.FG1.Row = i BackGrnd.FG1.col = ii If DatiOrigine(i, ii - 2) = -12345.67 Then BackGrnd.FG1.Text = "-" GoTo et End If BackGrnd.FG1.Text = DatiOrigine(i, ii - 2) et: Next ii Next i BackGrnd.FG1.Row = 0 BackGrnd.FG1.col = 1 BackGrnd.FG1.Text = "Symbol" BackGrnd.FG1.col = 2 BackGrnd.FG1.Text = "Color" For i = 1 To Numcamp1 BackGrnd.FG1.Row = i BackGrnd.FG1.col = 1 BackGrnd.FG1.Text = 3 BackGrnd.FG1.col = 2 BackGrnd.FG1.Text = 1 Next i 'converto in ppm gli eventuali ossidi di elementi utili in traccia INP.Feototale For i = 1 To Numelem If Elementi(i) = "TiO2" Then INP.ConvertiPPM "Ti", i End If If Elementi(i) = "P2O5" Then INP.ConvertiPPM "P", i End If If Elementi(i) = "Zr2O5" Then INP.ConvertiPPM "Zr", i End If If Elementi(i) = "K2O" Then INP.ConvertiPPM "K", i End If If Elementi(i) = "MnO" Then INP.ConvertiPPM "Mn", i End If If Elementi(i) = "FeOtot" Then INP.ConvertiPPM "Fe", i End If Next i INP.ResettaForm13 INP.InserisciInForm13Start BackGrnd.Show Form12.Hide Form27.Hide Fileopen = True GoTo ere1 ere2: MsgBox "An Error Occurred: I'm not able to open this file", , "Error" ere: '-------- Fileopen = False BackGrnd.Hide Form12.Hide Form27.Hide Close #1 Close #2 Close #3 Clipboard.Clear ere1: Form15.Hide Form7.Hide End Sub Private Sub opzOption_Click() frmOptions.Show End Sub Private Sub opzOtherSpi_Click() If Fileopen = False Then MsgBox "An Error Occurred: open an input file first", , "Error" Exit Sub End If SPI1.DeterminaSpiderPresenti Form16.Combo1.Text = "Seleziona" For i = 1 To 30 Form16.Shape2(i - 1).Visible = False Form16.Label1(i - 1).Visible = False Next i Form16.Combo2.Clear For i = 1 To Numcamp1 Form16.Combo2.AddItem NomeCamp(i) Next i Form16.List1.Clear Form16.Show Form16.SetFocus End Sub Private Sub opzPartition_Click() Form24.Show Form24.SetFocus End Sub Private Sub opzPecceTaylor_Click() DiagramType1 = "PecceTay" Form14.Text1.Text = 500 Form14.Text2.Text = 350 Form14.Show Form14.SetFocus End Sub Private Sub opzPick_Click() Form22.Combo1.Clear id1 = Indeks For i = 1 To Numcamp1 If Campione(i, id1) <> "" Then Form22.Combo1.AddItem Campione(i, id1) End If Next i Form22.Show Form22.SetFocus End Sub Private Sub opzProject_Click() Dim Symbol(5000) As Integer Dim Color(5000) As Integer On Error GoTo ere CommonDialog1.DialogTitle = "Open Data(.PRJ) ..." CommonDialog1.Filter = "*.PRJ" CommonDialog1.FileName = "*.PRJ" CommonDialog1.ShowOpen file$ = CommonDialog1.FileName jj = Len(file$) Nomegruppo = left(file$, jj - 4) On Error GoTo ere1 Open file$ For Input As #5 Input #5, Numelem, Numcamp1, NumL Input #5, aa, bb, cc, dd For i = 1 To Numelem Input #5, aa Elementi(i) = aa Next i For i = 1 To Numcamp1 Input #5, aaa, aa, bb, cc NomeCamp(i) = aa Symbol(i) = bb Color(i) = cc For ii = 1 To Numelem Input #5, aa DatiOrigine(i, ii) = aa Next ii Next i Input #5, aa For i = 1 To NumL Input #5, aa SerieL(i) = aa Next i Legen = True 'Converto eventuali imperfezioni nelle notazioni For k = 1 To Numelem If Elementi(k) = "SiO[2]" Then Elementi(k) = "SiO2" GoTo rr End If If Elementi(k) = "TiO[2]" Then Elementi(k) = "TiO2" GoTo rr End If If Elementi(k) = "Al[2]O[3]" Then Elementi(k) = "Al2O3" GoTo rr End If If Elementi(k) = "Fe[2]O[3]" Then Elementi(k) = "Fe2O3" GoTo rr End If If Elementi(k) = "FeO" Then Elementi(k) = "FeO" GoTo rr End If If Elementi(k) = "MnO" Then Elementi(k) = "MnO" GoTo rr End If If Elementi(k) = "MgO" Then Elementi(k) = "MgO" GoTo rr End If If Elementi(k) = "CaO" Then Elementi(k) = "CaO" GoTo rr End If If Elementi(k) = "Na[2]O" Then Elementi(k) = "Na2O" GoTo rr End If If Elementi(k) = "K[2]O" Then Elementi(k) = "K2O" GoTo rr End If If Elementi(k) = "P[2]O[5]" Then Elementi(k) = "P2O5" GoTo rr End If If Elementi(k) = "H[2]O+" Then Elementi(k) = "H2O+" GoTo rr End If If Elementi(k) = "H2[O]-" Then Elementi(k) = "H2O-" k = k + 1 GoTo rr End If If Elementi(k) = "Cr[2]O[3]" Then Elementi(k) = "Cr2O3" GoTo rr End If If Elementi(k) = "NiO" Then Elementi(k) = "NiO" GoTo rr End If rr: Next k 'inserisco i dati nella tabella NumElem0 = Numelem NumElem1 = Numelem 'inserisco i dati nella flex grid BackGrnd.FG1.Rows = Numcamp1 + 1 BackGrnd.FG1.ColS = Numelem + 3 For i = 1 To Numelem + 2 BackGrnd.FG1.ColWidth(i) = 1500 Next i Form9.MSFG1.Rows = Numcamp1 + 2 Form9.MSFG1.Row = Numcamp1 + 1 Form9.MSFG1.col = 0 Form9.MSFG1.Text = "mean" For i = 3 To Numelem + 2 BackGrnd.FG1.Row = 0 BackGrnd.FG1.col = i BackGrnd.FG1.Text = Elementi(i - 2) Next i Form7.Fl2.Rows = Numcamp1 + 1 Form7.Fl2.ColS = 33 'ATTENZIONE 28 For i = 1 To Numcamp1 Form12.Combo1.AddItem NomeCamp(i) Form12.Combo5.AddItem NomeCamp(i) Form12.Combo7.AddItem NomeCamp(i) Form12.Combo8.AddItem NomeCamp(i) Form8.Combo1.AddItem NomeCamp(i) Form27.Combo1.AddItem NomeCamp(i) Form27.Combo5.AddItem NomeCamp(i) BackGrnd.FG1.Row = i BackGrnd.FG1.col = 0 BackGrnd.FG1.Text = NomeCamp(i) Form7.Fl2.Row = i Form7.Fl2.col = 0 Form7.Fl2.Text = NomeCamp(i) Form9.MSFG1.col = 0 Form9.MSFG1.Row = i Form9.MSFG1.Text = NomeCamp(i) Next i For i = 1 To Numcamp1 For ii = 3 To Numelem + 2 BackGrnd.FG1.Row = i BackGrnd.FG1.col = ii If DatiOrigine(i, ii - 2) = -12345.67 Then BackGrnd.FG1.Text = "-" GoTo et End If BackGrnd.FG1.Text = DatiOrigine(i, ii - 2) et: Next ii Next i BackGrnd.FG1.Row = 0 BackGrnd.FG1.col = 1 BackGrnd.FG1.Text = "Symbol" BackGrnd.FG1.col = 2 BackGrnd.FG1.Text = "Color" For i = 1 To Numcamp1 BackGrnd.FG1.Row = i BackGrnd.FG1.col = 1 BackGrnd.FG1.Text = Symbol(i) BackGrnd.FG1.col = 2 BackGrnd.FG1.Text = Color(i) Next i INP.ResettaForm13 INP.InserisciInForm13Start BackGrnd.Show Form12.Hide Form27.Hide Fileopen = True '----------------------------------- Input #5, NumElem0 Input #5, Maxindeks For cv = 1 To Maxindeks Input #5, wwwr If wwwr = 1 Then ActiveGraph(cv) = True Else ActiveGraph(cv) = False End If Next cv For cv = 1 To Maxindeks If ActiveGraph(cv) = True Then Line Input #5, tipoGraph(cv) Input #5, bb Indeks = cv 'dati della finestra Input #5, bn If bn = 1 Then binary(cv) = True Else binary(cv) = False End If Input #5, bn If bn = 1 Then SPIDERREE(cv) = True Else SPIDERREE(cv) = False End If Input #5, bn If bn = 1 Then SPIDEROTHER(cv) = True Else SPIDEROTHER(cv) = TrueFalse End If Input #5, bn If bn = 1 Then Triangular(cv) = True Else Triangular(cv) = False End If Input #5, DiagramType(cv) Input #5, GraphDimX(cv) Input #5, GraphDimY(cv) Input #5, Xgraph(cv) Input #5, Ygraph(cv) Input #5, Tp1(cv) Input #5, SimbDim(cv) Input #5, SimbSp(cv) Input #5, LineSp(cv) Input #5, AXX(cv) Input #5, AXY(cv) Input #5, AxAa(cv) Input #5, AXB(cv) Input #5, AXC(cv) Input #5, MaxX(cv) Input #5, MinX(cv) Input #5, MaxY(cv) Input #5, MinY(cv) Input #5, deltax1(cv) Input #5, deltay1(cv) Input #5, NumCamp(cv) For i = 1 To NumCamp(cv) Input #5, xx(i, cv) Input #5, yy(i, cv) Input #5, XXReal(i, cv) Input #5, YYReal(i, cv) Input #5, Campione(i, cv) Next i 'spider For i = 1 To Numcamp1 For ii = 1 To 15 Input #5, Spiy(cv, ii, i) Next ii Next i Line Input #5, NormSP(cv) Line Input #5, SpiPlotted(cv) Input #5, NumCampSpi(cv) Input #5, NumCampSpi(cv) Input #5, NormSP(cv) Input #5, SpiPlotted(cv) Close #2 'dati dei modelli Input #5, ModAsseX(cv) Input #5, ModAssey(cv) Input #5, NumModelli(cv) For cvi = 1 To NumModelli(cv) Open App.Path + "\data\" + Trim(cv) + "modelExplain" + Trim(cvi) + ".txt" For Output As #2 Line Input #5, mmod '"AFC" Write #2, mmod Line Input #5, R 'R Write #2, R Line Input #5, C01 'C0 Write #2, co1 Line Input #5, CA 'CA Write #2, CA Line Input #5, C1 'C1 Write #2, C1 Line Input #5, C2 'C2 Write #2, C2 Line Input #5, NumModelElem4$ Write #2, Val(NumModelElem4$) aaw = Val(NumModelElem4$) For i = 1 To aaw Input #5, ModElementi(i) Write #2, ModElementi(i) Next i Input #5, aaw For i = 1 To aaw Input #5, ModD(i) Write #2, ModD(i) Next i Close #2 Open App.Path + "\data\" + Trim(cv) + "modello" + Trim(cvi) + ".txt" For Output As #2 Input #5, NumModelElem1 Input #5, NumModDati Input #5, ModelLineSp Input #5, ModelLineCol Input #5, ModelSymb Input #5, ModelSymbSp Input #5, ModelSymbCol Input #5, ModelSymbWid Write #2, NumModelElem1, NumModDati, ModelLineSp, ModelLineCol, ModelSymb, ModelSymbSp, ModelSymbCol, ModelSymbWid For ii = 1 To NumModelElem1 Input #5, qiope Write #2, qiope Next ii For i = 1 To NumModDati For ii = 1 To NumModelElem1 Input #5, qiope Write #2, qiope Next ii Next i Close #2 Next cvi End If Indeks = cv ProgTrue = True opzAggiorna_Click 'If tipoGraph(Indeks) = "normx-normy" Then 'MF1.DisegnaNormXNormY 'End If 'If tipoGraph(Indeks) = "normx-logy" Then 'MF1.DisegnaNormXLogY 'End If 'If tipoGraph(Indeks) = "logx-normy" Then 'MF1.DisegnaLogXNormY 'End If 'If tipoGraph(Indeks) = "logx-logy" Then 'MF1.DisegnaLogXLogY 'End If Next cv Close #5 GoTo ere ere1: MsgBox "An Error Occurred", , "Error" Fileopen = False BackGrnd.Hide Form12.Hide Form27.Hide Close #5 Close #2 Close #3 ere: Close #5 Close #2 Close #3 End Sub Private Sub opzQFANOR_Click() If CIPWyn = False Then CIPW.Norm CIPWyn = True End If DiagramType1 = "Strelemaitre" Form14.Text1.Text = 500 Form14.Text2.Text = 350 Form14.Show Form14.SetFocus End Sub Private Sub opzRbYbTa_Click() DiagramType1 = "Rb(YbTa)" Form1.Show Form1.SetFocus End Sub Private Sub opzRbYTa_Click() DiagramType1 = "Rb(YTa)" Form1.Show Form1.SetFocus End Sub Private Sub opzRbYNb_Click() DiagramType1 = "Rb(YNb)" Form1.Show Form1.SetFocus End Sub Private Sub opzRee_Click() If Fileopen = False Then MsgBox "An Error Occurred: open an input file first", , "Error" Exit Sub End If SPI.DeterminaREEPresenti If REE1(7) = False Then MsgBox "An Error Occurred: Eu have to be present in data table", , "Error" Exit Sub End If For i = 1 To 15 If REE1(i) = True Then Form8.Shape1(i - 1).FillColor = QBColor(2) REESelect(i - 1) = True End If If REE1(i) = False Then Form8.Shape1(i - 1).FillColor = QBColor(12) REESelect(i - 1) = False End If Next i Form8.Combo1.Clear Form8.List1.Clear INP.IndividuaREEgiusti Form8.Show End Sub Private Sub opzREETable_Click() If REEOperation = True Then Form9.Show Form9.SetFocus End If If REEOperation = False Then 'MsgBox "Non è stata eseguita alcuna operazione su REE (Input_Data_Elab)" End If End Sub Private Sub opzRoc_Click() On Error GoTo ere1 'resetto le variabili Erase DatiOrigine Erase Elementi Erase NomeCamp Erase KeyVal CIPWyn = False REEOperation = False Numelem = 0 Numcamp1 = 0 NumElem0 = 0 MDIForm1.StatusBar1.Panels(1).Text = "" MDIForm1.StatusBar1.Panels(2).Text = "" MDIForm1.StatusBar1.Panels(3).Text = "" For ia = 1 To 15 NumModelli(ia) = 0 Next ia BackGrnd.FG1.Clear BackGrnd.Hide Legen = False 'form2 Form2.Combo1.Clear Form2.Combo2.Clear 'form3 Form3.Combo1.Clear Form3.Combo2.Clear Form3.Combo3.Clear 'form6 Form6.Combo1.Clear Form6.Combo2.Clear 'APRO IL FILE E LEGGO CommonDialog1.DialogTitle = "Open IGPETWIN file(.ROC) ..." CommonDialog1.Filter = "*.ROC" CommonDialog1.FileName = "*.ROC" CommonDialog1.ShowOpen file$ = CommonDialog1.FileName jj = Len(file$) Nomegruppo = left(file$, jj - 4) aa = 1 On Error GoTo prova3 tipoacq = 1 Open file$ For Input As #1 Dim Key(10) Dim numKey As Integer numKey = 0 aa = "w" Input #1, aa If aa = "dum" Or aa = "Dum" Or aa = "DUM" Then numKey = numKey + 1 tipoacq = 2 Key(numKey) = "DUM" End If k = 0 For i = 1 To 100 Input #1, aa If aa = "end" Or aa = "END" Or aa = "End" Then GoTo rr1 End If If aa = "J" Or aa = "j" Then numKey = numKey + 1 Key(numKey) = "J" GoTo rr End If If aa = "K" Or aa = "k" Then numKey = numKey + 1 Key(numKey) = "K" GoTo rr End If If aa = "L" Or aa = "l" Then numKey = numKey + 1 Key(numKey) = "L" GoTo rr End If If aa = "SiO[2]" Then k = k + 1 Elementi(k) = "SiO2" GoTo rr End If If aa = "TiO[2]" Then k = k + 1 Elementi(k) = "TiO2" GoTo rr End If If aa = "Al[2]O[3]" Then k = k + 1 Elementi(k) = "Al2O3" GoTo rr End If If aa = "Fe[2]O[3]" Then k = k + 1 Elementi(k) = "Fe2O3" GoTo rr End If If aa = "FeO" Then k = k + 1 Elementi(k) = "FeO" GoTo rr End If If aa = "MnO" Then k = k + 1 Elementi(k) = "MnO" GoTo rr End If If aa = "MgO" Then k = k + 1 Elementi(k) = "MgO" GoTo rr End If If aa = "CaO" Then k = k + 1 Elementi(k) = "CaO" GoTo rr End If If aa = "Na[2]O" Then k = k + 1 Elementi(k) = "Na2O" GoTo rr End If If aa = "K[2]O" Then k = k + 1 Elementi(k) = "K2O" GoTo rr End If If aa = "P[2]O[5]" Then k = k + 1 Elementi(k) = "P2O5" GoTo rr End If If aa = "H[2]O+" Then k = k + 1 Elementi(k) = "H2O+" GoTo rr End If If aa = "H2[O]-" Then Elementi(k) = "H2O-" k = k + 1 GoTo rr End If If aa = "Cr[2]O[3]" Then k = k + 1 Elementi(k) = "Cr2O3" GoTo rr End If If aa = "NiO" Then k = k + 1 Elementi(k) = "NiO" GoTo rr End If If aa = "s" Or aa = "S" Or aa = "S$" Or aa = "s$" Then GoTo rr End If k = k + 1 Elementi(k) = aa rr: Next i rr1: If i > 99 Then GoTo prova3 Numelem = k 'primo metodo di acquisizione If tipoacq = 2 Then GoTo prova2 k = 0 Do While Not EOF(1) k = k + 1 Input #1, aa NomeCamp(k) = aa For ii = 1 To numKey Input #1, aa If Key(ii) = "K" Then KeyVal(k) = Val(aa) End If Next For i = 1 To Numelem Input #1, aa DatiOrigine(k, i) = Val(aa) Next Loop Close #1 Numcamp1 = k NumElem0 = Numelem NumElem1 = Numelem GoTo Inserisci prova2: 'secondo metodo di acquisizione k = 0 Do While Not EOF(1) k = k + 1 For ii = 1 To numKey Input #1, aa If Key(ii) = "K" Then KeyVal(k) = Val(aa) End If Next Input #1, aa NomeCamp(k) = aa For i = 1 To Numelem Input #1, aa DatiOrigine(k, i) = Val(aa) Next Loop Close #1 Numcamp1 = k NumElem0 = Numelem NumElem1 = Numelem GoTo Inserisci prova3: 'terzo metodo di acquisizione ( lo salto) GoTo prova4 '------------------------------------------------ On Error GoTo prova4 Close #1 'dertermino la directory LUNG = Len(file$) For i = 1 To LUNG str1 = Right(file$, i) str2 = left(str1, 1) If str2 = "\" Then lunfile = Len(str1) - 1 GoTo ryt End If Next i ryt: directory = left(file$, (LUNG - lunfile)) Open file$ For Input As #1 Input #1, aaa$ files1$ = directory + aaa$ Open files1$ For Input As #2 Input #2, aa Numelem = aa For i = 1 To Numelem Input #2, aa Elementi(i) = aa Next i Close #2 k = 0 numKey = 4 Key(3) = "K" Do While Not EOF(1) k = k + 1 For ii = 1 To numKey Input #1, aa If Key(ii) = "K" Then KeyVal(k) = Val(aa) End If Next Input #1, aa NomeCamp(k) = aa For i = 1 To Numelem Input #1, aa DatiOrigine(k, i) = Val(aa) Next Loop Close #1 Numcamp1 = k NumElem0 = Numelem NumElem1 = Numelem GoTo Inserisci '--------------------------------------------------- 'quarto metodo di acquisizione '------------------------------------------------ prova4: Close #1 On Error GoTo ere2 'resetto le variabili Erase DatiOrigine Erase Elementi Erase NomeCamp Erase KeyVal CIPWyn = False REEOperation = False Numelem = 0 Numcamp1 = 0 NumElem0 = 0 MDIForm1.StatusBar1.Panels(1).Text = "" MDIForm1.StatusBar1.Panels(2).Text = "" MDIForm1.StatusBar1.Panels(3).Text = "" BackGrnd.FG1.Clear BackGrnd.Hide 'form2 Form2.Combo1.Clear Form2.Combo2.Clear 'form3 Form3.Combo1.Clear Form3.Combo2.Clear Form3.Combo3.Clear 'form6 Form6.Combo1.Clear Form6.Combo2.Clear Dim a(100) Set MonXL = CreateObject("Excel.Application") MonXL.Workbooks.Open FileName:=file$ 'MonXL.activeWorkbook.Saveas FileName:=App.Path + "\data\ss.xls" '2 MonXL.range("C1").Select MonXL.selection.Copy a(1) = Clipboard.GetText Clipboard.Clear '3 MonXL.range("D1").Select MonXL.selection.Copy a(2) = Clipboard.GetText Clipboard.Clear '4 MonXL.range("E1").Select MonXL.selection.Copy a(3) = Clipboard.GetText Clipboard.Clear '5 MonXL.range("F1").Select MonXL.selection.Copy a(4) = Clipboard.GetText Clipboard.Clear '6 MonXL.range("G1").Select MonXL.selection.Copy a(5) = Clipboard.GetText Clipboard.Clear '7 MonXL.range("H1").Select MonXL.selection.Copy a(6) = Clipboard.GetText Clipboard.Clear '8 MonXL.range("I1").Select MonXL.selection.Copy a(7) = Clipboard.GetText Clipboard.Clear '9 MonXL.range("J1").Select MonXL.selection.Copy a(8) = Clipboard.GetText Clipboard.Clear '10 MonXL.range("K1").Select MonXL.selection.Copy a(9) = Clipboard.GetText Clipboard.Clear '11 MonXL.range("L1").Select MonXL.selection.Copy a(10) = Clipboard.GetText Clipboard.Clear '12 MonXL.range("M1").Select MonXL.selection.Copy a(11) = Clipboard.GetText Clipboard.Clear '13 MonXL.range("N1").Select MonXL.selection.Copy a(12) = Clipboard.GetText Clipboard.Clear '14 MonXL.range("O1").Select MonXL.selection.Copy a(13) = Clipboard.GetText Clipboard.Clear '15 MonXL.range("P1").Select MonXL.selection.Copy a(14) = Clipboard.GetText Clipboard.Clear '16 MonXL.range("Q1").Select MonXL.selection.Copy a(15) = Clipboard.GetText Clipboard.Clear '17 MonXL.range("R1").Select MonXL.selection.Copy a(16) = Clipboard.GetText Clipboard.Clear '18 MonXL.range("S1").Select MonXL.selection.Copy a(17) = Clipboard.GetText Clipboard.Clear '19 MonXL.range("T1").Select MonXL.selection.Copy a(18) = Clipboard.GetText Clipboard.Clear '20 MonXL.range("U1").Select MonXL.selection.Copy a(19) = Clipboard.GetText Clipboard.Clear '21 MonXL.range("V1").Select MonXL.selection.Copy a(20) = Clipboard.GetText Clipboard.Clear '22 MonXL.range("W1").Select MonXL.selection.Copy a(21) = Clipboard.GetText Clipboard.Clear '23 MonXL.range("X1").Select MonXL.selection.Copy a(22) = Clipboard.GetText Clipboard.Clear '24 MonXL.range("Y1").Select MonXL.selection.Copy a(23) = Clipboard.GetText Clipboard.Clear '25 MonXL.range("Z1").Select MonXL.selection.Copy a(24) = Clipboard.GetText Clipboard.Clear '26 MonXL.range("AA1").Select MonXL.selection.Copy a(25) = Clipboard.GetText Clipboard.Clear '27 MonXL.range("AB1").Select MonXL.selection.Copy a(26) = Clipboard.GetText Clipboard.Clear '28 MonXL.range("AC1").Select MonXL.selection.Copy a(27) = Clipboard.GetText Clipboard.Clear '29 MonXL.range("AD1").Select MonXL.selection.Copy a(28) = Clipboard.GetText Clipboard.Clear '30 MonXL.range("AE1").Select MonXL.selection.Copy a(29) = Clipboard.GetText Clipboard.Clear '31 MonXL.range("AF1").Select MonXL.selection.Copy a(30) = Clipboard.GetText Clipboard.Clear '32 MonXL.range("AG1").Select MonXL.selection.Copy a(31) = Clipboard.GetText Clipboard.Clear '33 MonXL.range("AH1").Select MonXL.selection.Copy a(32) = Clipboard.GetText Clipboard.Clear '34 MonXL.range("AI1").Select MonXL.selection.Copy a(33) = Clipboard.GetText Clipboard.Clear '35 MonXL.range("AJ1").Select MonXL.selection.Copy a(34) = Clipboard.GetText Clipboard.Clear '36 MonXL.range("AK1").Select MonXL.selection.Copy a(35) = Clipboard.GetText Clipboard.Clear '37 MonXL.range("AL1").Select MonXL.selection.Copy a(36) = Clipboard.GetText Clipboard.Clear '38 MonXL.range("AM1").Select MonXL.selection.Copy a(37) = Clipboard.GetText Clipboard.Clear '39 MonXL.range("AN1").Select MonXL.selection.Copy a(38) = Clipboard.GetText Clipboard.Clear '40 MonXL.range("AO1").Select MonXL.selection.Copy a(39) = Clipboard.GetText Clipboard.Clear '41 MonXL.range("AP1").Select MonXL.selection.Copy a(40) = Clipboard.GetText Clipboard.Clear '42 MonXL.range("AQ1").Select MonXL.selection.Copy a(41) = Clipboard.GetText Clipboard.Clear '43 MonXL.range("AR1").Select MonXL.selection.Copy a(42) = Clipboard.GetText Clipboard.Clear '44 MonXL.range("AS1").Select MonXL.selection.Copy a(43) = Clipboard.GetText Clipboard.Clear '45 MonXL.range("AT1").Select MonXL.selection.Copy a(44) = Clipboard.GetText Clipboard.Clear '46 MonXL.range("AU1").Select MonXL.selection.Copy a(45) = Clipboard.GetText Clipboard.Clear '47 MonXL.range("AV1").Select MonXL.selection.Copy a(46) = Clipboard.GetText Clipboard.Clear '48 MonXL.range("AW1").Select MonXL.selection.Copy a(47) = Clipboard.GetText Clipboard.Clear '49 MonXL.range("AX1").Select MonXL.selection.Copy a(48) = Clipboard.GetText Clipboard.Clear '50 MonXL.range("AY1").Select MonXL.selection.Copy a(49) = Clipboard.GetText Clipboard.Clear '51 MonXL.range("AZ1").Select MonXL.selection.Copy a(50) = Clipboard.GetText Clipboard.Clear '52 MonXL.range("BA1").Select MonXL.selection.Copy a(51) = Clipboard.GetText Clipboard.Clear '53 MonXL.range("BB1").Select MonXL.selection.Copy a(52) = Clipboard.GetText Clipboard.Clear '54 MonXL.range("BC1").Select MonXL.selection.Copy a(53) = Clipboard.GetText Clipboard.Clear '55 MonXL.range("BD1").Select MonXL.selection.Copy a(54) = Clipboard.GetText Clipboard.Clear '56 MonXL.range("BE1").Select MonXL.selection.Copy a(55) = Clipboard.GetText Clipboard.Clear '57 MonXL.range("BF1").Select MonXL.selection.Copy a(56) = Clipboard.GetText Clipboard.Clear '58 MonXL.range("BG1").Select MonXL.selection.Copy a(57) = Clipboard.GetText Clipboard.Clear '59 MonXL.range("BH1").Select MonXL.selection.Copy a(58) = Clipboard.GetText Clipboard.Clear '60 MonXL.range("BI1").Select MonXL.selection.Copy a(59) = Clipboard.GetText Clipboard.Clear '61 MonXL.range("BJ1").Select MonXL.selection.Copy a(60) = Clipboard.GetText Clipboard.Clear '62 MonXL.range("BK1").Select MonXL.selection.Copy a(61) = Clipboard.GetText Clipboard.Clear '63 MonXL.range("BL1").Select MonXL.selection.Copy a(62) = Clipboard.GetText Clipboard.Clear '64 MonXL.range("BM1").Select MonXL.selection.Copy a(63) = Clipboard.GetText Clipboard.Clear '65 MonXL.range("BN1").Select MonXL.selection.Copy a(64) = Clipboard.GetText Clipboard.Clear '66 MonXL.range("BO1").Select MonXL.selection.Copy a(65) = Clipboard.GetText Clipboard.Clear '67 MonXL.range("BP1").Select MonXL.selection.Copy a(66) = Clipboard.GetText Clipboard.Clear '68 MonXL.range("BQ1").Select MonXL.selection.Copy a(67) = Clipboard.GetText Clipboard.Clear '69 MonXL.range("BR1").Select MonXL.selection.Copy a(68) = Clipboard.GetText Clipboard.Clear '70 MonXL.range("BS1").Select MonXL.selection.Copy a(69) = Clipboard.GetText Clipboard.Clear '71 MonXL.range("BT1").Select MonXL.selection.Copy a(70) = Clipboard.GetText Clipboard.Clear '72 MonXL.range("BU1").Select MonXL.selection.Copy a(71) = Clipboard.GetText Clipboard.Clear '73 MonXL.range("BV1").Select MonXL.selection.Copy a(72) = Clipboard.GetText Clipboard.Clear '74 MonXL.range("BW1").Select MonXL.selection.Copy a(73) = Clipboard.GetText Clipboard.Clear '75 MonXL.range("BX1").Select MonXL.selection.Copy a(74) = Clipboard.GetText Clipboard.Clear '76 MonXL.range("BY1").Select MonXL.selection.Copy a(75) = Clipboard.GetText Clipboard.Clear '77 MonXL.range("BZ1").Select MonXL.selection.Copy a(76) = Clipboard.GetText Clipboard.Clear '78 MonXL.range("CA1").Select MonXL.selection.Copy a(77) = Clipboard.GetText Clipboard.Clear '79 MonXL.range("CB1").Select MonXL.selection.Copy a(78) = Clipboard.GetText Clipboard.Clear '80 MonXL.range("CC1").Select MonXL.selection.Copy a(79) = Clipboard.GetText Clipboard.Clear '81 MonXL.range("CD1").Select MonXL.selection.Copy a(80) = Clipboard.GetText Clipboard.Clear '82 MonXL.range("CE1").Select MonXL.selection.Copy a(81) = Clipboard.GetText Clipboard.Clear '83 MonXL.range("CF1").Select MonXL.selection.Copy a(82) = Clipboard.GetText Clipboard.Clear '82 MonXL.range("CG1").Select MonXL.selection.Copy a(83) = Clipboard.GetText Clipboard.Clear '85 MonXL.range("CH1").Select MonXL.selection.Copy a(84) = Clipboard.GetText Clipboard.Clear '86 MonXL.range("CI1").Select MonXL.selection.Copy a(85) = Clipboard.GetText Clipboard.Clear '87 MonXL.range("CJ1").Select MonXL.selection.Copy a(86) = Clipboard.GetText Clipboard.Clear '88 MonXL.range("CK1").Select MonXL.selection.Copy a(87) = Clipboard.GetText Clipboard.Clear '89 MonXL.range("CL1").Select MonXL.selection.Copy a(88) = Clipboard.GetText Clipboard.Clear '90 MonXL.range("CM1").Select MonXL.selection.Copy a(89) = Clipboard.GetText Clipboard.Clear '91 MonXL.range("CN1").Select MonXL.selection.Copy a(90) = Clipboard.GetText Clipboard.Clear '92 MonXL.range("CO1").Select MonXL.selection.Copy a(91) = Clipboard.GetText Clipboard.Clear '93 MonXL.range("CP1").Select MonXL.selection.Copy a(92) = Clipboard.GetText Clipboard.Clear '94 MonXL.range("CQ1").Select MonXL.selection.Copy a(93) = Clipboard.GetText Clipboard.Clear '95 MonXL.range("CR1").Select MonXL.selection.Copy a(94) = Clipboard.GetText Clipboard.Clear '96 MonXL.range("CS1").Select MonXL.selection.Copy a(95) = Clipboard.GetText Clipboard.Clear '97 MonXL.range("CT1").Select MonXL.selection.Copy a(96) = Clipboard.GetText Clipboard.Clear '98 MonXL.range("CU1").Select MonXL.selection.Copy a(97) = Clipboard.GetText Clipboard.Clear '99 MonXL.range("CV1").Select MonXL.selection.Copy a(98) = Clipboard.GetText Clipboard.Clear '100 MonXL.range("CW1").Select MonXL.selection.Copy a(99) = Clipboard.GetText Clipboard.Clear 'Elementi Open App.Path + "\data\Elementi.txt" For Output As #1 '13-05 For i = 1 To 100 'attenzione 24-11-03 prima era i=3 to 100 Print #1, a(i) Next i Close #1 Open App.Path + "\data\Elementi.txt" For Input As #1 k = 0 Do While Not EOF(1) ' Loop until end of file. Input #1, aa k = k + 1 If aa = "" Then k = k - 1 GoTo ww End If Elementi(k) = aa ' Combo1.AddItem aa Form2.Visible = False Form3.Visible = False Form2.Combo1.AddItem aa Form2.Combo2.AddItem aa Form3.Combo1.AddItem aa Form3.Combo2.AddItem aa Form3.Combo3.AddItem aa Form6.Combo1.AddItem aa Form6.Combo2.AddItem aa Form2.Visible = False Form3.Visible = False ww: Loop Numelem = k 'Label1.Caption = k Close #1 'CAMPIONI MonXL.range("A2:A500").Select MonXL.selection.Copy bbb = Clipboard.GetText Open App.Path + "\data\Campioni.txt" For Output As #2 Print #2, bbb Close #2 Open App.Path + "\data\Campioni.txt" For Input As #2 k = 0 Do While Not EOF(2) ' Loop until end of file. Line Input #2, aa k = k + 1 If aa = "" Then k = k - 1 GoTo ww1 End If NomeCamp(k) = aa 'Combo2.AddItem aa ww1: Loop Close #2 NumElem0 = Numelem NumElem1 = Numelem MonXL.range("B2:B500").Select MonXL.selection.Copy bbb = Clipboard.GetText Open App.Path + "\data\Key.txt" For Output As #2 Print #2, bbb Close #2 Open App.Path + "\data\Key.txt" For Input As #2 k = 0 Do While Not EOF(2) ' Loop until end of file. Line Input #2, aa k = k + 1 If aa = "" Then k = k - 1 GoTo ww45 End If KeyVal(k) = aa 'Combo2.AddItem aa ww45: Loop Close #2 Numcamp1 = k 'DATI Form15.Show Form15.ProgressBar1.Value = 0 Form15.ProgressBar1.Value = 0 Form15.Label1.Caption = "Importing file IGPET file .ROC" Form15.ProgressBar1.Max = Numelem + 4 t0 = Timer nsecond = 2 Do While Timer - t0 < nsecond dummy = DoEvents() If Timer < t0 Then t0 = t0 - CLng(24) * CLng(60) * CLng(60) End If Loop MonXL.range("a1:CZ501").Select Set Intervallo = MonXL.selection.currentregion For i = 3 To Numelem + 3 For ii = 2 To Numcamp1 + 1 DatiOrigine(ii - 1, i - 2) = Val(Intervallo(ii, i)) Next Form15.ProgressBar1.Value = i Next For i = 1 To Numelem For ii = 1 To Numcamp1 If DatiOrigine(ii, i) = 0 Then DatiOrigine(ii, i) = -12345.67 End If Next Next MonXL.range("C2:C500").Select MonXL.selection.Copy bbb = Clipboard.GetText On Error GoTo qwer12 Clipboard.Clear MonXL.activeWorkbook.Close SaveChanges:=False qwer12: 'MonXL.quit Set MonXL = Nothing Open App.Path + "\data\Key.txt" For Output As #2 Print #2, bbb Close #2 Open App.Path + "\data\Key.txt" For Input As #2 k = 0 Do While Not EOF(2) ' Loop until end of file. Line Input #2, aa k = k + 1 If aa = "" Then k = k - 1 GoTo ww451 End If KeyVal(k) = aa 'Combo2.AddItem aa ww451: Loop Close #2 Close #3 'Converto eventuali imperfezioni nelle notazioni For k = 1 To Numelem If Elementi(k) = "SiO[2]" Then Elementi(k) = "SiO2" GoTo rrr End If If Elementi(k) = "TiO[2]" Then Elementi(k) = "TiO2" GoTo rrr End If If Elementi(k) = "Al[2]O[3]" Then Elementi(k) = "Al2O3" GoTo rrr End If If Elementi(k) = "Fe[2]O[3]" Then Elementi(k) = "Fe2O3" GoTo rrr End If If Elementi(k) = "FeO" Then Elementi(k) = "FeO" GoTo rrr End If If Elementi(k) = "MnO" Then Elementi(k) = "MnO" GoTo rrr End If If Elementi(k) = "MgO" Then Elementi(k) = "MgO" GoTo rrr End If If Elementi(k) = "CaO" Then Elementi(k) = "CaO" GoTo rrr End If If Elementi(k) = "Na[2]O" Then Elementi(k) = "Na2O" GoTo rrr End If If Elementi(k) = "K[2]O" Then Elementi(k) = "K2O" GoTo rrr End If If Elementi(k) = "P[2]O[5]" Then Elementi(k) = "P2O5" GoTo rrr End If If Elementi(k) = "H[2]O+" Then Elementi(k) = "H2O+" GoTo rrr End If If Elementi(k) = "H2[O]-" Then Elementi(k) = "H2O-" k = k + 1 GoTo rr End If If Elementi(k) = "Cr[2]O[3]" Then Elementi(k) = "Cr2O3" GoTo rrr End If If Elementi(k) = "NiO" Then Elementi(k) = "NiO" GoTo rrr End If rrr: Next k '------------------------------------------------ Inserisci: 'inserisco i dati nella flex grid BackGrnd.FG1.Rows = Numcamp1 + 1 BackGrnd.FG1.ColS = (Numelem + 4) Form7.Fl2.Rows = Numcamp1 + 1 Form7.Fl2.ColS = 33 'ATTENZIONE28 Form9.MSFG1.Rows = Numcamp1 + 2 Form9.MSFG1.Row = Numcamp1 + 1 Form9.MSFG1.col = 0 Form9.MSFG1.Text = "mean" For i = 4 To Numelem + 3 BackGrnd.FG1.Row = 0 BackGrnd.FG1.col = i BackGrnd.FG1.Text = Elementi(i - 3) Next i For i = 1 To Numcamp1 Form12.Combo1.AddItem NomeCamp(i) Form12.Combo5.AddItem NomeCamp(i) Form12.Combo7.AddItem NomeCamp(i) Form12.Combo8.AddItem NomeCamp(i) Form8.Combo1.AddItem NomeCamp(i) Form27.Combo1.AddItem NomeCamp(i) Form27.Combo5.AddItem NomeCamp(i) BackGrnd.FG1.Row = i BackGrnd.FG1.col = 0 BackGrnd.FG1.Text = NomeCamp(i) Form7.Fl2.Row = i Form7.Fl2.col = 0 Form7.Fl2.Text = NomeCamp(i) Form9.MSFG1.col = 0 Form9.MSFG1.Row = i Form9.MSFG1.Text = NomeCamp(i) Next i For i = 1 To Numcamp1 For ii = 4 To Numelem + 3 BackGrnd.FG1.Row = i BackGrnd.FG1.col = ii If DatiOrigine(i, ii - 3) = -12345.67 Then BackGrnd.FG1.Text = "-" GoTo et End If BackGrnd.FG1.Text = DatiOrigine(i, ii - 3) et: Next ii Next i BackGrnd.FG1.Row = 0 BackGrnd.FG1.col = 1 BackGrnd.FG1.Text = "Symbol" BackGrnd.FG1.col = 2 BackGrnd.FG1.Text = "Color" BackGrnd.FG1.col = 3 BackGrnd.FG1.Text = "Plot (0-1)" For i = 1 To Numcamp1 If KeyVal(i) = 0 Then BackGrnd.FG1.Row = i BackGrnd.FG1.col = 1 BackGrnd.FG1.Text = 0 BackGrnd.FG1.col = 2 BackGrnd.FG1.Text = 1 End If If KeyVal(i) >= 1 And KeyVal(i) <= 9 Then BackGrnd.FG1.Row = i BackGrnd.FG1.col = 1 BackGrnd.FG1.Text = KeyVal(i) BackGrnd.FG1.col = 2 BackGrnd.FG1.Text = 1 End If If KeyVal(i) >= 10 And KeyVal(i) <= 19 Then BackGrnd.FG1.Row = i BackGrnd.FG1.col = 1 BackGrnd.FG1.Text = KeyVal(i) - 9 BackGrnd.FG1.col = 2 BackGrnd.FG1.Text = 2 End If If KeyVal(i) >= 19 And KeyVal(i) <= 27 Then BackGrnd.FG1.Row = i BackGrnd.FG1.col = 1 BackGrnd.FG1.Text = KeyVal(i) - 18 BackGrnd.FG1.col = 2 BackGrnd.FG1.Text = 3 End If If KeyVal(i) >= 28 And KeyVal(i) <= 36 Then BackGrnd.FG1.Row = i BackGrnd.FG1.col = 1 BackGrnd.FG1.Text = KeyVal(i) - 27 BackGrnd.FG1.col = 2 BackGrnd.FG1.Text = 4 End If If KeyVal(i) >= 37 And KeyVal(i) <= 45 Then BackGrnd.FG1.Row = i BackGrnd.FG1.col = 1 BackGrnd.FG1.Text = KeyVal(i) - 36 BackGrnd.FG1.col = 2 BackGrnd.FG1.Text = 5 End If If KeyVal(i) >= 46 And KeyVal(i) <= 54 Then BackGrnd.FG1.Row = i BackGrnd.FG1.col = 1 BackGrnd.FG1.Text = KeyVal(i) - 45 BackGrnd.FG1.col = 2 BackGrnd.FG1.Text = 6 End If If KeyVal(i) >= 55 And KeyVal(i) <= 64 Then BackGrnd.FG1.Row = i BackGrnd.FG1.col = 1 BackGrnd.FG1.Text = KeyVal(i) - 54 BackGrnd.FG1.col = 2 BackGrnd.FG1.Text = 7 End If If KeyVal(i) >= 65 And KeyVal(i) <= 72 Then BackGrnd.FG1.Row = i BackGrnd.FG1.col = 1 BackGrnd.FG1.Text = KeyVal(i) - 64 BackGrnd.FG1.col = 2 BackGrnd.FG1.Text = 8 End If BackGrnd.FG1.Row = i BackGrnd.FG1.col = 3 BackGrnd.FG1.Text = 1 Next i 'converto in ppm gli eventuali ossidi di elementi utili in traccia INP.Feototale For i = 1 To Numelem If Elementi(i) = "TiO2" Then INP.ConvertiPPM "Ti", i End If If Elementi(i) = "P2O5" Then INP.ConvertiPPM "P", i End If If Elementi(i) = "Zr2O5" Then INP.ConvertiPPM "Zr", i End If If Elementi(i) = "K2O" Then INP.ConvertiPPM "K", i End If If Elementi(i) = "MnO" Then INP.ConvertiPPM "Mn", i End If If Elementi(i) = "FeOtot" Then INP.ConvertiPPM "Fe", i End If Next i INP.ResettaForm13 INP.InserisciInForm13Start BackGrnd.Show Form12.Hide Form27.Hide Fileopen = True For i = 1 To Numcamp1 SimbFilter(i) = 1 Next i GoTo ere1 ere2: MsgBox "An Error Occurred: I'm not able to to open this .ROC file", , "Attenzione!" ere: Clipboard.Clear Fileopen = False BackGrnd.Hide Form12.Hide Form27.Hide Close #1 Close #2 Close #3 GoTo ere1 ere1: Form15.Hide Form7.Hide Clipboard.Clear 'MonXL.activeWorkbook.Close SaveChanges:=False 'MonXL.quit Set MonXL = Nothing End Sub Private Sub opzSalvaGrafico_Click() On Error GoTo error CommonDialog1.DialogTitle = "Salva grafico (.wmf) ..." CommonDialog1.Filter = "*.wmf" aa$ = picforms(Indeks).Caption + ".wmf" CommonDialog1.FileName = "graph_" + Trim(Str(Indeks)) + ".wmf" CommonDialog1.ShowSave file$ = CommonDialog1.FileName If Right(file$, 4) = ".wmf" Then file$ = file$ Else file$ = file$ + ".wmf" End If Indeks = IndexSel Dim obj As Picture Set obj = LoadPicture(App.Path + "\data\g10" + Trim(Indeks) + ".wmf") SavePicture obj, file$ error: End Sub Public Sub opzSavePetrograph_Click() Dim Symbol(5000) As Integer Dim Color(5000) As Integer For i = 1 To Numcamp1 BackGrnd.FG1.col = 1 BackGrnd.FG1.Row = i Symbol(i) = Val(BackGrnd.FG1.Text) BackGrnd.FG1.col = 2 BackGrnd.FG1.Row = i Color(i) = Val(BackGrnd.FG1.Text) BackGrnd.FG1.col = 3 BackGrnd.FG1.Row = i plot1(i) = Val(BackGrnd.FG1.Text) Next i On Error GoTo ere CommonDialog1.DialogTitle = "Save Data(.PEG) ..." CommonDialog1.Filter = "*.PEG" CommonDialog1.FileName = Nomegruppo + ".PEG" CommonDialog1.ShowSave file$ = CommonDialog1.FileName If Right(file$, 4) = ".PEG" Then file$ = file$ Else file$ = file$ + ".PEG" End If On Error GoTo ere1 Open file$ For Output As #1 Write #1, Numelem, Numcamp1, NumL; Write #1, Write #1, "SAMPLE", "SYMBOL", "COLOR"; For i = 1 To Numelem Write #1, Elementi(i); Next i Write #1, For i = 1 To Numcamp1 aa$ = NomeCamp(i) bb = Symbol(i) cc = Color(i) dd = plot1(i) Write #1, aa$, bb, cc, dd; For ii = 1 To Numelem Write #1, DatiOrigine(i, ii); Next ii Write #1, Next i For i = 1 To NumL Write #1, SerieL(i), ColS(i), TipoS(i) Next i Close #1 GoTo ere ere1: MsgBox "An Error Occurred", , "Error" ere: End Sub Private Sub opzSaveproj_Click() 'prima salvo i dati e la legenda Dim Symbol(5000) As Integer Dim Color(5000) As Integer For i = 1 To Numcamp1 BackGrnd.FG1.col = 1 BackGrnd.FG1.Row = i Symbol(i) = Val(BackGrnd.FG1.Text) BackGrnd.FG1.col = 2 BackGrnd.FG1.Row = i Color(i) = Val(BackGrnd.FG1.Text) Next i On Error GoTo ere1 CommonDialog1.DialogTitle = "Save Data(.PRJ) ..." CommonDialog1.Filter = "*.PRJ" CommonDialog1.FileName = Nomegruppo + ".PRJ" CommonDialog1.ShowSave file$ = CommonDialog1.FileName If Right(file$, 4) = ".PRJ" Then file$ = file$ Else file$ = file$ + ".PRJ" End If On Error GoTo ere Open file$ For Output As #1 Write #1, Numelem, Numcamp1, NumL; Write #1, Write #1, "SAMPLE", "SYMBOL", "COLOR"; For i = 1 To Numelem Write #1, Elementi(i); Next i Write #1, For i = 1 To Numcamp1 aa$ = NomeCamp(i) bb = Symbol(i) cc = Color(i) Write #1, aa$, bb, cc; For ii = 1 To Numelem Write #1, DatiOrigine(i, ii); Next ii Write #1, Next i For i = 1 To NumL Write #1, SerieL(i) Next i Write #1, NumElem0 'poi i dati relativi ad ogni finestra Write #1, Maxindeks For cv = 1 To Maxindeks If ActiveGraph(cv) = True Then Write #1, 1 Else Write #1, 0 End If Next cv For cv = 1 To Maxindeks If ActiveGraph(cv) = True Then Print #1, tipoGraph(cv) 'dati della finestra Write #1, cv If binary(cv) = True Then Write #1, 1 Else Write #1, 0 End If If SPIDERREE(cv) = True Then Write #1, 1 Else Write #1, 0 End If If SPIDEROTHER(cv) = True Then Write #1, 1 Else Write #1, 0 End If If Triangular(cv) = True Then Write #1, 1 Else Write #1, 0 End If Write #1, DiagramType(cv) Write #1, GraphDimX(cv) Write #1, GraphDimY(cv) Write #1, Xgraph(cv) Write #1, Ygraph(cv) Write #1, Tp1(cv) Write #1, SimbDim(cv) Write #1, SimbSp(cv) Write #1, LineSp(cv) Write #1, AXX(cv) Write #1, AXY(cv) Write #1, AxAa(cv) Write #1, AXB(cv) Write #1, AXC(cv) Write #1, MaxX(cv) Write #1, MinX(cv) Write #1, MaxY(cv) Write #1, MinY(cv) Write #1, deltax1(cv) Write #1, deltay1(cv) Write #1, NumCamp(cv) For i = 1 To NumCamp(cv) Write #1, xx(i, cv) Write #1, yy(i, cv) Write #1, XXReal(i, cv) Write #1, YYReal(i, cv) Write #1, Campione(i, cv) Next i 'dati spider '----------------------- For i = 1 To Numcamp1 For ii = 1 To 15 Write #1, Spiy(cv, ii, i) Next ii Next i Print #1, NormSP(cv) Print #1, SpiPlotted(cv) Print #1, NumCampSpi(cv) Print #1, NumCampSpi(cv) Print #1, NormSP(cv) Print #1, SpiPlotted(cv) '----------------------- Close #2 'dati dei modelli Write #1, ModAsseX(cv) Write #1, ModAssey(cv) Write #1, NumModelli(cv) For cvi = 1 To NumModelli(cv) Open App.Path + "\data\" + Trim(cv) + "modelExplain" + Trim(cvi) + ".txt" For Input As #2 Line Input #2, mmod '"AFC" Print #1, mmod Line Input #2, R 'R Print #1, R Line Input #2, C01 'C0 Print #1, co1 Line Input #2, CA 'CA Print #1, CA Line Input #2, C1 'C1 Print #1, C1 Line Input #2, C2 'C2 Print #1, C2 Line Input #2, NumModelElem4$ Print #1, Val(NumModelElem4$) aaw = Val(NumModelElem4$) For i = 1 To aaw Input #2, ModElementi(i) Print #1, ModElementi(i) Next i Write #1, aaw For i = 1 To aaw Input #2, ModD(i) Print #1, ModD(i) Next i Close #2 Open App.Path + "\data\" + Trim(cv) + "modello" + Trim(cvi) + ".txt" For Input As #2 Input #2, NumModelElem1, NumModDati, ModelLineSp, ModelLineCol, ModelSymb, ModelSymbSp, ModelSymbCol, ModelSymbWid Print #1, NumModelElem1 Print #1, NumModDati Print #1, ModelLineSp Print #1, ModelLineCol Print #1, ModelSymb Print #1, ModelSymbSp Print #1, ModelSymbCol Print #1, ModelSymbWid For ii = 1 To NumModelElem1 Input #2, qiope Write #1, qiope Next ii For i = 1 To NumModDati For ii = 1 To NumModelElem1 Input #2, qiope Write #1, qiope Next ii Next i Close #2 Next cvi End If Next cv Close #1 GoTo ere1 ere: MsgBox "An error occurred", , "Error" ere1: End Sub Private Sub opzSiO2FM_Click() DiagramType1 = "Myas" Form14.Text1.Text = 500 Form14.Text2.Text = 350 Form14.Show Form14.SetFocus End Sub Private Sub opzSpidermodels_Click() Form28.Combo6.Text = "Select Model" Form28.Picture1(21).BackColor = QBColor(12) Form28.Picture1(39).BackColor = QBColor(12) ModelSymbCol = QBColor(12) ModelLineCol = QBColor(12) 'simboli e linee For i = 0 To 8 Form28.Picture1(i).Scale (1, 9)-(9, 1) Next i Form28.Picture1(41).Scale (1, 9)-(9, 1) Form28.Picture1(41).FillColor = QBColor(0) Form28.Picture1(41).FillStyle = 0 Form28.Picture1(41).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B ModelSymb = 1 'picture(0) Form28.Picture1(0).FillColor = QBColor(0) Form28.Picture1(0).FillStyle = 0 Form28.Picture1(0).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B 'picture(1) Form28.Picture1(1).FillColor = QBColor(0) Form28.Picture1(1).FillStyle = 1 Form28.Picture1(1).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0), B 'picture(2) Form28.Picture1(2).FillColor = QBColor(0) Form28.Picture1(2).FillStyle = 0 Form28.Picture1(2).Circle (5, 5), 2, QBColor(0) 'picture(3) Form28.Picture1(3).FillColor = QBColor(0) Form28.Picture1(3).FillStyle = 1 Form28.Picture1(3).Circle (5, 5), 2, QBColor(0) 'picture(4) Form28.Picture1(4).FillStyle = 1 Form28.Picture1(4).Line (5 - 2, 5 - 2)-(5, 5 + 2), QBColor(0) Form28.Picture1(4).Line (5 - 2, 5 - 2)-(5 + 2, 5 - 2), QBColor(0) Form28.Picture1(4).Line (5 + 2, 5 - 2)-(5, 5 + 2), QBColor(0) 'picture(5) Form28.Picture1(5).FillStyle = 1 Form28.Picture1(5).Line (5 - 2, 5 + 2)-(5, 5 - 2), QBColor(0) Form28.Picture1(5).Line (5 - 2, 5 + 2)-(5 + 2, 5 + 2), QBColor(0) Form28.Picture1(5).Line (5 + 2, 5 + 2)-(5, 5 - 2), QBColor(0) 'picture(6) Form28.Picture1(6).FillStyle = 1 Form28.Picture1(6).Line (5 - 2, 5)-(5 + 2, 5), QBColor(0) Form28.Picture1(6).Line (5, 5 - 2)-(5, 5 + 2), QBColor(0) Form28.Picture1(6).Line (5 - 2, 5 - 2)-(5 + 2, 5 + 2), QBColor(0) Form28.Picture1(6).Line (5 + 2, 5 - 2)-(5 - 2, 5 + 2), QBColor(0) 'picture(7) Form28.Picture1(7).FillStyle = 1 Form28.Picture1(7).Line (5 - 2, 5)-(5 + 2, 5), QBColor(0) Form28.Picture1(7).Line (5, 5 - 2)-(5, 5 + 2), QBColor(0) 'picture(8) Form28.Picture1(8).FillStyle = 1 Form28.Picture1(8).Line (5 - 2, 5)-(5, 5 + 4), QBColor(0) Form28.Picture1(8).Line (5, 5 + 4)-(5 + 2, 5), QBColor(0) Form28.Picture1(8).Line (5 + 2, 5)-(5, 5 - 4), QBColor(0) Form28.Picture1(8).Line (5, 5 - 4)-(5 - 2, 5), QBColor(0) '----------------------------- For i = 0 To 29 Form28.Label1(i).Visible = False Form28.Text1(i).Visible = False Next i Form28.Frame2.Visible = False Form28.Frame1.Visible = False Form28.Frame6.Visible = False Form28.frame7.Visible = False 'REE If SPIDERREE(Indeks) = True Then For i = 1 To 15 If REE1(i) = True Then Form28.Label1(i) = "D for " + REE(i) Form28.Label1(i).Visible = True Form28.Text1(i).Visible = True REESelect(i - 1) = True End If If REE1(i) = False Then Form28.Label1(i).Visible = False Form28.Text1(i).Visible = False End If Next i End If Form28.Show End Sub Private Sub opzTable_Click() If Fileopen = False Then 'MsgBox "Non è possibile eseguire questa operazione se prima non si apre un file di dati" Exit Sub End If BackGrnd.Show BackGrnd.SetFocus End Sub Private Sub opzTASLeBas_Click() DiagramType1 = "LeBas" Form14.Text1.Text = 500 Form14.Text2.Text = 350 Form14.Show Form14.SetFocus End Sub Private Sub opzTaYb_Click() DiagramType1 = "TaYb" Form1.Show Form1.SetFocus End Sub Private Sub opzTaYbThYb_Click() DiagramType1 = "TaYbThYb" Form1.Show Form1.SetFocus End Sub Private Sub opzThHfTa_Click() DiagramType1 = "ThHfTa" Form1.Show Form1.SetFocus End Sub Private Sub opzTiZrBin_Click() DiagramType1 = "TiZrPearce" Form14.Text1.Text = 500 Form14.Text2.Text = 350 Form14.Show Form14.SetFocus End Sub Private Sub opzTiZrSr_Click() DiagramType1 = "TiZrSr" Form1.Show Form1.SetFocus End Sub Private Sub opzTiZrY_Click() DiagramType1 = "TiZrY" Form1.Show Form1.SetFocus End Sub Private Sub opzTriangularPlot_Click() If Fileopen = False Then MsgBox "An Error Occurred: open an input file first", , "Error" Exit Sub End If Form3.Combo1.Clear Form3.Combo2.Clear Form3.Combo3.Clear For i = 1 To Numelem Form3.Combo1.AddItem Elementi(i) Form3.Combo2.AddItem Elementi(i) Form3.Combo3.AddItem Elementi(i) Next i Form3.Show Form3.SetFocus End Sub Private Sub opzTutti_Click() Indeks = GraphSelect If NumModelli(Indeks) = 0 Then GoTo yyy End If binary(Indeks) = True SPIDERREE(Indeks) = False SPIDEROTHER(Indeks) = False Triangular(Indeks) = False picforms(Indeks).Picture1.Cls picforms(Indeks).Picture2.Cls NumModelli(Indeks) = 0 If tipoGraph(Indeks) = "normx-normy" Then MF1.DisegnaNormXNormY End If If tipoGraph(Indeks) = "normx-logy" Then MF1.DisegnaNormXLogY End If If tipoGraph(Indeks) = "logx-normy" Then MF1.DisegnaLogXNormY End If If tipoGraph(Indeks) = "logx-logy" Then MF1.DisegnaLogXLogY End If yyy: End Sub Private Sub opzultimo_Click() Indeks = GraphSelect If NumModelli(Indeks) = 0 Then GoTo yyy End If binary(Indeks) = True SPIDERREE(Indeks) = False SPIDEROTHER(Indeks) = False Triangular(Indeks) = False picforms(Indeks).Picture1.Cls picforms(Indeks).Picture2.Cls NumModelli(Indeks) = NumModelli(Indeks) - 1 If tipoGraph(Indeks) = "normx-normy" Then MF1.DisegnaNormXNormY End If If tipoGraph(Indeks) = "normx-logy" Then MF1.DisegnaNormXLogY End If If tipoGraph(Indeks) = "logx-normy" Then MF1.DisegnaLogXNormY End If If tipoGraph(Indeks) = "logx-logy" Then MF1.DisegnaLogXLogY End If yyy: End Sub Private Sub ozSplash_Click() frmAbout.Show End Sub Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) If Button.Index = 2 Then MDIForm1.PopupMenu MDIForm1.opz1ope End If If Button.Index = 4 Then MDIForm1.PopupMenu MDIForm1.opzImport End If If Button.Index = 6 Then MDIForm1.PopupMenu MDIForm1.opz1Sav End If If Button.Index = 8 Then opz_binaryPlot_Click End If If Button.Index = 10 Then opzTriangularPlot_Click End If If Button.Index = 12 Then MDIForm1.PopupMenu MDIForm1.opzpider End If If Button.Index = 14 Then MDIForm1.PopupMenu MDIForm1.mnuDiagram End If If Button.Index = 16 Then opzMassBalance_Click End If If Button.Index = 18 Then opzLeg_Click End If If Button.Index = 20 Then opzTable_Click End If If Button.Index = 22 Then opzElabInput_Click End If If Button.Index = 24 Then opzArrange_Click End If If Button.Index = 26 Then ozSplash_Click End If End Sub