Option Explicit
' SCRIPT SU RICHIESTA DI ZETRIX UTENTE LOTTOCED
' LO SCRIPT È REGALATO PUÒ ESSERE DISTRIBUITO MA NON PUÒ ESSERE VENDUTO"
' NON SI ESCLUDONO ERRORI O EVENTUALI BUGS
' SPETTA ALL UTENTE FINALE FINALE CONTROLLARE CHE I RISULTATI SIANO ESATTI
' L UTILIZZATORE È L UNICO RESPONSABILE DI EVENTUALI PERDITE DI DENARO SE DECIE DI GIOCARE
' LO SCRIPT È DI CARATTERE GRAFICO NON RESTITUISCE PREVISIONI
' IL GIOCO IN ITALIA È VIETATO AI MINORI DI ANNI 18 ( IN BASE AL REGOLAMENTO VIGENTE IN DATA 27/12/2022) E PUÒ PROVOCARE GRAVE DIPENDENZA PATOLOGICA
Class cls1
Dim Num
Dim nPres
Sub IncrementaPres
nPres = nPres + 1
End Sub
End Class
Sub Main
Call MsgBox("script su richiesta di zetrix utente lottoced" & vbCrLf & "lo script è regalato può essere distribuito ma non può essere venduto" & vbCrLf & _
"Non si escludono errori o eventuali bugs" & vbCrLf & "spetta all utente finale finale controllare che i risultati siano esatti" & vbCrLf & _
"spetta all utente finale finale controllare che i risultati siano esatti" & vbCrLf & "l utilizzatore è l unico responsabile di eventuali perdite di denaro se decie di giocare" & vbCrLf & _
"lo script è di carattere grafico non restituisce previsioni" & vbCrLf & "il gioco in italia è vietato ai minori di anni 18 ( in base al regolamnto vigente in data 27/12/2022)" & vbCrLf & _
" e può provocare grave dipendenza patologica",vbInformation + vbOKOnly,"Informazioni")
Call SetColorSezione(RGB(210,228,247))
Dim idestr:idestr = EstrazioneFin
Dim sum,nPasso,nElem,n,i,e,bRet,nSpia,m
nSpia = GetSpia
nPasso = GetPasso
nElem = GetElementi(nPasso)
Dim Coll:Set Coll = GetNewCollection
Dim sKey,sNum,sTemp,nTro
nTro = 0
For n = 1 To 90
sum = 0
bRet = False
m = 0
ReDim aLung(nElem),aN(90)
For i = 1 To nElem
e = Fuori90(n + sum)
If aN(e) <> 1 Then
m = m + 1
aLung(m) = e
aN(e) = 1
End If
If e = nSpia Then bRet = True
sum = sum + nPasso
Next
If bRet Then
ReDim Preserve aLung(m)
ReDim atemp(m)
For i = 1 To m
atemp(i) =(aLung(i))
Next
Call OrdinaMatriceTurbo(atemp,1)
nTro = nTro + 1
sKey = "K" & StringaNumeri(atemp,True)
If GetItemCollection(Coll,sKey,sNum) Then
snum.IncrementaPres
Else
Set sNum = New cls1
sNum.num = StringaNumeri(sTemp,,True)
Coll.Add sNum,sKey
Call GetStrinaNumeriDaEvidenziare(idestr,aLung,nSpia,m,nPasso)
End If
End If
Next
End Sub
Sub GetStrinaNumeriDaEvidenziare(idEstr,aLung,nSpia,nLung,nPasso)
Dim r,e,p,nPresSpia
Dim nCaselleDaEvid
ReDim aCeck(90),anTro(0)
Call aZZera(aCeck)
For e = 1 To UBound(aLung)
aCeck(aLung(e)) = 1
Next
Dim aR:aR = Array(0,1,2,3,4,5,6,7,8,9,10,12)
' predispone le dimensioni della matrice che contien i numeri
ReDim aNumDaEvid(55,1) ' dato che non so a priori la quantita di numeri metto 55
nPresSpia = 0
For r = 1 To 11
For p = 1 To 5
e = Estratto(idEstr,aR(r),p)
If e = nSpia Then nPresSpia = nPresSpia + 1
If aCeck(e) = 1 Then
nCaselleDaEvid = nCaselleDaEvid + 1
ReDim Preserve anTro(nCaselleDaEvid)
anTro(nCaselleDaEvid) = e
aNumDaEvid(nCaselleDaEvid,0) = r
aNumDaEvid(nCaselleDaEvid,1) = p
End If
Next
Next
Call EliminaRipetuti(anTro,True)
' If UBound(anTro) >= 2 Then
ReDim aMatriceLegami(nCaselleDaEvid - 1,3)
For r = 1 To nCaselleDaEvid - 1
aMatriceLegami(r,0) = aNumDaEvid(r,0)
aMatriceLegami(r,1) = aNumDaEvid(r,1)
aMatriceLegami(r,2) = aNumDaEvid(r + 1,0)
aMatriceLegami(r,3) = aNumDaEvid(r + 1,1)
Next
Dim col:col = RGB(210,228,247)
Dim nVolte:nVolte = "Volta"
If nPresSpia <> 1 Then nVolte = "volte"
Dim nFormat:nFormat = Len(StringaNumeri(aLung,,True))
Scrivi" ",,0
Scrivi FormatSpace(" Non si garantisce che vengano visualizzate Tutte le formazioni",194),1,,RGB(43,129,212),5
Scrivi" ",,0
Scrivi FormatSpace(" La sequenza si sviluppa in senso orario .Vedi cerchio ciclometrico",194),1,,RGB(43,129,212),5
Scrivi
Scrivi" ",,0
Scrivi " Numero Spia nelle lunghette: ",1,0,col,RGB(79,79,79)
Scrivi "|",,0,,RGB(210,228,247),3
Scrivi " " & FormatSpace(nSpia,2,1) & " ",1,0,RGB(87,99,128),vbWhite
Scrivi" ",,0
Scrivi FormatSpace(" Pres nell'estrazione: " & nPresSpia & " " & nVolte,60),,,,vbRed
Scrivi" ",,0
Scrivi " Numero elementi lunghetta: ",1,0,col,RGB(79,79,79)
Scrivi "|",,0,,RGB(210,228,247),3
Scrivi FormatSpace(nLung,nFormat,1),1,,5
Scrivi" ",,0
Scrivi " Passo lunghetta: ",1,0,col,RGB(79,79,79)
Scrivi "|",,0,,RGB(210,228,247),3
Scrivi FormatSpace(nPasso,nFormat,1),1,,5
Scrivi" ",,0
Scrivi " Lunghetta Spia: ",1,0,col,RGB(79,79,79)
Scrivi "|",,0,,RGB(210,228,247),3
Scrivi FormatSpace(StringaNumeri(aLung,,True),nFormat,1),1,,5
Scrivi" ",,0
Scrivi " Numeri trovati: ",1,0,col,RGB(79,79,79)
Scrivi "|",,0,,RGB(210,228,247),3
Scrivi " " & FormatSpace(UBound(anTro),2,1) & " ",1,0,RGB(87,99,128),vbWhite
Scrivi "|",,0,,RGB(210,228,247),3
Scrivi FormatSpace("[ " & StringaNumeri(anTro,,True) & " ]",nFormat,1),1,,5
Scrivi
Call DisegnaEstrazione(idEstr,aNumDaEvid,aMatriceLegami,vbGreen)
Call DisegnaCerchioCiclometrico(anTro,True,,,,1,1)
' End If
End Sub
Sub aZZera(aCeck)
ReDim aCeck(90)
Dim i
For i = 1 To 90
aCeck(i) = 0
Next
End Sub
Function GetSpia
Dim aSpia(89)
Dim i
For i = 0 To 89
aSpia(i) = i + 1
Next
GetSpia = ScegliOpzioneMenu(aSpia,0,"Seleziona Elemento Spia ") + 1
End Function
Function GetPasso
Dim aPasso(29)
Dim i
For i = 0 To 29
aPasso(i) = i + 1
Next
GetPasso = ScegliOpzioneMenu(aPasso,0,"Scegli passo") + 1
End Function
Function GetElementi(nPasso)
Dim i,idE
idE = CInt(Dividi(90,nPasso)) - 3
ReDim aElem(17)
For i = 0 To UBound(aElem)
aElem(i) = i + 3
Next
If idE > 20 Then idE = 0: Else idE = idE - 3
GetElementi = ScegliOpzioneMenu(aElem,idE,"Scegli quanti elementi nella lunghetta") + 3
End Function
