VERSION 1.0 CLASS BEGIN MultiUse = -1 'True Persistable = 0 'NotPersistable DataBindingBehavior = 0 'vbNone DataSourceBehavior = 0 'vbNone MTSTransactionMode = 0 'NotAnMTSObject END Attribute VB_Name = "ElabDati" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Public Sub InserisciTabella(num As Integer) aaw = BackGrnd.FG1.ColS + 1 BackGrnd.FG1.ColS = aaw BackGrnd.FG1.col = aaw - 1 BackGrnd.FG1.ColWidth(aaw - 1) = 1500 BackGrnd.FG1.Row = 0 BackGrnd.FG1.Text = Elementi(num) For i = 1 To Numcamp1 BackGrnd.FG1.Row = i If DatiOrigine(i, num) = -12345.67 Then BackGrnd.FG1.Text = "-" Else BackGrnd.FG1.Text = Val(Format$(DatiOrigine(i, num), "0.00000")) End If Next i End Sub Public Sub IndividuaREEgiusti() 'individuo La nLa = -1 For ii = 1 To NumElem1 If Elementi(ii) = "La" Then nLa = ii End If Next ii If nLa = -1 Then GoTo poi 'individuo Ce nCe = -1 For ii = 1 To NumElem1 If Elementi(ii) = "Ce" Then nCe = ii End If Next ii If nCe = -1 Then GoTo poi 'individuo Sm nSm = -1 For ii = 1 To NumElem1 If Elementi(ii) = "Sm" Then nSm = ii End If Next ii If nSm = -1 Then GoTo poi 'individuo Eu nEu = -1 For ii = 1 To NumElem1 If Elementi(ii) = "Eu" Then nEu = ii End If Next ii If nEu = -1 Then GoTo poi 'individuo Tb nTb = -1 For ii = 1 To NumElem1 If Elementi(ii) = "Tb" Then nTb = ii End If Next ii If nTb = -1 Then GoTo poi 'individuo Yb nYb = -1 For ii = 1 To NumElem1 If Elementi(ii) = "Yb" Then nYb = ii End If Next ii If nYb = -1 Then GoTo poi Dim RRW$(5000) mm1 = 0 For i = 1 To Numcamp1 If DatiOrigine(i, nEu) > 0 Then mm1 = mm1 + 1 RRW$(mm1) = NomeCamp(i) End If Next i For i = 1 To mm1 Form8.Combo1.AddItem RRW$(i) Next i Form8.Show poi: End Sub Public Sub PartitionCoeff(EL) On Error GoTo fin aaa$ = EL Close #1 Open App.Path + "\data\PC\" + aaa$ + ".txt" For Input As #1 k = 0 While Not EOF(1) Line Input #1, vvv$ LUNG = Len(vvv$) k = k + 1 tt = 1 ind = 1 For i = 1 To LUNG car = Mid(vvv$, i, 1) If car = Chr$(9) Then If ind = 1 Then RcPC(k) = Mid(vvv$, tt, i - tt) 'Combo2.AddItem RcPC(k) tt = i ind = ind + 1 GoTo ttt End If If ind = 2 Then MinerPC(k) = Mid(vvv$, tt + 1, i - tt - 1) 'Combo3.AddItem MinerPC(k) tt = i + 1 ind = ind + 1 GoTo ttt End If If ind = 3 Then If tt = i Then rr = "" GoTo ere1 End If rr = Mid(vvv$, tt + 1, i - tt - 1) ere1: ValuePC(k) = Val(rr) 'Combo4.AddItem ValuePC(k) tt = i + 1 ind = ind + 1 GoTo ttt End If If ind = 4 Then If tt = i Then rr = "" GoTo ere2 End If rr = Mid(vvv$, tt + 1, i - tt - 1) ere2: ValueMinPC(k) = Val(rr) 'Combo5.AddItem ValueMinPC(k) tt = i + 1 ind = ind + 1 GoTo ttt End If If ind = 5 Then If tt = i Then rr = "" GoTo ere3 End If rr = Mid(vvv$, tt + 1, i - tt - 1) ere3: ValueMaxPC(k) = Val(rr) 'Combo6.AddItem ValueMaxPC(k) tt = i + 1 ind = ind + 1 End If ReferencePC(k) = Mid(vvv$, tt, LUNG - tt + 1) 'Combo7.AddItem ReferencePC(k) tt = i + 1 ind = ind + 1 End If ttt: Next i Wend Close #1 NumPC = k Form25.Grid1.Rows = NumPC + 1 For i = 1 To NumPC Form25.Grid1.Row = i Form25.Grid1.col = 0 Form25.Grid1.Text = ReferencePC(i) Form25.Grid1.col = 1 Form25.Grid1.Text = RcPC(i) Form25.Grid1.col = 2 Form25.Grid1.Text = MinerPC(i) Form25.Grid1.col = 3 Form25.Grid1.Text = ValuePC(i) Form25.Grid1.col = 4 Form25.Grid1.Text = ValueMinPC(i) Form25.Grid1.col = 5 Form25.Grid1.Text = ValueMaxPC(i) Next i Form25.Show Form25.SetFocus fin: End Sub Public Sub InserisciInForm13(id As Integer) On Error GoTo rety Form13.Command1(id - 1).Caption = Elementi(id) Form13.Command1(id - 1).Enabled = True If FinOpen = 2 Then Form3.Hide End If If FinOpen = 3 Then Form2.Hide End If GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub InserisciInForm13Start() On Error GoTo rety For i = 1 To Numelem Form13.Command1(i - 1).Caption = Elementi(i) Form13.Command1(i - 1).Enabled = True Next i GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub ResettaForm13() On Error GoTo rety For i = 1 To 100 Form13.Command1(i - 1).Caption = "..." Form13.Command1(i - 1).Enabled = False Next i GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub MostraForm13(left As Integer, top As Integer) On Error GoTo rety www: If left + Form13.Width > MDIForm1.Width Then left = left - 20 GoTo www End If If top + Form13.Height > MDIForm1.Height Then top = top - 20 GoTo www End If Form13.left = left Form13.top = top Form13.Show GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub form13_Selezione(id) On Error GoTo rety id = id + 1 'filtering If FormSelezionato = "FILTERING" Then Form34.Combo1.Text = Elementi(id) End If 'form2 If FormSelezionato = "BinaryPlot1" Then Form2.Combo1.Text = Elementi(id) Form2.Combo1.SetFocus End If If FormSelezionato = "BinaryPlot2" Then Form2.Combo2.Text = Elementi(id) Form2.Combo1.SetFocus End If 'form3 If FormSelezionato = "TriangularPlot1" Then Form3.Combo1.Text = Elementi(id) Form3.Combo1.SetFocus End If If FormSelezionato = "TriangularPlot2" Then Form3.Combo2.Text = Elementi(id) Form3.Combo2.SetFocus End If If FormSelezionato = "TriangularPlot3" Then Form3.Combo3.Text = Elementi(id) Form3.Combo3.SetFocus End If 'form6 If FormSelezionato = "Elabora1" Then Form6.Combo1.Text = Elementi(id) Form6.Combo1.SetFocus End If If FormSelezionato = "Elabora2" Then Form6.Combo2.Text = Elementi(id) Form6.Combo2.SetFocus End If 'form26 If FormSelezionato = "form26_X1" Then ww = id 'Form26.Text2 = DatiOrigine(IperbolaC1, ww) End If If FormSelezionato = "form26_Y1" Then ww = id 'Form26.Text4 = DatiOrigine(IperbolaC1, ww) End If If FormSelezionato = "form26_X2" Then ww = id 'Form26.Text7 = DatiOrigine(IperbolaC2, ww) End If If FormSelezionato = "form26_Y2" Then ww = id 'Form26.Text5 = DatiOrigine(IperbolaC2, ww) End If 'Form 4 If FormSelezionato = "form4-1" Then Form4.Combo1.Text = Elementi(id) Form4.Combo1.SetFocus ' DETERMINO MASSIMO MINIMO ETC INP.SalvaABCamp Form4.Combo1.Text, Form4.Combo2.Text INP.Max App.Path + "\data\datiinputx.txt" MAXXX = StatResult INP.Min App.Path + "\data\datiinputx.txt" MinXX = StatResult logMinXX = Int(LOG10(MinXX)) xm = 0 'aggiungo e tolgo un epsilon ai valori massimi e minimi deltaxXX = (MAXXX - MinXX) / 8 '10 10-10-02 If deltaxXX >= 1 Then deltaxXX = Val(Format$(deltaxXX, "0")) MinXX = Val(Format$(MinXX, "0")) - deltaxXX MAXXX = Val(Format$(MAXXX, "0")) + deltaxXX End If If deltaxXX < 1 And deltaxXX >= 0.1 Then deltaxXX = Val(Format$(deltaxXX, "0.0")) MinXX = Val(Format$(MinXX, "0.0")) - deltaxXX MAXXX = Val(Format$(MAXXX, "0.0")) + deltaxXX End If If deltaxXX < 0.1 And deltaxXX >= 0.01 Then deltaxXX = Val(Format$(deltaxXX, "0.00")) MinXX = Val(Format$(MinXX, "0.00")) - deltaxXX MAXXX = Val(Format$(MAXXX, "0.00")) + deltaxXX End If If deltaxXX < 0.01 And deltaxXX >= 0.001 Then deltaxXX = Val(Format$(deltaxXX, "0.000")) MinXX = Val(Format$(MinXX, "0.000")) - deltaxXX MAXXX = Val(Format$(MAXXX, "0.000")) + deltaxXX End If If deltaxXX < 0.001 And deltaxXX >= 0.0001 Then deltaxXX = Val(Format$(deltaxXX, "0.0000")) MinXX = Val(Format$(MinXX, "0.0000")) - deltaxXX MAXXX = Val(Format$(MAXXX, "0.0000")) + deltaxXX End If If deltaxXX < 0.0001 And deltaxXX >= 0.00001 Then deltaxXX = Val(Format$(deltaxXX, "0.00000")) MinXX = Val(Format$(MinXX, "0.00000")) - deltaxXX MAXXX = Val(Format$(MAXXX, "0.00000")) + deltaxXX End If If deltaxXX < 0.00001 And deltaxXX >= 0.000001 Then deltaxXX = Val(Format$(deltaxXX, "0.000000")) MinXX = Val(Format$(MinXX, "0.000000")) - deltaxXX MAXXX = Val(Format$(MAXXX, "0.000000")) + deltaxXX End If If deltaxXX < 0.000001 And deltaxXX >= 0.0000001 Then deltaxXX = Val(Format$(deltaxXX, "0.0000000")) MinXX = Val(Format$(MinXX, "0.0000000")) - deltaxXX MAXXX = Val(Format$(MAXXX, "0.0000000")) + deltaxXX End If If deltaxXX < 0.0000001 And deltaxXX >= 0.00000001 Then deltaxXX = Val(Format$(deltaxXX, "0.00000000")) MinXX = Val(Format$(MinXX, "0.00000000")) - deltaxXX MAXXX = Val(Format$(MAXXX, "0.00000000")) + deltaxXX End If If MAXXX = MinXX Then MAXXX = MAXXX + 1 MinXX = MinXX - 1 End If Form4.Text1.Text = MAXXX If MAXXX > 1 Then Form4.Text8.Text = Int(LOG10(MAXXX)) + 1 Else Form4.Text8.Text = Int(LOG10(MAXXX)) + 2 End If Form4.Text2.Text = MinXX Form4.Text2.Text = MinXX If MinXX <= 0 Then Form4.Text7.Text = logMinXX GoTo toto1 End If If MinXX > 1 Then Form4.Text7.Text = Int(LOG10(MinXX)) ' - 1 '11/06/02 Else Form4.Text7.Text = Int(LOG10(MinXX)) - 1 '11/06/02 End If toto1: Form4.Text3.Text = deltaxXX End If If FormSelezionato = "form4-2" Then Form4.Combo2.Text = Elementi(id) Form4.Combo2.SetFocus '----------------------------------------- ' DETERMINO MASSIMO MINIMO ETC INP.SalvaABCamp Form4.Combo1.Text, Form4.Combo2.Text INP.Max App.Path + "\data\datiinputy.txt" maxyx = StatResult INP.Min App.Path + "\data\datiinputy.txt" minYx = StatResult logMinyX = Int(LOG10(minYx)) ym = 0 'aggiungo e tolgo un epsilon ai valori massimi e minimi deltaxYX = (maxyx - minYx) / 8 '10 10-10-02 If deltaxYX >= 1 Then deltaxYX = Val(Format$(deltaxYX, "0")) minYx = Val(Format$(minYx, "0")) - deltaxYX maxyx = Val(Format$(maxyx, "0")) + deltaxYX End If If deltaxYX < 1 And deltaxYX >= 0.1 Then deltaxYX = Val(Format$(deltaxYX, "0.0")) minYx = Val(Format$(minYx, "0.0")) - deltaxYX maxyx = Val(Format$(maxyx, "0.0")) + deltaxYX End If If deltaxYX < 0.1 And deltaxYX >= 0.01 Then deltaxYX = Val(Format$(deltaxYX, "0.00")) minYx = Val(Format$(minYx, "0.00")) - deltaxYX maxyx = Val(Format$(maxyx, "0.00")) + deltaxYX End If If deltaxYX < 0.01 And deltaxYX >= 0.001 Then deltaxYX = Val(Format$(deltaxYX, "0.000")) minYx = Val(Format$(minYx, "0.000")) - deltaxYX maxyx = Val(Format$(maxyx, "0.000")) + deltaxYX End If If deltaxYX < 0.001 And deltaxYX >= 0.0001 Then deltaxYX = Val(Format$(deltaxYX, "0.0000")) minYx = Val(Format$(minYx, "0.0000")) - deltaxYX maxyx = Val(Format$(maxyx, "0.0000")) + deltaxYX End If If deltaxYX < 0.0001 And deltaxYX >= 0.00001 Then deltaxYX = Val(Format$(deltaxYX, "0.00000")) minYx = Val(Format$(minYx, "0.00000")) - deltaxYX maxyx = Val(Format$(maxyx, "0.00000")) + deltaxYX End If If deltaxYX < 0.00001 And deltaxYX >= 0.000001 Then deltaxYX = Val(Format$(deltaxYX, "0.000000")) minYx = Val(Format$(minYx, "0.000000")) - deltaxYX maxyx = Val(Format$(maxyx, "0.000000")) + deltaxYX End If If deltaxYX < 0.000001 And deltaxYX >= 0.0000001 Then deltaxYX = Val(Format$(deltaxYX, "0.0000000")) minYx = Val(Format$(minYx, "0.0000000")) - deltaxYX maxyx = Val(Format$(maxyx, "0.0000000")) + deltaxYX End If If deltaxYX < 0.0000001 And deltaxYX >= 0.00000001 Then deltaxYX = Val(Format$(deltaxYX, "0.00000000")) minYx = Val(Format$(minYx, "0.00000000")) - deltaxYX maxyx = Val(Format$(maxyx, "0.00000000")) + deltaxYX End If If maxyx = minYx Then maxyx = maxyx + 1 minYx = minYx - 1 End If Form4.Text4.Text = maxyx If maxyy > 1 Then Form4.Text10.Text = Int(LOG10(maxyx)) + 1 Else Form4.Text10.Text = Int(LOG10(maxyx)) + 2 End If Form4.Text5.Text = minYx If minyy <= 0 Then Form4.Text9.Text = "logMinyX" GoTo toto End If If minyy > 1 Then Form4.Text9.Text = Int(LOG10(minYx)) ' - 1 '11/06/02 Else Form4.Text9.Text = Int(LOG10(minYx)) - 1 '11/06/02 End If toto: Form4.Text6.Text = deltaxYX End If Form13.Hide GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub Addizione(a As String, b As String) On Error GoTo rety ErrorElab = False numa = 101 numb = 101 'determino la colonna di A For i = 1 To Numelem If Elementi(i) = a Then numa = i End If Next i 'determino la colonna di B For i = 1 To Numelem If Elementi(i) = b Then numb = i End If Next i If numa = 101 Or numb = 101 Then MsgBox "An Error Occurred: I'm not able to identify the necessary species", , "Error" ErrorElab = True GoTo rerew1 End If Numelem = Numelem + 1 For ii = 1 To Numcamp1 aa = DatiOrigine(ii, numa) bb = DatiOrigine(ii, numb) If aa <= 0 Or bb <= 0 Then DatiOrigine(ii, Numelem) = -12345.67 GoTo dopo1 End If DatiOrigine(ii, Numelem) = aa + bb DatiOrigine(ii, Numelem) = Val(Format$(DatiOrigine(ii, Numelem), "0.0000000000")) dopo1: Next ii Elementi(Numelem) = "(" + a + "+" + b + ")" INP.RegistraOperazione numa, numb, Numelem, "A+B" rerew1: GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub Sottrazione(a As String, b As String) On Error GoTo rety ErrorElab = False numa = 101 numb = 101 'determino la colonna di A For i = 1 To Numelem If Elementi(i) = a Then numa = i End If Next i 'determino la colonna di B For i = 1 To Numelem If Elementi(i) = b Then numb = i End If Next i If numa = 101 Or numb = 101 Then MsgBox "An Error Occurred: I'm not able to identify the necessary species", , "Error" ErrorElab = True GoTo rerew2 End If If numa = 101 Or numb = 101 Then MsgBox "An Error Occurred: I'm not able to identify the necessary species", , "Error" ErrorElab = True GoTo rerew2 End If Numelem = Numelem + 1 For ii = 1 To Numcamp1 aa = DatiOrigine(ii, numa) bb = DatiOrigine(ii, numb) If aa <= 0 Or bb <= 0 Then DatiOrigine(ii, Numelem) = -12345.67 GoTo dopo1 End If DatiOrigine(ii, Numelem) = aa - bb DatiOrigine(ii, Numelem) = Val(Format$(DatiOrigine(ii, Numelem), "0.000000000")) dopo1: Next ii Elementi(Numelem) = "(" + a + "-" + b + ")" INP.RegistraOperazione numa, numb, Numelem, "A-B" rerew2: GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub Feototale() On Error GoTo rety ErrorElab = False numa = 101 numb = 101 'determino la colonna di FeO For i = 1 To Numelem If Elementi(i) = "FeO" Then numa = i End If Next i 'determino la colonna di Fe2O3 For i = 1 To Numelem If Elementi(i) = "Fe2O3" Then numb = i End If Next i If numa = 101 And numb = 101 Then MsgBox "An Error Occurred: I'm not able to identify the necessary species", , "Error" ErrorElab = True GoTo rerew3 End If If numa = 101 Then Numelem = Numelem + 1 For ii = 1 To Numcamp1 bb = DatiOrigine(ii, numb) If aa <= 0 Then aa = 0 End If If bb <= 0 Then bb = 0 End If DatiOrigine(ii, Numelem) = bb DatiOrigine(ii, Numelem) = Val(Format$(DatiOrigine(ii, Numelem), "0.000000000")) Next ii Elementi(Numelem) = "FeOtot" Exit Sub End If If numb = 101 Then Numelem = Numelem + 1 For ii = 1 To Numcamp1 bb = 0.9 * DatiOrigine(ii, numa) If bb <= 0 Then bb = 0 End If DatiOrigine(ii, Numelem) = bb DatiOrigine(ii, Numelem) = Val(Format$(DatiOrigine(ii, Numelem), "0.000000000")) Next ii Elementi(Numelem) = "FeOtot" Exit Sub End If Numelem = Numelem + 1 For ii = 1 To Numcamp1 aa = DatiOrigine(ii, numa) bb = DatiOrigine(ii, numb) If aa <= 0 Then aa = 0 End If If bb <= 0 Then bb = 0 End If DatiOrigine(ii, Numelem) = aa + (bb * 0.9) DatiOrigine(ii, Numelem) = Val(Format$(DatiOrigine(ii, Numelem), "0.000000000")) Next ii Elementi(Numelem) = "FeOtot" rerew3: GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub AggiungiTabella() End Sub Public Sub ASI() 'On Error GoTo rety ErrorElab = False numa = 101 numb = 101 numc = 101 numd = 101 'determino la colonna di Al2O3 For i = 1 To Numelem If Elementi(i) = "Al2O3" Then numa = i End If Next i 'determino la colonna di K2O For i = 1 To Numelem If Elementi(i) = "K2O" Then numb = i End If Next i 'determino la colonna di K2O For i = 1 To Numelem If Elementi(i) = "Na2O" Then numc = i End If Next i 'determino la colonna di CaO For i = 1 To Numelem If Elementi(i) = "CaO" Then numd = i End If Next i If numa = 101 Or numb = 101 Or numc = 101 Or numd = 101 Then MsgBox "An Error Occurred: I'm not able to identify the necessary species", , "Error" ErrorElab = True GoTo rerew4 End If Numelem = Numelem + 1 For ii = 1 To Numcamp1 aa = DatiOrigine(ii, numa) / 101.9612 bb = DatiOrigine(ii, numb) / 94.2034 If aa <= 0 Then aa = 0 End If If bb <= 0 Then bb = 0 End If cc = DatiOrigine(ii, numc) / 61.979 dd = DatiOrigine(ii, numd) / 56.0794 If cc <= 0 Then cc = 0 End If If dd <= 0 Then dd = 0 End If If (bb + cc + dd) = 0 Then MsgBox "Sample " + NomeCamp(ii) + " contains 0 % wt of Ca0, Na20 and K20", , "Error" DatiOrigine(ii, Numelem) = -12345.67 GoTo eret End If DatiOrigine(ii, Numelem) = aa / (bb + cc + dd) DatiOrigine(ii, Numelem) = Val(Format$(DatiOrigine(ii, Numelem), "0.000000000")) eret: Next ii Elementi(Numelem) = "ASI" rerew4: GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub LarsenIndex() On Error GoTo rety ErrorElab = False numa = 101 numb = 101 numc = 101 numd = 101 Nume = 101 'determino la colonna di SiO2 For i = 1 To Numelem If Elementi(i) = "SiO2" Then numa = i End If Next i 'determino la colonna di K2O For i = 1 To Numelem If Elementi(i) = "K2O" Then numb = i End If Next i 'determino la colonna di MgO For i = 1 To Numelem If Elementi(i) = "MgO" Then numc = i End If Next i 'determino la colonna di CaO For i = 1 To Numelem If Elementi(i) = "CaO" Then numd = i End If Next i 'determino la colonna di FeOtot For i = 1 To Numelem If Elementi(i) = "FeOtot" Then Nume = i End If Next i If Nume = 101 Then INP.Feototale If ErrorElab = True Then Nume = Numelem 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) End If End If If numa = 101 Or numb = 101 Or numc = 101 Or numd = 101 Or Nume = 101 Then MsgBox "An Error Occurred: I'm not able to identify the necessary species", , "Error" ErrorElab = True GoTo rerew4 End If Numelem = Numelem + 1 For ii = 1 To Numcamp1 aa = DatiOrigine(ii, numa) bb = DatiOrigine(ii, numb) If aa <= 0 Then aa = 0 End If If bb <= 0 Then bb = 0 End If cc = DatiOrigine(ii, numc) dd = DatiOrigine(ii, numd) If cc <= 0 Then cc = 0 End If If dd <= 0 Then dd = 0 End If ee = DatiOrigine(ii, Nume) If ee <= 0 Then ee = 0 End If DatiOrigine(ii, Numelem) = (aa / 3) + bb - cc - dd - ee DatiOrigine(ii, Numelem) = Val(Format$(DatiOrigine(ii, Numelem), "0.000000000")) Next ii Elementi(Numelem) = "LarsenIndex" rerew4: GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub SolIndex() On Error GoTo rety ErrorElab = False numa = 101 numb = 101 numc = 101 numd = 101 'determino la colonna di MgO For i = 1 To Numelem If Elementi(i) = "MgO" Then numa = i End If Next i 'determino la colonna di Na2O For i = 1 To Numelem If Elementi(i) = "Na2O" Then numb = i End If Next i 'determino la colonna di K2O For i = 1 To Numelem If Elementi(i) = "K2O" Then numc = i End If Next i 'determino la colonna di FeOtot For i = 1 To Numelem If Elementi(i) = "FeOtot" Then numd = i End If Next i If numd = 101 Then INP.Feototale If ErrorElab = True Then Nume = Numelem 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) End If End If If numa = 101 Or numb = 101 Or numc = 101 Or numd = 101 Then MsgBox "An Error Occurred: I'm not able to identify the necessary species", , "Error" ErrorElab = True GoTo rerew13 End If 'controllo che in (Na2O+K2O+FeOtot+MgO) non ci siano valori=0 Numelem = Numelem + 1 For ii = 1 To Numcamp1 If (DatiOrigine(ii, numa) + DatiOrigine(ii, numb) + DatiOrigine(ii, numc) + DatiOrigine(ii, numd)) = 0 Then DatiOrigine(ii, Numelem) = -12345.67 GoTo rerew131 End If DatiOrigine(ii, Numelem) = (DatiOrigine(ii, numa) / (DatiOrigine(ii, numa) + DatiOrigine(ii, numb) + DatiOrigine(ii, numc) + DatiOrigine(ii, numd))) * 100 rerew131: Next ii Elementi(Numelem) = "SolIndex" rerew13: GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub FeMgRatio() On Error GoTo rety ErrorElab = False numa = 101 numb = 101 'determino la colonna di MgO For i = 1 To Numelem If Elementi(i) = "MgO" Then numa = i End If Next i 'determino la colonna di FeOtot For i = 1 To Numelem If Elementi(i) = "FeOtot" Then numb = i End If Next i If numb = 101 Then INP.Feototale If ErrorElab = True Then Nume = Numelem 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) End If End If If numa = 101 Or numb = 101 Then MsgBox "An Error Occurred: I'm not able to identify the necessary species", , "Error" ErrorElab = True GoTo rerew11 End If 'controllo che in Mg non ci siano valori=0 Numelem = Numelem + 1 For ii = 1 To Numcamp1 aa = DatiOrigine(ii, numb) If aa <= 0 Then aa = 0 End If bb = DatiOrigine(ii, numa) If bb <= 0 Then DatiOrigine(ii, Numelem) = -12345.67 GoTo wer1 End If DatiOrigine(ii, Numelem) = aa / bb DatiOrigine(ii, Numelem) = Val(Format$(DatiOrigine(ii, Numelem), "0.000000000")) wer1: Next ii Elementi(Numelem) = "FeO-MgORatio" rerew11: GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub prodotto(a As String, b As String) On Error GoTo rety ErrorElab = False numa = 101 numb = 101 'determino la colonna di A For i = 1 To Numelem If Elementi(i) = a Then numa = i End If Next i 'determino la colonna di B For i = 1 To Numelem If Elementi(i) = b Then numb = i End If Next i If numa = 101 Or numb = 101 Then MsgBox "An Error Occurred: I'm not able to identify the necessary species", , "Error" ErrorElab = True GoTo rerew5 End If Numelem = Numelem + 1 For ii = 1 To Numcamp1 aa = DatiOrigine(ii, numa) bb = DatiOrigine(ii, numb) If aa <= 0 Or bb <= 0 Then DatiOrigine(ii, Numelem) = -12345.67 GoTo dopo1 End If DatiOrigine(ii, Numelem) = aa * bb DatiOrigine(ii, Numelem) = Val(Format$(DatiOrigine(ii, Numelem), "0.00000000000")) dopo1: Next ii Elementi(Numelem) = "(" + a + "*" + b + ")" INP.RegistraOperazione numa, numb, Numelem, "A*B" rerew5: GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub SqrA(a As String) On Error GoTo rety ErrorElab = False numa = 101 'determino la colonna di A For i = 1 To Numelem If Elementi(i) = a Then numa = i End If Next i If numa = 101 Then MsgBox "An Error Occurred: I'm not able to identify the necessary species", , "Error" ErrorElab = True GoTo rerew6 End If Numelem = Numelem + 1 For ii = 1 To Numcamp1 aa = DatiOrigine(ii, numa) If aa <= 0 Then DatiOrigine(ii, Numelem) = -12345.67 GoTo dopo1 End If DatiOrigine(ii, Numelem) = Sqr(aa) DatiOrigine(ii, Numelem) = Val(Format$(DatiOrigine(ii, Numelem), "0.00000000000")) dopo1: Next ii Elementi(Numelem) = "(SQR(" + a + "))" INP.RegistraOperazione numa, 0, Numelem, "SQR(A)" rerew6: GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub AxA(a As String) On Error GoTo rety ErrorElab = False numa = 101 'determino la colonna di A For i = 1 To Numelem If Elementi(i) = a Then numa = i End If Next i If numa = 101 Then MsgBox "An Error Occurred: I'm not able to identify the necessary species", , "Error" ErrorElab = True GoTo rerew7 End If Numelem = Numelem + 1 For ii = 1 To Numcamp1 aa = DatiOrigine(ii, numa) If aa <= 0 Then DatiOrigine(ii, Numelem) = -12345.67 GoTo dopo1 End If DatiOrigine(ii, Numelem) = aa * aa DatiOrigine(ii, Numelem) = Val(Format$(DatiOrigine(ii, Numelem), "0.00000000000")) dopo1: Next ii Elementi(Numelem) = "(" + a + "^2)" INP.RegistraOperazione numa, 0, Numelem, "AXA" rerew7: GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub AxConst(a As String, c As Single) On Error GoTo rety ErrorElab = False numa = 101 'determino la colonna di A For i = 1 To Numelem If Elementi(i) = a Then numa = i End If Next i If numa = 101 Then MsgBox "An Error Occurred: I'm not able to identify the necessary species", , "Error" ErrorElab = True GoTo rerew8 End If Numelem = Numelem + 1 For ii = 1 To Numcamp1 aa = DatiOrigine(ii, numa) If aa <= 0 Then DatiOrigine(ii, Numelem) = -12345.67 GoTo dopo1 End If DatiOrigine(ii, Numelem) = aa * c DatiOrigine(ii, Numelem) = Val(Format$(DatiOrigine(ii, Numelem), "0.0000000000")) dopo1: Next ii Elementi(Numelem) = "(" + Trim(Str(c)) + "*" + a + ")" INP.RegistraOperazione numa, c, Numelem, "A*C" rerew8: GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub AsuConst(a As String, c As Single) On Error GoTo rety ErrorElab = False numa = 101 'determino la colonna di A For i = 1 To Numelem If Elementi(i) = a Then numa = i End If Next i If numa = 101 Then MsgBox "An Error Occurred: I'm not able to identify the necessary species", , "Error" ErrorElab = True GoTo rerew8 End If Numelem = Numelem + 1 For ii = 1 To Numcamp1 aa = DatiOrigine(ii, numa) If aa <= 0 Then DatiOrigine(ii, Numelem) = -12345.67 GoTo dopo1 End If DatiOrigine(ii, Numelem) = aa / c DatiOrigine(ii, Numelem) = Val(Format$(DatiOrigine(ii, Numelem), "0.0000000000")) dopo1: Next ii Elementi(Numelem) = "(" + a + "/" + Trim(Str(c)) + ")" INP.RegistraOperazione numa, c, Numelem, "A/C" rerew8: GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub MgNumber() On Error GoTo rety ErrorElab = False numMg = 101 numFe = 101 'determino la colonna di Mg For i = 1 To Numelem If Elementi(i) = "FeO" Then numFe = i End If If Elementi(i) = "MgO" Then numMg = i End If Next i If numMg = 101 Or numFe = 101 Then MsgBox "An Error Occurred" Exit Sub End If Numelem = Numelem + 1 cFe = 71.8464 cMg = 40.3114 For iii = 1 To Numcamp1 Amg = DatiOrigine(iii, numMg) aFe = DatiOrigine(iii, numFe) If Amg <= 0 Or aFe <= 0 Then DatiOrigine(iii, Numelem) = -12345.67 GoTo poi End If Molmg = Amg / cMg Molfe = aFe / cFe DatiOrigine(iii, Numelem) = 100 * (Molmg / (Molmg + Molfe)) DatiOrigine(iii, Numelem) = Val(Format$(DatiOrigine(iii, Numelem), "0.000")) poi: Next iii Elementi(Numelem) = "Mg-Number" 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) INP.InserisciInForm13 Numelem INP.InserisciTabella Numelem dopo1: rerew8: GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub MgNumber1() 'On Error GoTo rety ErrorElab = False numMg = 101 numFe2 = 101 numFe3 = 101 'determino la colonna di Mg , Fe2 e Fe3 For i = 1 To Numelem If Elementi(i) = "FeO" Then numFe2 = i End If If Elementi(i) = "Fe2O3" Then numFe3 = i End If If Elementi(i) = "MgO" Then numMg = i End If Next i If numMg = 101 Or numFe2 = 101 Or numFe3 = 101 Then MsgBox "An Error Occurred" Exit Sub End If Numelem = Numelem + 1 For iii = 1 To Numcamp1 Amg = DatiOrigine(iii, numMg) aFe2 = DatiOrigine(iii, numFe2) aFe3 = DatiOrigine(iii, numFe3) If Amg <= 0 Or aFe2 <= 0 Or aFe3 <= 0 Then DatiOrigine(iii, Numelem) = -12345.67 GoTo poi End If fetot = aFe2 + (0.9 * aFe3) Fe2 = 0.85 * fetot 'MgAtom = Amg / 40.311 'FeAtom = Fe2 / 71.8464 MgAtom = Amg * 0.6031 / 24.305 FeAtom = Fe2 * 0.77731 / 55.847 DatiOrigine(iii, Numelem) = 100 * (MgAtom / (MgAtom + FeAtom)) 'DatiOrigine(iii, Numelem) = 100 * ((Amg / 40.3114) / ((Amg / 40.3114) + ((aFe2 + (aFe3 * 0.9)) / (1.135 * 71.8464)))) 'DatiOrigine(iii, Numelem) = Val(Format$(DatiOrigine(iii, Numelem), "0.00000000000")) poi: Next iii Elementi(Numelem) = "Mg#" 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) INP.InserisciInForm13 Numelem dopo1: rerew8: GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub molar() 'On Error GoTo rety ErrorElab = False For ii = 1 To Numelem 'determino la colonna di A For i = 1 To Numelem If Elementi(ii) = "SiO2" Then c = 60.08 numa = ii GoTo dopo End If If Elementi(ii) = "TiO2" Then c = 79.9 numa = ii GoTo dopo End If If Elementi(ii) = "Al2O3" Then c = 101.96 numa = ii GoTo dopo End If If Elementi(ii) = "Fe2O3" Then c = 159.69 numa = ii GoTo dopo End If If Elementi(ii) = "FeO" Then c = 71.85 numa = ii GoTo dopo End If If Elementi(ii) = "MnO" Then c = 70.94 numa = ii GoTo dopo End If If Elementi(ii) = "MgO" Then c = 40.31 numa = ii GoTo dopo End If If Elementi(ii) = "CaO" Then c = 56.08 numa = ii GoTo dopo End If If Elementi(ii) = "Na2O" Then c = 61.98 numa = ii GoTo dopo End If If Elementi(ii) = "K2O" Then c = 94.2 numa = ii GoTo dopo End If If Elementi(ii) = "P2O5" Then c = 141.94 numa = ii GoTo dopo End If Next i GoTo dopo1 dopo: Numelem = Numelem + 1 For iii = 1 To Numcamp1 aa = DatiOrigine(iii, numa) If aa <= 0 Then aa = 0 End If DatiOrigine(iii, Numelem) = aa / c DatiOrigine(iii, Numelem) = Val(Format$(DatiOrigine(iii, Numelem), "0.00000000000")) Next iii Elementi(Numelem) = "m" + Elementi(ii) INP.RegistraOperazione numa, c, Numelem, "m" 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) INP.InserisciInForm13 Numelem dopo1: Next ii rerew8: GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub ConvertiPPM(a As String, c As Variant) On Error GoTo rety ErrorElab = False For i = 1 To Numelem If Elementi(i) = c Then c = i GoTo poii End If Next i poii: aa$ = Elementi(c) zx = 0 If aa$ = "Na2O" Then zx = 0.7419 a = "Na" End If If aa$ = "Si2O" Then zx = 0.4674 a = "Si" End If If aa$ = "CaO" Then zx = 0.7147 a = "Ca" End If If aa$ = "MnO" Then zx = 0.7745 a = "Mn" End If If aa$ = "MgO" Then zx = 0.6031 a = "Mg" End If If aa$ = "ZnO" Then zx = 0.8034 a = "Zn" End If If aa$ = "Cr2O3" Then zx = 0.6843 a = "Cr" End If If aa$ = "TiO2" Then zx = 0.5995 a = "Ti" End If If aa$ = "LiO2" Then zx = 0.4645 a = "Li" End If If aa$ = "B2O3" Then zx = 0.3105 a = "B" End If If aa$ = "ZrO2" Then zx = 0.7403 a = "Zr" End If If aa$ = "CuO" Then zx = 0.799 a = "Cu" End If If aa$ = "NiO" Then zx = 0.7858 a = "Ni" End If If aa$ = "BeO" Then zx = 0.3603 a = "Be" End If If aa$ = "V2O5" Then zx = 0.5602 a = "V" End If If aa$ = "K2O" Then zx = 0.8302 a = "K" End If If aa$ = "FeO" Then zx = 0.77731 a = "Fe(2)" End If If aa$ = "Fe2O3" Then zx = 0.69943 a = "Fe(3)" End If If aa$ = "P2O5" Then zx = 0.43642 a = "P" End If If aa$ = "Al2O3" Then zx = 0.52925 a = "Al" End If If aa$ = "FeOtot" Then 'Total iron expressed as Fe2O3 zx = 0.69943 'Attenzione 1-08-02 a = "Fe" End If If zx = 0 Then GoTo rety End If Numelem = Numelem + 1 For ii = 1 To Numcamp1 If DatiOrigine(ii, c) <= 0 Then DatiOrigine(ii, Numelem) = -12345.67 GoTo yyy End If DatiOrigine(ii, Numelem) = zx * DatiOrigine(ii, c) * 10000 DatiOrigine(ii, Numelem) = Val(Format$(DatiOrigine(ii, Numelem), "0.00000000000")) yyy: Next ii Elementi(Numelem) = a INP.InserisciInForm13 Numelem 'NumElem0 = NumElem0 + 1 rerew8: GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub ConvertiPerWt(c) Close #1 Open "c:\converti\ConversioneMon" + c + ".txt" For Output As #1 On Error GoTo rety ErrorElab = False aa$ = c For i = 1 To NumElem1 If Elementi(i) = c Then c1111 = i GoTo poi1 End If Next i poi1: zx = 0 If aa$ = "Na" Then zx = 0.7419 a = "Na2O" End If If aa$ = "Si" Then zx = 0.4674 a = "SiO2" End If If aa$ = "Fe" Then zx = 0.6995 a = "FeO" End If If aa$ = "Ca" Then zx = 0.7147 a = "CaO" End If If aa$ = "Mn" Then zx = 0.7745 a = "MnO" End If If aa$ = "Mg" Then zx = 0.6031 a = "MgO" End If If aa$ = "Zn" Then zx = 0.8034 a = "ZnO" End If If aa$ = "Cr" Then zx = 0.6843 a = "Cr2O3" End If If aa$ = "Ti" Then zx = 0.5995 a = "TiO2" End If If aa$ = "Li" Then zx = 0.4645 a = "Li2O" End If If aa$ = "B" Then zx = 0.3105 a = "B2O3" End If If aa$ = "Zr" Then zx = 0.7403 a = "ZrO2" End If If aa$ = "Cu" Then zx = 0.799 a = "CuO" End If If aa$ = "Ni" Then zx = 0.7858 a = "NiO" End If If aa$ = "Be" Then zx = 0.3603 a = "BeO" End If If aa$ = "V" Then zx = 0.5602 a = "VO2" End If If aa$ = "K" Then zx = 0.8302 a = "K2O" End If 'If aa$ = "Fe" Then 'zx = 0.77731 'End If 'If aa$ = "Fe2O3" Then 'zx = 0.69943 'End If If aa$ = "P" Then zx = 0.43642 a = "P2O5" End If If aa$ = "Al" Then zx = 0.52925 a = "Al2O3" End If If aa$ = "Fe" Then 'Total iron expressed as Fe2O3 zx = 0.69943 'Attenzione 1-08-02 a = "FeO" End If If zx = 0 Then GoTo rety End If Numelem = Numelem + 1 For ii = 1 To Numcamp1 If DatiOrigine(ii, c1111) <= 0 Then DatiOrigine(ii, Numelem) = -12345.67 GoTo yyy End If DatiOrigine(ii, Numelem) = DatiOrigine(ii, c1111) / (zx * 10000) DatiOrigine(ii, Numelem) = Val(Format$(DatiOrigine(ii, Numelem), "0.00000000000")) Write #1, NomeCamp(ii), DatiOrigine(ii, Numelem) yyy: Next ii Elementi(Numelem) = a INP.InserisciInForm13 Numelem 'NumElem0 = NumElem0 + 1 Close #1 rerew8: GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub Divisione(a As String, b As String) On Error GoTo rety ErrorElab = False numa = 101 numb = 101 'determino la colonna di A For i = 1 To Numelem If Elementi(i) = a Then numa = i End If Next i 'determino la colonna di B For i = 1 To Numelem If Elementi(i) = b Then numb = i End If Next i If numa = 101 Or numb = 101 Then MsgBox "An Error Occurred: I'm not able to identify the necessary species", , "Error" ErrorElab = True GoTo rerew8 End If Numelem = Numelem + 1 'Eseguo l'operazione For ii = 1 To Numcamp1 aa = DatiOrigine(ii, numa) bb = DatiOrigine(ii, numb) If aa <= 0 Or bb <= 0 Then DatiOrigine(ii, Numelem) = -12345.67 GoTo dopo1 End If DatiOrigine(ii, Numelem) = aa / DatiOrigine(ii, numb) DatiOrigine(ii, Numelem) = Val(Format$(DatiOrigine(ii, Numelem), "0.00000000000")) dopo1: Next ii Elementi(Numelem) = "(" + a + "/" + b + ")" INP.RegistraOperazione numa, numb, Numelem, "A/B" wewe: rerew8: GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub UnoSuA(a As String) On Error GoTo rety ErrorElab = False numa = 101 'determino la colonna di A For i = 1 To Numelem If Elementi(i) = a Then numa = i End If Next i If numa = 101 Then MsgBox "An Error Occurred: I'm not able to identify the necessary species", , "Error" ErrorElab = True GoTo rerew9 End If 'controllo che in A non ci siano valori=0 Numelem = Numelem + 1 'Eseguo l'operazione For ii = 1 To Numcamp1 aa = DatiOrigine(ii, numa) If aa <= 0 Then DatiOrigine(ii, Numelem) = -12345.67 GoTo dopo1 End If DatiOrigine(ii, Numelem) = 1 / DatiOrigine(ii, numa) DatiOrigine(ii, Numelem) = Val(Format$(DatiOrigine(ii, Numelem), "0.00000000000")) dopo1: Next ii Elementi(Numelem) = "(1/" + a + ")" INP.RegistraOperazione numa, 0, Numelem, "Uno/A" wewe22: rerew9: GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub SalvaABCamp(a As String, b As String) On Error GoTo rety ErrorElab = False numa = 101 numb = 101 'determino la colonna di A For i = 1 To Numelem If Elementi(i) = a Then numa = i End If Next i 'determino la colonna di B For i = 1 To Numelem If Elementi(i) = b Then numb = i End If Next i If numa = 101 Then MsgBox "An Error Occurred: I'm not able to identify the necessary species", , "Error" ErrorElab = True GoTo rerew10 End If Close #1 Close #2 Close #3 Open App.Path + "\data\datiinput.txt" For Output As #1 Open App.Path + "\data\datiinputx.txt" For Output As #2 Open App.Path + "\data\datiinputy.txt" For Output As #3 For ii = 1 To Numcamp1 BackGrnd.FG1.Row = ii BackGrnd.FG1.col = 1 tipo = Val(BackGrnd.FG1) BackGrnd.FG1.Row = ii BackGrnd.FG1.col = 3 tipo1 = Val(BackGrnd.FG1) If tipo = 0 Or tipo1 = 0 Or SimbFilter(ii) = 0 Or DatiOrigine(ii, numa) = -12345.67 Or DatiOrigine(ii, numb) = -12345.67 Then GoTo qqq '16-05 Write #1, DatiOrigine(ii, numa), DatiOrigine(ii, numb), NomeCamp(ii) Write #2, DatiOrigine(ii, numa) Write #3, DatiOrigine(ii, numb) qqq: Next ii Close #1 Close #2 Close #3 rerew10: GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" Close #1 Close #2 Close #3 rety1: End Sub Public Sub Media(file As String) On Error GoTo rety 'il file input deve stare dentro app.path Close #1 Open file For Input As #1 k = 0 tot = 0 Do While Not EOF(1) Input #1, num k = k + 1 tot = tot + num Loop Close #1 StatResult = tot / k GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" Close #1 rety1: End Sub Public Sub Max(file As String) 'On Error GoTo rety 'il file input deve stare dentro app.path Close #1 Open file For Input As #1 Mass = -1E+101 Do While Not EOF(1) Input #1, num If num > Mass Then Mass = num End If Loop Close #1 StatResult = Mass GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" Close #1 rety1: End Sub Public Sub Min(file As String) On Error GoTo rety 'il file input deve stare dentro app.path Close #1 Open file For Input As #1 Minn = 1E+101 Do While Not EOF(1) Input #1, num If num = 0 Then GoTo wer If num < Minn Then Minn = num End If wer: Loop Close #1 StatResult = Minn GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" Close #1 rety1: End Sub Public Sub Var(file As String) On Error GoTo rety 'il file input deve stare dentro app.path INP.Media (file) med = StatResult tot = 0 k = 0 Close #1 Open file For Input As #1 Do While Not EOF(1) Input #1, num k = k + 1 tot = tot + ((num - med) ^ 2) Loop Close #1 StatResult = tot / (k - 1) GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" Close #1 rety1: End Sub Sub stdDev(file As String) On Error GoTo rety INP.Var (file) vari = StatResult StatResult = Sqr(vari) GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Sub RegA(file As String) On Error GoTo rety 'dato il file input.txt del tipo x,y 'calcola il coefficente a dell'equazione Y=aX+b 'prima faccio la media di x e y Close #1 Open file For Input As #1 k = 0 totx = 0 toty = 0 Do While Not EOF(1) Input #1, aa, bb k = k + 1 totx = totx + aa toty = toty + bb Loop Close #1 medx = totx / k medY = toty / k 'calcolo la varianza di x e y totx = 0 toty = 0 k = 0 Close #1 Open file For Input As #1 Do While Not EOF(1) Input #1, aa, bb k = k + 1 totx = totx + ((aa - medx) ^ 2) toty = toty + ((bb - medY) ^ 2) Loop Close #1 VarX = totx / k vary = toty / k 'calcolo la covarianza di x e y totx = 0 toty = 0 k = 0 Close #1 Open file For Input As #1 Do While Not EOF(1) Input #1, aa, bb k = k + 1 tot = tot + ((aa - medx) * (bb - ymed)) Loop Close #1 CovXY = tot / k StatResult = (CovXY / VarX) GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" Close #1 rety1: End Sub Sub RegB(file As String) On Error GoTo rety 'dato il file input.txt del tipo x,y 'calcola il coefficente b dell'equazione Y=aX+b INP.RegA (file) a = StatResult 'prima faccio la media di x e y Close #1 Open file For Input As #1 k = 0 totx = 0 toty = 0 Do While Not EOF(1) Input #1, dd, ff k = k + 1 totx = totx + dd toty = toty + ff Loop Close #1 medx = totx / k medY = toty / k StatResult = medY - (a * medx) GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" Close #1 rety1: End Sub Sub CoeffCorr(file As String) 'dato il file input.txt del tipo x,y 'calcola il coefficente di correlazione On Error GoTo rety 'prima faccio la media di x e y Close #1 Open file For Input As #1 k = 0 totx = 0 toty = 0 Do While Not EOF(1) Input #1, dd, ff k = k + 1 totx = totx + dd toty = toty + ff Loop Close #1 medx = totx / k medY = toty / k 'calcolo la varianza di x e y totx = 0 toty = 0 k = 0 Close #1 Open file For Input As #1 Do While Not EOF(1) Input #1, dd, ff k = k + 1 totx = totx + ((dd - medx) ^ 2) toty = toty + ((ff - medY) ^ 2) Loop Close #1 VarX = totx / k vary = toty / k 'calcolo la covarianza di x e y totx = 0 toty = 0 k = 0 Close #1 Open file For Input As #1 Do While Not EOF(1) Input #1, dd, ff k = k + 1 tot = tot + ((dd - medx) * (ff - ymed)) Loop Close #1 CovXY = tot / k StatResult = (CovXY / (Sqr(VarX * vary))) GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" Close #1 rety1: End Sub Public Sub ModAddizione(a As Variant, b As Variant) On Error GoTo rety NumModelElem = NumModelElem + 1 For i = 1 To NumModelElem If ModElementi(i) = Elementi(a) Then a = i GoTo poi1: End If Next i poi1: For i = 1 To NumModelElem If ModElementi(i) = Elementi(b) Then b = i GoTo poi2: End If Next i poi2: For ii = 1 To NumModDati DatiModello(ii, NumModelElem) = DatiModello(ii, a) + DatiModello(ii, b) Next ii ModElementi(NumModelElem) = "(" + ModElementi(a) + "+" + ModElementi(b) + ")" GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub ModSottrazione(a As Variant, b As Variant) On Error GoTo rety NumModelElem = NumModelElem + 1 For i = 1 To NumModelElem If ModElementi(i) = Elementi(a) Then a = i GoTo poi1: End If Next i poi1: For i = 1 To NumModelElem If ModElementi(i) = Elementi(b) Then b = i GoTo poi2: End If Next i poi2: For ii = 1 To NumModDati DatiModello(ii, NumModelElem) = DatiModello(ii, a) - DatiModello(ii, b) Next ii ModElementi(NumModelElem) = "(" + ModElementi(a) + "-" + ModElementi(b) + ")" GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub ModProdotto(a As Variant, b As Variant) On Error GoTo rety NumModelElem = NumModelElem + 1 For i = 1 To NumModelElem If ModElementi(i) = Elementi(a) Then a = i GoTo poi1: End If Next i poi1: For i = 1 To NumModelElem If ModElementi(i) = Elementi(b) Then b = i GoTo poi2: End If Next i poi2: For ii = 1 To NumModDati DatiModello(ii, NumModelElem) = DatiModello(ii, a) * DatiModello(ii, b) Next ii ModElementi(NumModelElem) = "(" + ModElementi(a) + "*" + ModElementi(b) + ")" GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub ModAxConst(a As Variant, b As Variant) 'On Error GoTo rety NumModelElem = NumModelElem + 1 For i = 1 To NumModelElem If ModElementi(i) = Elementi(a) Then a = i GoTo poi1: End If Next i poi1: For ii = 1 To NumModDati DatiModello(ii, NumModelElem) = DatiModello(ii, a) * b Next ii ModElementi(NumModelElem) = "(" + Trim(Str(b)) + "*" + Trim(ModElementi(a)) + ")" GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub ModASuConst(a As Variant, b As Variant) On Error GoTo rety NumModelElem = NumModelElem + 1 For i = 1 To NumModelElem If ModElementi(i) = Elementi(a) Then a = i GoTo poi1: End If Next i poi1: For ii = 1 To NumModDati DatiModello(ii, NumModelElem) = DatiModello(ii, a) / b Next ii ModElementi(NumModelElem) = "(" + ModElementi(a) + "/" + Trim(Str(b)) + ")" GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub ModAxA(a As Variant) On Error GoTo rety NumModelElem = NumModelElem + 1 For i = 1 To NumModelElem If ModElementi(i) = Elementi(a) Then a = i GoTo poi1: End If Next i poi1: For ii = 1 To NumModDati DatiModello(ii, NumModelElem) = DatiModello(ii, a) * DatiModello(ii, a) Next ii ModElementi(NumModelElem) = "(" + ModElementi(a) + "^2)" GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub ModDivisione(a As Variant, b As Variant) On Error GoTo rety 'controllo che in B non ci siano valori=0 For i = 1 To NumModelElem If ModElementi(i) = Elementi(a) Then a = i GoTo poi1: End If Next i poi1: For i = 1 To NumModelElem If ModElementi(i) = Elementi(b) Then b = i GoTo poi2 End If Next i poi2: For ii = 1 To NumModDati If DatiModello(ii, b) = 0 Then MsgBox "An Error Occurred: division by Zero" GoTo wewe End If Next ii 'Eseguo l'operzione NumModelElem = NumModelElem + 1 For ii = 1 To NumModDati DatiModello(ii, NumModelElem) = DatiModello(ii, a) / DatiModello(ii, b) Next ii ModElementi(NumModelElem) = "(" + ModElementi(a) + "/" + ModElementi(b) + ")" wewe: GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub ModUnoSuA(a As Variant) 'On Error GoTo rety 'controllo che in B non ci siano valori=0 For i = 1 To NumModelElem If ModElementi(i) = Elementi(a) Then a = i GoTo poi1: End If Next i poi1: 'Eseguo l'operzione NumModelElem = NumModelElem + 1 For ii = 1 To NumModDati aa = DatiModello(ii, a) If aa <= 0 Then DatiOrigine(ii, Numelem) = -12345.67 GoTo wer5 End If DatiModello(ii, NumModelElem) = 1 / aa wer5: Next ii ModElementi(NumModelElem) = "(1/" + ModElementi(a) + ")" wewe: GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub ModSQRA(a As Variant) On Error GoTo rety 'Eseguo l'operzione NumModelElem = NumModelElem + 1 For i = 1 To NumModelElem If ModElementi(i) = Elementi(a) Then a = i GoTo poi1: End If Next i poi1: For i = 1 To NumModelElem If ModElementi(i) = Elementi(b) Then b = i End If Next i For ii = 1 To NumModDati bb = DatiModello(ii, a) If bb <= 0 Then DatiOrigine(ii, Numelem) = -12345.67 GoTo wer4 End If DatiModello(ii, NumModelElem) = Sqr(bb) wer4: Next ii ModElementi(NumModelElem) = "(SQR(" + ModElementi(a) + "))" wewe: GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub ModOperazione(a As Variant, b As Variant, c As String) On Error GoTo rety If c = "A+B" Then INP.ModAddizione a, b End If If c = "A-B" Then INP.ModSottrazione a, b End If If c = "A*B" Then INP.ModProdotto a, b End If If c = "A/B" Then INP.ModDivisione a, b End If If c = "A*C" Then INP.ModAxConst a, b End If If c = "A/C" Then INP.ModASuConst a, b End If If c = "Uno/A" Then INP.ModUnoSuA a End If If c = "AXA" Then INP.ModAxA a End If If c = "SQR(A)" Then INP.ModSQRA a End If GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub MaxMinREE() On Error GoTo rety MinREE = 1E+38 MaxREE = 0 For i = 1 To 15 If valREEn(i) > MaxREE Then MaxREE = valREEn(i) End If If valREEn(i) < MinREE Then MinREE = valREEn(i) End If Next i GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" rety1: End Sub Public Sub RegistraOperazione(numcolA As Variant, numcolB As Variant, numcolF As Variant, operaz As String) On Error GoTo rety Close #1 Open App.Path + "\data\" + Str(numcolF) + ".txt" For Output As #1 Write #1, numcolA Write #1, numcolB Write #1, operaz Close #1 GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" Close #1 rety1: End Sub Public Sub RecuperoXY(a, da) On Error GoTo rety Erase AsseXop Erase AsseYop k = 0 'asse x If a > NumElem0 Then Close #1 Open App.Path + "\data\" + Str(a) + ".txt" For Input As #1 k = k + 1 Input #1, a1 AsseXop(k) = a1 k = k + 1 Input #1, b1 AsseXop(k) = b1 k = k + 1 Input #1, C1 AsseXop(k) = C1 Close #1 End If If a <= NumElem0 Then k = k + 1 AsseXop(k) = a k = k + 1 AsseXop(k) = "" k = k + 1 AsseXop(k) = "" Close #1 numopX = 3 GoTo tere End If 'primo livello If a1 > NumElem0 Then Close #1 Open App.Path + "\data\" + Str(a1) + ".txt" For Input As #1 k = k + 1 Input #1, a2 AsseXop(k) = a2 k = k + 1 Input #1, b2 AsseXop(k) = b2 k = k + 1 Input #1, C2 AsseXop(k) = C2 Close #1 End If If b1 > NumElem0 And C1 <> "A*C" Then Close #1 Open App.Path + "\data\" + Str(b1) + ".txt" For Input As #1 k = k + 1 Input #1, a3 AsseXop(k) = a3 k = k + 1 Input #1, b3 AsseXop(k) = b3 k = k + 1 Input #1, c3 AsseXop(k) = c3 Close #1 End If 'secondo livello If a2 > NumElem0 Then Close #1 Open App.Path + "\data\" + Str(a2) + ".txt" For Input As #1 k = k + 1 Input #1, a4 AsseXop(k) = a4 k = k + 1 Input #1, b4 AsseXop(k) = b4 k = k + 1 Input #1, c4 AsseXop(k) = c4 Close #1 End If If b2 > NumElem0 And C1 <> "A*C" Then Close #1 Open App.Path + "\data\" + Str(b2) + ".txt" For Input As #1 k = k + 1 Input #1, a5 AsseXop(k) = a5 k = k + 1 Input #1, b4 AsseXop(k) = b5 k = k + 1 Input #1, c5 AsseXop(k) = c5 Close #1 End If If a3 > NumElem0 Then Close #1 Open App.Path + "\data\" + Str(a3) + ".txt" For Input As #1 k = k + 1 Input #1, a6 AsseXop(k) = a6 k = k + 1 Input #1, b6 AsseXop(k) = b6 k = k + 1 Input #1, c6 AsseXop(k) = c6 Close #1 End If If b3 > NumElem0 And c3 <> "A*C" Then Close #1 Open App.Path + "\data\" + Str(b3) + ".txt" For Input As #1 k = k + 1 Input #1, a7 AsseXop(k) = a7 k = k + 1 Input #1, b7 AsseXop(k) = b7 k = k + 1 Input #1, c7 AsseXop(k) = c7 Close #1 End If numopX = k tere: 'asse y kk = 0 If da > NumElem0 Then Close #1 Open App.Path + "\data\" + Str(da) + ".txt" For Input As #1 kk = kk + 1 Input #1, d1 AsseYop(kk) = d1 kk = kk + 1 Input #1, E1 AsseYop(kk) = E1 kk = kk + 1 Input #1, f1 AsseYop(kk) = f1 Close #1 End If If da <= NumElem0 Then kk = kk + 1 AsseYop(kk) = da kk = kk + 1 AsseYop(kk) = "" kk = kk + 1 AsseYop(kk) = "" Close #1 numopY = 3 GoTo tere1 End If 'primo livello If d1 > NumElem0 Then Close #1 Open App.Path + "\data\" + Str(d1) + ".txt" For Input As #1 kk = kk + 1 Input #1, d2 AsseYop(kk) = d2 kk = kk + 1 Input #1, e2 AsseYop(kk) = e2 kk = kk + 1 Input #1, f2 AsseYop(kk) = f2 Close #1 End If If E1 > NumElem0 And f1 <> "A*C" And f1 <> "A/C" Then Close #1 Open App.Path + "\data\" + Str(E1) + ".txt" For Input As #1 kk = kk + 1 Input #1, d3 AsseYop(kk) = d3 kk = kk + 1 Input #1, e3 AsseYop(kk) = e3 kk = kk + 1 Input #1, f3 AsseYop(kk) = f3 Close #1 End If 'secondo livello If d2 > NumElem0 Then Close #1 Open App.Path + "\data\" + Str(d2) + ".txt" For Input As #1 kk = kk + 1 Input #1, d4 AsseYop(kk) = d4 kk = kk + 1 Input #1, e4 AsseYop(kk) = e4 kk = kk + 1 Input #1, f4 AsseYop(kk) = f4 Close #1 End If If e2 > NumElem0 And f2 <> "A*C" And f2 <> "A/C" Then Close #1 Open App.Path + "\data\" + Str(e2) + ".txt" For Input As #1 kk = kk + 1 Input #1, d5 AsseYop(kk) = d5 kk = kk + 1 Input #1, e4 AsseYop(kk) = e5 kk = kk + 1 Input #1, f5 AsseYop(kk) = f5 Close #1 End If If d3 > NumElem0 Then Close #1 Open App.Path + "\data\" + Str(a3) + ".txt" For Input As #1 kk = kk + 1 Input #1, d6 AsseYop(kk) = d6 kk = kk + 1 Input #1, e6 AsseYop(kk) = e6 kk = kk + 1 Input #1, f6 AsseYop(kk) = f6 Close #1 End If If e3 > NumElem0 And f3 <> "A*C" And f3 <> "A/C" Then Close #1 Open App.Path + "\data\" + Str(b3) + ".txt" For Input As #1 kk = kk + 1 Input #1, d7 AsseYop(kk) = d7 kk = kk + 1 Input #1, e7 AsseYop(kk) = e7 kk = kk + 1 Input #1, f7 AsseYop(kk) = f7 Close #1 End If numopY = kk tere1: NumModelElem = 0 'ww = 0 'For i = k To 1 Step -1 'ww = ww + 1 'ModXop(ww) = AsseXop(i) 'If Val(AsseXop(i)) <> 0 And AsseXop(i + 1) <> "A*C" And AsseXop(i + 2) <> "Uno/A" Then 'For ii = 1 To NumModelElem 'If Elementi(AsseXop(i)) = ModElementi(ii) And AsseXop(i) <= NumElem0 Then 'ModXop(ww) = ii 'GoTo aaz 'End If 'Next ii 'NumModelElem = NumModelElem + 1 'ModElementi(NumModelElem) = Elementi(AsseXop(i)) 'ModXop(ww) = Str(NumModelElem) 'End If 'aaz: 'Next i ww = 0 For i = numopX To 1 Step -1 ww = ww + 1 ModXop(ww) = AsseXop(i) 'If Val(AsseYop(i)) <> 0 And AsseYop(i + 1) <> "A*C" And AsseYop(i + 2) <> "Uno/A" Then 'If AsseYop(i + 2) = "A*C" Then 'ModYop(ww) = "" 'GoTo aaz1 'End If If Val(AsseXop(i)) <> 0 And Val(AsseXop(i)) <= NumElem0 And AsseXop(i + 1) <> "A*C" And AsseXop(i + 1) <> "A/C" Then For ii = 1 To NumModelElem If Elementi(AsseXop(i)) = ModElementi(ii) Then 'ModYop(ww) = ii GoTo aaz1 End If Next ii NumModelElem = NumModelElem + 1 ModElementi(NumModelElem) = Elementi(AsseXop(i)) 'Modxop(ww) = Str(NumModelElem) End If aaz1: Next i ww = 0 For i = numopY To 1 Step -1 ww = ww + 1 ModYop(ww) = AsseYop(i) 'If Val(AsseYop(i)) <> 0 And AsseYop(i + 1) <> "A*C" And AsseYop(i + 2) <> "Uno/A" Then 'If AsseYop(i + 2) = "A*C" Then 'ModYop(ww) = "" 'GoTo aaz1 'End If If Val(AsseYop(i)) <> 0 And Val(AsseYop(i)) <= NumElem0 And AsseYop(i + 1) <> "A*C" And AsseYop(i + 1) <> "A/C" Then For ii = 1 To NumModelElem If Elementi(AsseYop(i)) = ModElementi(ii) Then 'ModYop(ww) = ii GoTo aaz2 End If Next ii NumModelElem = NumModelElem + 1 ModElementi(NumModelElem) = Elementi(AsseYop(i)) 'ModYop(ww) = Str(NumModelElem) End If aaz2: Next i GoTo rety1 rety: MsgBox "An Error Occurred During Data Elaboration", , "Error" Close #1 rety1: End Sub Public Sub Filtri() 'elaboro i filti For i = 1 To Numcamp1 SimbFilter(i) = 1 Next i For i = 1 To NumFilter For ii = 1 To NumElem1 If FiltElem(i) = Elementi(ii) Then el1 = ii GoTo poi1 End If Next ii 'se non trova l'elemeto ... MsgBox "An error occurred" Exit Sub poi1: 'eseguo l'operazione ' ...>............... If FiltOp(i) = 1 Then For ii = 1 To Numcamp1 If DatiOrigine(ii, el1) < FiltVal(i) Then SimbFilter(ii) = 0 End If Next ii End If '.........<.................. If FiltOp(i) = 2 Then For ii = 1 To Numcamp1 If DatiOrigine(ii, el1) > FiltVal(i) Then SimbFilter(ii) = 0 End If Next ii End If '.........<.................. If FiltOp(i) <> 3 Then For ii = 1 To Numcamp1 If DatiOrigine(ii, el1) = FiltVal(i) Then SimbFilter(ii) = 0 End If Next ii End If Next i End Sub