salvo50
Advanced Member >PLATINUM PLUS<
METODO AURUM di ROBERTO PASCALE su appunti di FABARRI
Codice:
'PROGETTO - AURUM - BY ROBERTO PASCALE
'Con cerchio ciclometrico
'SCRIPT BY SALVO50
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
Ultima modifica:
