Zetrix
Advanced Premium Member
Codice:
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))
Dim SviluppoQuartina
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 " numeri in 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 " sequence 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,RGB(249,80,47))
Call DisegnaCerchioCiclometrico(anTro,True,,,,1,1)
' se togli il rem al rigo successivo verranno disegnati tutti i cerchi in classe 4 con fisso il numero spia n
'Call Get SviluppoQuartina(anTro,nSpia)
'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 numero spia ") + 1
End Function
Function GetPasso
Dim aPasso(44)
Dim i
For i = 0 To 44
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 numeri nella lunghetta") + 3
End Functioni legend ho fatto una modifica su Dim aPasso
ho messo (44) e ho fatto una prova con la sequenza 32 in lunghetta e lo
script da errore dice valore di proprieta non valido
Dim aPasso(44)
Dim i
For i = 0 To 44
