Follow along with the video below to see how to install our site as a web app on your home screen.
Nota: This feature may not be available in some browsers.
Option Explicit
Sub Main
Dim Ini,Fin,idEstr,nRit,nRuota,nDaFare,nFatte,p,n,k,nSfald ,bValida
Dim cMaxRigo,cSorte
Dim cIdRit,cIdRitMax,cIdFreq
cIdRit = 0
cIdRitMax = 1
cIdFreq = 3
cMaxRigo = 80
cSorte = 1
ReDim aRitPerRigo(cMaxRigo,12,3)
Ini = EstrazioneIni
Fin = EstrazioneFin
nDaFare = Fin -(Ini - 1)
For idEstr = Ini To Fin - 1
ReDim aNum(5)
Call GeneraAnaliticoTurbo ( idEstr)
For nRuota = 1 To 12
If nRuota <> 11 Then
Call GetArrayNumeriRuota(idEstr + 1,nRuota,aNum)
ReDim aBNumEstrSucc(90)
For p = 1 To 5
aBNumEstrSucc(aNum(p)) = True
Next
For nRit = 0 To cMaxRigo
nSfald = 0
'bValida = False
For p = 1 To 5
n = TabelloneAnaliticoTurbo(nRit,nRuota,p)
'If n >0 Then bValida = True
If aBNumEstrSucc(n) Then
nSfald = nSfald + 1
End If
Next
'If bValida Then
If nSfald >= cSorte Then
If aRitPerRigo(nRit,nRuota,cIdRit) > aRitPerRigo(nRit,nRuota,cIdRitMax) Then
aRitPerRigo(nRit,nRuota,cIdRitMax) = aRitPerRigo(nRit,nRuota,cIdRit)
End If
aRitPerRigo(nRit,nRuota,cIdRit) = 0
aRitPerRigo(nRit,nRuota,cIdFreq) = aRitPerRigo(nRit,nRuota,cIdFreq) + 1
Else
aRitPerRigo(nRit,nRuota,cIdRit) = aRitPerRigo(nRit,nRuota,cIdRit) + 1
End If
'End If
If ScriptInterrotto Then Exit For
Next
End If
If ScriptInterrotto Then Exit For
Next
nFatte = nFatte + 1
Call AvanzamentoElab(1,nDaFare,nFatte)
If ScriptInterrotto Then Exit For
Next
ReDim aV(5)
aV(1) = "Rigo"
aV(2) = "Ritardo"
aV(3) = "RitardoMax"
aV(4) = "Frequenza"
aV(5) = "Ruota"
Messaggio "Creazione tabella"
DoEventsEx
Call InitTabella(aV )
For nRuota = 1 To 12
If nRuota <> 11 Then
For k = 0 To cMaxRigo
aV(1) = k
aV(2) = aRitPerRigo(k,nRuota,cIdRit)
aV(3) = aRitPerRigo(k,nRuota,cIdRitMax)
aV(4) = aRitPerRigo(k,nRuota,cIdFreq)
aV(5) = NomeRuota(nRuota)
Call AddRigaTabella(aV)
Next
End If
Next
Call CreaTabella(2 )
End Sub
[COLOR=#0000CD]If n > 0 Then[/COLOR]
[COLOR=#808080]If aBNumEstrSucc(n) Then
nSfald = nSfald + 1
End If[/COLOR]
[COLOR=#0000CD] End If[/COLOR]
Option Explicit
Sub Main
Dim Ini,Fin,idEstr,nRit,nRuota,nDaFare,nFatte,p,n,k,nSfald,bValida,sNum,bMostraSoloRigheConNimeri
Dim cMaxRigo,cSorte
Dim cIdRit,cIdRitMax,cIdFreq
cIdRit = 0
cIdRitMax = 1
cIdFreq = 3
cMaxRigo = 80
cSorte = 1
ReDim aRitPerRigo(cMaxRigo,12,3)
Ini = EstrazioneIni
Fin = EstrazioneFin
nDaFare = Fin -(Ini - 1)
For idEstr = Ini To Fin - 1
ReDim aNum(5)
Call GeneraAnaliticoTurbo(idEstr)
For nRuota = 1 To 12
If nRuota <> 11 Then
Call GetArrayNumeriRuota(idEstr + 1,nRuota,aNum)
ReDim aBNumEstrSucc(90)
For p = 1 To 5
aBNumEstrSucc(aNum(p)) = True
Next
For nRit = 0 To cMaxRigo
nSfald = 0
'bValida = False
For p = 1 To 5
n = TabelloneAnaliticoTurbo(nRit,nRuota,p)
'If n >0 Then bValida = True
If n > 0 Then
If aBNumEstrSucc(n) Then
nSfald = nSfald + 1
End If
End If
Next
'If bValida Then
If nSfald >= cSorte Then
If aRitPerRigo(nRit,nRuota,cIdRit) > aRitPerRigo(nRit,nRuota,cIdRitMax) Then
aRitPerRigo(nRit,nRuota,cIdRitMax) = aRitPerRigo(nRit,nRuota,cIdRit)
End If
aRitPerRigo(nRit,nRuota,cIdRit) = 0
aRitPerRigo(nRit,nRuota,cIdFreq) = aRitPerRigo(nRit,nRuota,cIdFreq) + 1
Else
aRitPerRigo(nRit,nRuota,cIdRit) = aRitPerRigo(nRit,nRuota,cIdRit) + 1
End If
'End If
If ScriptInterrotto Then Exit For
Next
End If
If ScriptInterrotto Then Exit For
Next
nFatte = nFatte + 1
Call AvanzamentoElab(1,nDaFare,nFatte)
If ScriptInterrotto Then Exit For
Next
ReDim aV(6)
aV(1) = "Rigo"
aV(2) = "Ritardo"
aV(3) = "RitardoMax"
aV(4) = "Frequenza"
aV(5) = "Ruota"
aV(6) = "NumPresRigoAttuale"
Call GeneraAnaliticoTurbo(idEstr)
Messaggio "Creazione tabella"
If MsgBox ("Mostrare solo le righe alla cui posizione nel tab analitico sono effettivamente presenti dei numeri ?" , vbQuestion + vbYesNo ) = vbYes Then
bMostraSoloRigheConNimeri = True
End If
DoEventsEx
Call InitTabella(aV)
For nRuota = 1 To 12
If nRuota <> 11 Then
For k = 0 To cMaxRigo
aV(1) = k
aV(2) = aRitPerRigo(k,nRuota,cIdRit)
aV(3) = aRitPerRigo(k,nRuota,cIdRitMax)
aV(4) = aRitPerRigo(k,nRuota,cIdFreq)
aV(5) = NomeRuota(nRuota)
sNum = ""
For p = 1 To 5
n = TabelloneAnaliticoTurbo(k,nRuota,p)
sNum = Iif(n >0 , sNum & n & ".", sNum)
Next
sNum = RimuoviLastChr(sNum , ".")
bValida = False
If bMostraSoloRigheConNimeri Then
If sNum <> "" Then bValida = True
Else
bValida = True
End If
If bValida Then
aV(6) = sNum
Call AddRigaTabella(aV)
End If
Next
End If
Next
Call CreaTabella(2)
End Sub
Option Explicit
Sub Main
Dim Ini,Fin,idEstr,nRit,nRuota,nDaFare,nFatte,p,n,k,nSfald,bValida,sNum,bMostraSoloRigheConNimeri
Dim cMaxRigo,cSorte
Dim cIdRit,cIdRitMax,cIdFreq
cIdRit = 0
cIdRitMax = 1
cIdFreq = 3
cMaxRigo = 80
cSorte = 1
ReDim abRuote(12)
Call ScegliRuote( Nothing , abRuote)
ReDim aRitPerRigo(cMaxRigo,12,3)
Ini = EstrazioneIni
Fin = EstrazioneFin
nDaFare = Fin -(Ini - 1)
For idEstr = Ini To Fin - 1
ReDim aNum(5)
Call GeneraAnaliticoTurbo(idEstr)
For nRuota = 1 To 12
If nRuota <> 11 And abRuote (nRuota) Then
Call GetArrayNumeriRuota(idEstr + 1,nRuota,aNum)
ReDim aBNumEstrSucc(90)
For p = 1 To 5
aBNumEstrSucc(aNum(p)) = True
Next
For nRit = 0 To cMaxRigo
nSfald = 0
'bValida = False
For p = 1 To 5
n = TabelloneAnaliticoTurbo(nRit,nRuota,p)
'If n >0 Then bValida = True
If n > 0 Then
If aBNumEstrSucc(n) Then
nSfald = nSfald + 1
End If
End If
Next
'If bValida Then
If nSfald >= cSorte Then
If aRitPerRigo(nRit,nRuota,cIdRit) > aRitPerRigo(nRit,nRuota,cIdRitMax) Then
aRitPerRigo(nRit,nRuota,cIdRitMax) = aRitPerRigo(nRit,nRuota,cIdRit)
End If
aRitPerRigo(nRit,nRuota,cIdRit) = 0
aRitPerRigo(nRit,nRuota,cIdFreq) = aRitPerRigo(nRit,nRuota,cIdFreq) + 1
Else
aRitPerRigo(nRit,nRuota,cIdRit) = aRitPerRigo(nRit,nRuota,cIdRit) + 1
End If
'End If
If ScriptInterrotto Then Exit For
Next
End If
If ScriptInterrotto Then Exit For
Next
nFatte = nFatte + 1
Call AvanzamentoElab(1,nDaFare,nFatte)
If ScriptInterrotto Then Exit For
Next
ReDim aV(7)
aV(1) = "Rigo"
aV(2) = "Ritardo"
aV(3) = "RitardoMax"
aV(4) = "Frequenza"
aV(5) = "Ruota"
aV(6) = "NumPresRigoAttuale"
aV(7) = "IndiceConv"
Call GeneraAnaliticoTurbo(idEstr)
Messaggio "Creazione tabella"
If MsgBox("Mostrare solo le righe alla cui posizione nel tab analitico sono effettivamente presenti dei numeri ?",vbQuestion + vbYesNo) = vbYes Then
bMostraSoloRigheConNimeri = True
End If
DoEventsEx
Call InitTabella(aV)
For nRuota = 1 To 12
If nRuota <> 11 And abRuote (nRuota) Then
For k = 0 To cMaxRigo
aV(1) = k
aV(2) = aRitPerRigo(k,nRuota,cIdRit)
aV(3) = aRitPerRigo(k,nRuota,cIdRitMax)
aV(4) = aRitPerRigo(k,nRuota,cIdFreq)
aV(5) = NomeRuota(nRuota)
sNum = ""
For p = 1 To 5
n = TabelloneAnaliticoTurbo(k,nRuota,p)
sNum = Iif(n > 0,sNum & n & ".",sNum)
Next
sNum = RimuoviLastChr(sNum,".")
bValida = False
If bMostraSoloRigheConNimeri Then
If sNum <> "" Then bValida = True
Else
bValida = True
End If
If bValida Then
aV(6) = sNum
aV(7) = Round(Dividi(aRitPerRigo(k,nRuota,cIdRit),Dividi(nFatte,aRitPerRigo(k,nRuota,cIdFreq))),3)
Call AddRigaTabella(aV)
End If
Next
End If
Next
Call Scrivi ("Inizio : " & GetInfoEstrazione (Ini) )
Call Scrivi ("Fine : " & GetInfoEstrazione (Fin) )
Call CreaTabella(2)
End Sub
LuigiB;n1995753 ha scritto:Ciao Sky , no problem .. al limite provo a fare delle modifiche che testano la strategia di gioco , ad esempio si potrebbe prendere
come discriminante per la giocate il valore dell'indice di convenienza ,. a inizio script si chiede a quale indice di convenienza minimo si deve fare la giocata , poi si chedono le estrazioni su cui testare la strategia (che non coincidono con qelle del range statistico) dopo di che lo script iniziera le sue analisi
sul range individuato per valutare la strategia , appena le condizioni lo consentono esegue la giocate e
memorizza il costo parziale e totale gestendo eventualmente la progressione per tutte le giocate successive in modo tale da vedere quanto capitale sarebbe servito per non andare in perdita .. non so ..proverei a fare qualcosa di simile ..
Option Explicit
Dim cIdRit,cIdRitMax,cIdFreq
Sub Main
Select Case ScegliProcedura
Case 0
ScriviIstruzioni
Case 1
VisualizzaProgressione
Case 2
Call Analisi(True)
Case 3
Call Analisi(False)
End Select
End Sub
Sub Analisi(bEseguiAnalisi)
Dim Ini,Fin,idEstr,nRit,nRuota,nDaFare,nFatte,p,n,k,nSfald,bValida,sNum,bMostraSoloRigheConNimeri,sTmp
Dim cMaxRigo,cSorte
Dim nCapitaleImpegnato,nTotVincita,nIndiceConvMin,nPostaIniziale,nPercGuadagno,nPrimaEstrGioco,nColpiProgressione
Dim nNumInGioc,nRuotaInGioc,nRetIC,nIdProg,nGiocateTot,bSuperataProg,nMassimaEspos,nVincitaParz,nRetIdRigo,nRetRitRigo
ReDim aPoste(0)
ReDim aRetRigheProgr(0)
cIdRit = 0
cIdRitMax = 1
cIdFreq = 3
cMaxRigo = 80
cSorte = 1
nIdProg = 0
nGiocateTot = 0
bSuperataProg = False
Ini = EstrazioneIni
Fin = EstrazioneFin
nDaFare = Fin -(Ini - 1)
If bEseguiAnalisi Then
nColpiProgressione = CInt(InputBox("Inserire la quantita di colpi potenziali per la progressione","Colpi progressione",90))
nIndiceConvMin = CInt(InputBox("Inserire un valore intero per l'indice di convenienza minimo al quale la giocata viene eseguita","IcMin",5))
nPostaIniziale = CInt(InputBox("Inserire la posta per la prima giocata","Posta",1))
nPercGuadagno = CInt(InputBox("Inserire la percentuale di guadagno minima per calcolare la progressione","Percentuale guadagno",10))
nPrimaEstrGioco = CInt(InputBox("Inserire la prima estrazione dalla quale iniziare a giocare deve essere un numero compreso tra Inizio e fine Range","Prima estr giocabile",Fin - 100))
If VerificaParametriGioco(Ini,Fin,nPrimaEstrGioco,nPercGuadagno,nPostaIniziale,nIndiceConvMin,nColpiProgressione) = False Then Exit Sub
Call GetVettoreProgressione(1,1,1,nColpiProgressione,aPoste,aRetRigheProgr,1,1,0,nPercGuadagno,nPostaIniziale)
End If
ReDim abRuote(12)
If ScegliRuote(Nothing,abRuote ) <= 0 Then
MsgBox "Ruote non selezionate",vbCritical
Exit Sub
End If
ReDim aRitPerRigo(cMaxRigo,12,3)
For idEstr = Ini To Fin - 1
ReDim aNum(5)
Call GeneraAnaliticoTurbo(idEstr)
nFatte = nFatte + 1
' blocco analisi giocate ==============================
If bEseguiAnalisi Then
If idEstr >= nPrimaEstrGioco And bSuperataProg = False Then
If GetNumeroDaGiocare(aRitPerRigo,nFatte,nIndiceConvMin,nNumInGioc,nRuotaInGioc,nRetIC,nRetIdRigo,nRetRitRigo) Then
nIdProg = nIdProg + 1
If nIdProg <= nColpiProgressione Then
nGiocateTot = nGiocateTot + 1
sTmp = FormatSpace(nGiocateTot,5) & " - "
sTmp = sTmp & GetInfoEstrazione(idEstr ) & " Num : " & Format2(nNumInGioc) & " "
sTmp = sTmp & SiglaRuota(nRuotaInGioc)
sTmp = sTmp & " I.C. : " & FormatSpace (nRetIC ,5 , True)
sTmp = sTmp & " Rigo : " & FormatSpace (nRetIdRigo,5 , True)
sTmp = sTmp & " Ritardo : " & FormatSpace (nRetRitRigo ,5 , True)
sTmp = sTmp & " Costo : " & aPoste(nIdProg)
Call Scrivi(sTmp)
nCapitaleImpegnato = GetCapitaleImpegnato(nIdProg,aRetRigheProgr)
If nCapitaleImpegnato > nMassimaEspos Then nMassimaEspos = nCapitaleImpegnato
If VerificaGiocata(idEstr + 1,nNumInGioc,nRuotaInGioc) Then
nVincitaParz = GetVincitaNetta(nIdProg,aRetRigheProgr)
nTotVincita = nTotVincita + nVincitaParz
sTmp = "VINCENTE ! Vinti : " & nVincitaParz
sTmp = sTmp & " Max Esposizione : " & nMassimaEspos
sTmp = sTmp & " Esposizione corrente : " & nCapitaleImpegnato
sTmp = sTmp & " TotVincita : " & nTotVincita
Call Scrivi(sTmp,True,,vbYellow,vbRed)
nIdProg = 0
End If
Else
Scrivi "Superati i limiti della progressione impostata. Termine analisi"
bSuperataProg = True
End If
End If
End If
End If
'======================================================
For nRuota = 1 To 12
If nRuota <> 11 And abRuote(nRuota) Then
Call GetArrayNumeriRuota(idEstr + 1,nRuota,aNum)
ReDim aBNumEstrSucc(90)
For p = 1 To 5
aBNumEstrSucc(aNum(p)) = True
Next
For nRit = 0 To cMaxRigo
nSfald = 0
'bValida = False
For p = 1 To 5
n = TabelloneAnaliticoTurbo(nRit,nRuota,p)
'If n >0 Then bValida = True
If n > 0 Then
If aBNumEstrSucc(n) Then
nSfald = nSfald + 1
End If
End If
Next
'If bValida Then
If nSfald >= cSorte Then
If aRitPerRigo(nRit,nRuota,cIdRit) > aRitPerRigo(nRit,nRuota,cIdRitMax) Then
aRitPerRigo(nRit,nRuota,cIdRitMax) = aRitPerRigo(nRit,nRuota,cIdRit)
End If
aRitPerRigo(nRit,nRuota,cIdRit) = 0
aRitPerRigo(nRit,nRuota,cIdFreq) = aRitPerRigo(nRit,nRuota,cIdFreq) + 1
Else
aRitPerRigo(nRit,nRuota,cIdRit) = aRitPerRigo(nRit,nRuota,cIdRit) + 1
End If
'End If
If ScriptInterrotto Then Exit For
Next
End If
If ScriptInterrotto Then Exit For
Next
Call AvanzamentoElab(1,nDaFare,nFatte)
If ScriptInterrotto Then Exit For
Next
If bEseguiAnalisi Then
Call Scrivi
Call Scrivi("Giocate eseguite : " & nGiocateTot)
Call Scrivi("Massima esposizione : " & nMassimaEspos)
Call Scrivi("Vincita netta : " & nTotVincita)
Call Scrivi
End If
ReDim aV(7)
aV(1) = "Rigo"
aV(2) = "Ritardo"
aV(3) = "RitardoMax"
aV(4) = "Frequenza"
aV(5) = "Ruota"
aV(6) = "NumPresRigoAttuale"
aV(7) = "IndiceConv"
Call GeneraAnaliticoTurbo(Fin )
Messaggio "Creazione tabella"
If MsgBox("Mostrare solo le righe alla cui posizione nel tab analitico sono effettivamente presenti dei numeri ?",vbQuestion + vbYesNo) = vbYes Then
bMostraSoloRigheConNimeri = True
End If
DoEventsEx
Call InitTabella(aV)
For nRuota = 1 To 12
If nRuota <> 11 And abRuote(nRuota) Then
For k = 0 To cMaxRigo
aV(1) = k
aV(2) = aRitPerRigo(k,nRuota,cIdRit)
aV(3) = aRitPerRigo(k,nRuota,cIdRitMax)
aV(4) = aRitPerRigo(k,nRuota,cIdFreq)
aV(5) = NomeRuota(nRuota)
sNum = ""
For p = 1 To 5
n = TabelloneAnaliticoTurbo(k,nRuota,p)
sNum = Iif(n > 0,sNum & n & ".",sNum)
Next
sNum = RimuoviLastChr(sNum,".")
bValida = False
If bMostraSoloRigheConNimeri Then
If sNum <> "" Then bValida = True
Else
bValida = True
End If
If bValida Then
aV(6) = sNum
aV(7) = Round(Dividi(aRitPerRigo(k,nRuota,cIdRit),Dividi(nFatte,aRitPerRigo(k,nRuota,cIdFreq))),3)
Call AddRigaTabella(aV)
End If
Next
End If
Next
Call Scrivi("Inizio : " & GetInfoEstrazione(Ini))
Call Scrivi("Fine : " & GetInfoEstrazione(Fin))
Call CreaTabella(2)
End Sub
Function GetCapitaleImpegnato(nIdProg,aRigheProgr)
ReDim aV(0)
Call SplitByChar(aRigheProgr(nIdProg),"|",aV)
GetCapitaleImpegnato = CDbl(Trim(aV(4)))
End Function
Function GetVincitaNetta(nIdProg,aRigheProgr)
ReDim aV(0)
Call SplitByChar(aRigheProgr(nIdProg),"|",aV)
GetVincitaNetta = CDbl(Trim(aV(7)))
End Function
Function VerificaGiocata(idEstr,nNumGiocato,nRuota)
Dim k
ReDim aNum(0)
Dim bRet
bRet = False
Call GetArrayNumeriRuota(idEstr,nRuota,aNum)
For k = 1 To 5
If aNum(k) = nNumGiocato Then
bRet = True
Exit For
End If
Next
VerificaGiocata = bRet
End Function
Function GetNumeroDaGiocare(aRitPerRigo,nFatte,nIndiceConvMin,nRetNumInGioc,nRetRuotaInGioc,nRetIC,nRetIdRigo,nRetRitRigo)
Dim k,p,nQ,n,nIc,nRuota,nIndiceConvTrov, nNumDaGioc
nIndiceConvTrov = nIndiceConvMin
nRetNumInGioc = 0
nRetRuotaInGioc = 0
nRetIC = 0
nRetIdRigo = 0
nRetRitRigo = 0
For k = LBound(aRitPerRigo) To UBound(aRitPerRigo)
For nRuota = 1 To 12
If nRuota <> 11 Then
nIc = Round(Dividi(aRitPerRigo(k,nRuota,cIdRit),Dividi(nFatte,aRitPerRigo(k,nRuota,cIdFreq))),3)
If nIc >= nIndiceConvTrov Then
nQ = 0
nNumDaGioc =0
For p = 1 To 5
n = TabelloneAnaliticoTurbo(k,nRuota,p)
If n > 0 Then
nNumDaGioc = n
nQ = nQ + 1
If nQ > 1 Then Exit For
End If
Next
If nQ = 1 Then
nRetNumInGioc = nNumDaGioc
nRetRuotaInGioc = nRuota
nIndiceConvTrov = nIc
nRetIC = nIndiceConvTrov
nRetIdRigo = k
nRetRitRigo = aRitPerRigo(k,nRuota,cIdRit)
End If
End If
End If
Next
Next
GetNumeroDaGiocare = nRetNumInGioc > 0
End Function
Function ScegliProcedura()
Dim aVoci
aVoci = Array("Istruzioni","Visualizza progressione","Analisi + statistica","Solo statistica")
ScegliProcedura = ScegliOpzioneMenu(aVoci,0)
End Function
Sub ScriviIstruzioni
Dim sTesto
sTesto = "Lo script analizza i ritardi di rigo del tabellone analitico all'interno del range impostato" & vbCrLf
sTesto = sTesto & "nel programma." & vbCrLf
sTesto = sTesto & "Possono essere analizzate tutte le ruote ma non si puo scegliere la ruota TUTTE" & vbCrLf
sTesto = sTesto & "Un rigo del tabellone analitico si sfalda se all'estrazione successiva sulla stessa ruota esce" & vbCrLf
sTesto = sTesto & "uno dei numeri in esso contenuti" & vbCrLf
Call Scrivi(sTesto)
sTesto = "Al termine dell'analisi verra mostrata una tabella con la situazione attuale ovvero quella che" & vbCrLf
sTesto = sTesto & "si configura nel momento dell'estrazione identificata come fine range analizzato." & vbCrLf
Call Scrivi(sTesto)
sTesto = "E' anche possibile analizzare la strategia di gioco indicando da quale estrazione all'interno del" & vbCrLf
sTesto = sTesto & "range analizzato iniziare a giocare." & vbCrLf
sTesto = sTesto & "A tale scopo bisogna fornire i parametri per il calcolo della progressione da applicare." & vbCrLf
sTesto = sTesto & "Indicando un valore minimo per l' INDICE DI CONVENIENZA lo script giochera il numero" & vbCrLf
sTesto = sTesto & "presente nel rigo con l'indice di convenienza piu alto maggiore o uguale al minimo previsto." & vbCrLf
sTesto = sTesto & "N.B verranno considerati e giocate solo le righe del Tab analitico nel cui spazio si trovi un solo numero." & vbCrLf
sTesto = sTesto & "Ovvero verra giocato il rigo con indice di convenienza piu alto in cui sia presente un solo numero." & vbCrLf
sTesto = sTesto & "Se durante l'analisi delle giocate si superano i colpi previsti dalla progressione il gioco sarà interrotto con perdita." & vbCrLf
sTesto = sTesto & "e verrà interrotta l'analisi sulle giocate mentre la statistica continuera fino alla fine." & vbCrLf
Call Scrivi(sTesto)
sTesto = "Per cercare di non andare in perdita è opportuno impostare un congruo numero di colpi per la progressione" & vbCrLf
sTesto = sTesto & "da usare. Questo prevede di avere a disposizione un discreto capitale da investire per ricavare somme" & vbCrLf
sTesto = sTesto & "modeste per non dire irrisorie in confronto al capitale esposto al rischio." & vbCrLf
Call Scrivi(sTesto,True,,,vbRed)
End Sub
Sub VisualizzaProgressione
Dim nPostaIniziale,nPercGuadagno,nColpiProgressione,k
ReDim aPoste(0)
ReDim aRetRigheProgr(0)
nColpiProgressione = CInt(InputBox("Inserire la quantita di colpi potenziali per la progressione","Colpi progressione",5))
nPostaIniziale = CInt(InputBox("Inserire la posta per la prima giocata","Posta",1))
nPercGuadagno = CInt(InputBox("Inserire la percentuale di guadagno minima per calcolare la progressione","Percentuale guadagno",10))
If nColpiProgressione > 0 And nPostaIniziale > 0 And nPercGuadagno > 0 Then
Call GetVettoreProgressione(1,1,1,nColpiProgressione,aPoste,aRetRigheProgr,1,1,0,nPercGuadagno,nPostaIniziale)
For k = 0 To UBound(aRetRigheProgr)
Call Scrivi(aRetRigheProgr(k))
Next
Else
MsgBox "Parametri non validi",vbCritical
End If
End Sub
Function VerificaParametriGioco(Ini,Fin,nPrimaEstrGioco,nPercGuadagno,nPostaIniziale,nIndiceConvMin,nColpiProgressione)
Dim sMsg
sMsg = ""
If nPrimaEstrGioco < Ini Or nPrimaEstrGioco > Fin Then
sMsg = "Prima estrazione di gioco non valida"
End If
If nPercGuadagno <= 0 Or nPercGuadagno > 100 Then
sMsg = "Percentuale di guadagno sul capitale impiegato non valida"
End If
If nPostaIniziale <= 0 Then
sMsg = "Posta iniziale non valida"
End If
If nIndiceConvMin <= 0 Then
sMsg = "Indice convenienza minimo non valido"
End If
If nColpiProgressione <= 0 Then
sMsg = "Impostare il numero di colpi per la progressione"
End If
If sMsg <> "" Then
MsgBox sMsg,vbCritical
Else
VerificaParametriGioco = True
End If
End Function