| CITAZIONE (pigreko73.. @ 26/2/2018, 07:03) 'PROGETTO - AURUM - BY ROBERTO PASCALE 'Con cerchio ciclometrico 'SCRIPT BY ARETUSEO Option Explicit Sub Main Dim FIn,Es,Esq,Clp,Col,Esqcol,Idestr Dim Posta(2),Ruota(1),Ambo1(2),Ambo2(2) Dim Ambo3(2),Ambo4(2),F(3),Num(5),Poste(5) Dim P1,P2,P3,R1,Caso,Casi,Salvo50,Clp2 Dim A1,A2,A3,B1,B2,B3,C1,C2,C3,Dab,Dac,Dbc Dim DC1,DC2,DC3,PA1,MA1,PC3,MC3,Est1,Est2 Dim Me1,C90DC2,V1,V2,Diam1,Diam2 FIn = EstrazioneFin Esq = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9200)'6779 primo esempio GE 23-01-1999 Clp = InputBox("Per quanti colpi vuoi giocare l'ambo?",Salvo50,7) Clp2 = InputBox("Per quanti colpi vuoi giocare la cinquina?",Salvo50,13) Col = CInt(InputBox(" Quante estrazioni vuoi controllare ",Salvo50,9000)) Posta(1) = 1 Posta(2) = 1 Poste(2) = 1 Poste(3) = 1 Poste(4) = 1 'Poste(5) = 1 Esqcol = Esq + Col If Esqcol > FIn Then Esqcol = FIn For Es = Esq To Esqcol Messaggio Es AvanzamentoElab Esq,Esqcol,Es Caso = 0 For R1 = 1 To 12 If R1 = 11 Then R1 = 12 For P1 = 1 To 3 For P2 = P1 + 1 To 4 For P3 = P2 + 1 To 5 A1 = Estratto(Es,R1,P1): If A1 > 0 Then B1 = Estratto(Es,R1,P2) C1 = Estratto(Es,R1,P3) If A1 <> 45 And A1 <> 90 And B1 <> 45 And B1 <> 90 And C1 <> 45 And C1 <> 90 Then Dab = Distanza(A1,B1) : Dac = Distanza(A1,C1) : Dbc = Distanza(B1,C1) If Dab <> 30 And Dac <> 30 And Dbc <> 30 Then If(Dab = Dbc) Then A2 = Fuori90(A1 + 30) : A3 = Fuori90(A2 + 30) B2 = Fuori90(B1 + 30) : B3 = Fuori90(B2 + 30) C2 = Fuori90(C1 + 30) : C3 = Fuori90(C2 + 30) DC1 = Distanza(A1,C3) PA1 = Fuori90(A1 + DC1): MA1 = Fuori90(90 +(A1 - DC1)) If PA1 = C3 Then Est1 = MA1 Else Est1 = PA1 End If ' PC3 = Fuori90(C3 + DC1): MC3 = Fuori90(90 +(C3 - DC1)) If PC3 = A1 Then Est2 = MC3 Else Est2 = PC3 End If ' DC2 = Distanza(Est1,Est2) If pari(DC2) Then C90DC2 =(90 - DC2) Me1 = C90DC2 / 2 If Me1 <> 30 Then If Est1 < Est2 Then V1 = Fuori90(Est1 + Me1) V2 = Fuori90(90 +(Est2 - Me1)) End If If Est2 < Est1 Then V1 = Fuori90(Est2 + Me1) V2 = Fuori90(90 +(Est1 - Me1)) End If If V1 = V2 Then Ruota(1) = R1 Diam1 = Diametrale(Est1) Diam2 = Diametrale(Est2) ' Caso = Caso + 1 Casi = Casi + 1 ColoreTesto 1 Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000") ColoreTesto 2 Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000") ColoreTesto 0 Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0 Scrivi " " & SiglaRuota(R1) & " " & StringaEstratti(Es,R1),1 Scrivi ColoreTesto 1 Scrivi " Distanza Ciclometrica tra estratti " & Format2(Dab) & " - " & Format2(A1) & " " & Format2(B1) & " " & Format2(C1),1 Scrivi Scrivi Space(41) & Format2(A2) & " " & Format2(B2) & " " & Format2(C2),1 Scrivi Scrivi Space(41) & Format2(A3) & " " & Format2(B3) & " " & Format2(C3),1 Scrivi ColoreTesto 2 Scrivi Space(14) & "Cardine 1" & Space(5) & "estremo 1" & Space(5) & "Distanza" & Space(5) & "Estremo 2 " & Space(5) & "Cardine 2" Scrivi Space(17) & Format2(Est1) & Space(12) & Format2(A1) & Space(12) & Format2(DC1) & Space(11) & Format2(C3) & Space(13) & Format2(Est2) ColoreTesto 0 Scrivi F(1) = Est1 :F(2) = Est2 :F(3) = V1 DisegnaCerchioCiclometrico F,- 1,1,0 Num(1) = V1 Num(2) = Est1 Num(3) = Est2 Num(4) = Diam1 Num(5) = Diam2 ' Scrivi Ambo1(1) = V1 Ambo1(2) = Est1 ImpostaGiocata 1,Ambo1,Ruota,Posta,Clp Ambo2(1) = V1 Ambo2(2) = Est2 ImpostaGiocata 2,Ambo2,Ruota,Posta,Clp Ambo3(1) = V1 Ambo3(2) = Diam1 ImpostaGiocata 3,Ambo3,Ruota,Posta,Clp Ambo4(1) = V1 Ambo4(2) = Diam2 ImpostaGiocata 4,Ambo4,Ruota,Posta,Clp Num(1) = V1 Num(2) = Est1 Num(3) = Est2 Num(4) = Diam1 Num(5) = Diam2 ImpostaGiocata 5,Num,Ruota,Poste,Clp2 Gioca Es End If End If End If End If
End If End If End If If ScriptInterrotto Then Exit Sub Next Next Next Next Next ScriviResoconto Scrivi Space(50) & "PROGETTO - AURUM - BY ROBERTO PASCALE" Scrivi Space(50) & "SCRIPT BY SALVO50" End Sub SACRIPT MODIFICATO PER LOTTODESK ED L8+CODICE 'PROGETTO - AURUM - BY ROBERTO PASCALE 'Con cerchio ciclometrico 'SCRIPT BY ARETUSEO Option Explicit Sub Main Dim FIn,Es,Esq,Clp,Col,Esqcol,Idestr Dim Posta(2),Ruota(1),Ambo1(2),Ambo2(2) Dim Ambo3(2),Ambo4(2),F(3),Num(5),Poste(5) Dim P1,P2,P3,R1,Caso,Casi,Salvo50,Clp2 Dim A1,A2,A3,B1,B2,B3,C1,C2,C3,Dab,Dac,Dbc Dim DC1,DC2,DC3,PA1,MA1,PC3,MC3,Est1,Est2 Dim Me1,C90DC2,V1,V2,Diam1,Diam2 FIn = EstrazioneFin Esq = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9200)'6779 primo esempio GE 23-01-1999 Clp = InputBox("Per quanti colpi vuoi giocare l'ambo?",Salvo50,7) Clp2 = InputBox("Per quanti colpi vuoi giocare la cinquina?",Salvo50,13) Col = CInt(InputBox(" Quante estrazioni vuoi controllare ",Salvo50,9000)) Posta(1) = 1 Posta(2) = 1 Poste(2) = 1 Poste(3) = 1 Poste(4) = 1 'Poste(5) = 1 Esqcol = Esq + Col If Esqcol > FIn Then Esqcol = FIn For Es = Esq To Esqcol Messaggio Es AvanzamentoElab Esq,Esqcol,Es Caso = 0 For R1 = 1 To 12 If R1 = 11 Then R1 = 12 For P1 = 1 To 3 For P2 = P1 + 1 To 4 For P3 = P2 + 1 To 5 A1 = Estratto(Es,R1,P1): If A1 > 0 Then B1 = Estratto(Es,R1,P2) C1 = Estratto(Es,R1,P3) If A1 <> 45 And A1 <> 90 And B1 <> 45 And B1 <> 90 And C1 <> 45 And C1 <> 90 Then Dab = Distanza(A1,B1) : Dac = Distanza(A1,C1) : Dbc = Distanza(B1,C1) If Dab <> 30 And Dac <> 30 And Dbc <> 30 Then If(Dab = Dbc) Then A2 = Fuori90(A1 + 30) : A3 = Fuori90(A2 + 30) B2 = Fuori90(B1 + 30) : B3 = Fuori90(B2 + 30) C2 = Fuori90(C1 + 30) : C3 = Fuori90(C2 + 30) DC1 = Distanza(A1,C3) PA1 = Fuori90(A1 + DC1): MA1 = Fuori90(90 +(A1 - DC1)) If PA1 = C3 Then Est1 = MA1 Else Est1 = PA1 End If ' PC3 = Fuori90(C3 + DC1): MC3 = Fuori90(90 +(C3 - DC1)) If PC3 = A1 Then Est2 = MC3 Else Est2 = PC3 End If ' DC2 = Distanza(Est1,Est2) If pari(DC2) Then C90DC2 =(90 - DC2) Me1 = C90DC2 / 2 If Me1 <> 30 Then If Est1 < Est2 Then V1 = Fuori90(Est1 + Me1) V2 = Fuori90(90 +(Est2 - Me1)) End If If Est2 < Est1 Then V1 = Fuori90(Est2 + Me1) V2 = Fuori90(90 +(Est1 - Me1)) End If If V1 = V2 Then Ruota(1) = R1 Diam1 = Diametrale(Est1) Diam2 = Diametrale(Est2) ' Caso = Caso + 1 Casi = Casi + 1 ColoreTesto 1 Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000") ColoreTesto 2 Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000") ColoreTesto 0 Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0 Scrivi " " & SiglaRuota(R1) & " " & StringaEstratti(Es,R1),1 Scrivi ColoreTesto 1 Scrivi " Distanza Ciclometrica tra estratti " & Format2(Dab) & " - " & Format2(A1) & " " & Format2(B1) & " " & Format2(C1),1 Scrivi Scrivi Space(41) & Format2(A2) & " " & Format2(B2) & " " & Format2(C2),1 Scrivi Scrivi Space(41) & Format2(A3) & " " & Format2(B3) & " " & Format2(C3),1 Scrivi ColoreTesto 2 Scrivi Space(14) & "Cardine 1" & Space(5) & "estremo 1" & Space(5) & "Distanza" & Space(5) & "Estremo 2 " & Space(5) & "Cardine 2" Scrivi Space(17) & Format2(Est1) & Space(12) & Format2(A1) & Space(12) & Format2(DC1) & Space(11) & Format2(C3) & Space(13) & Format2(Est2) ColoreTesto 0 Scrivi F(1) = Est1 :F(2) = Est2 :F(3) = V1 Num(1) = V1 Num(2) = Est1 Num(3) = Est2 Num(4) = Diam1 Num(5) = Diam2 ' Scrivi Ambo1(1) = V1 Ambo1(2) = Est1 ImpostaGiocata 1,Ambo1,Ruota,Posta,Clp Ambo2(1) = V1 Ambo2(2) = Est2 ImpostaGiocata 2,Ambo2,Ruota,Posta,Clp Ambo3(1) = V1 Ambo3(2) = Diam1 ImpostaGiocata 3,Ambo3,Ruota,Posta,Clp Ambo4(1) = V1 Ambo4(2) = Diam2 ImpostaGiocata 4,Ambo4,Ruota,Posta,Clp Num(1) = V1 Num(2) = Est1 Num(3) = Est2 Num(4) = Diam1 Num(5) = Diam2 ImpostaGiocata 5,Num,Ruota,Poste,Clp2 Gioca Es End If End If End If End If
End If End If End If Next Next Next Next Next ScriviResoconto Scrivi Space(50) & "PROGETTO - AURUM - BY ROBERTO PASCALE" Scrivi Space(50) & "SCRIPT BY SALVO50" End Sub
|