A Simple Wheel Generator

iziplay · March 15, 2017

Jadex (Douglas Paul Smalish) released a windows version

The links for download can be done at these below:

http://www.jadexcode.com/files/programs/asimplewheelgenerator.exe

http://mail1.mediacombb.net/home/jadexcode@mediacombb.net/Files/Applications/ASimpleWheelGenerator.exe

ftp://www.jadexcode.com/applications/ASimpleWheelGenerator.exe

This is a very basic wheel generator.

We released the source code a while back in a post here at the Lottery Post, A Simple Wheel Generator Source.

In the image below, it shows the simple layout.

The settings are: Set, Pick, Match and Win.

Set is the quantity of numbers used to make a combination.

Pick is the size of the lottery's drawing, i.e. Pick 6, Pick 5.

Match is how many drawn numbers match the set of numbers used.

Win is how many drawn numbers appear in at least 1 combination.

These are explained in the Condition section of the displayed wheel.

Changing these setting and pressing Build will generate a new wheel.

Each wheel, depending on the settings, will create a different wheel each time and a different wheel than everyone else.

You can also start the application multiple times to have more than one program running at the same time.

The wheel can be displayed with line numbers and the combos can have the spaces replaced with tabs.

The tabbing works well with Excel when pasting a copy of a wheel; it allows the numbers to be placed in different columns.

iziplay · March 15, 2017

Para maiores detalhes visitem o link de publicação

https://www.lotterypost.com/thread/311357

Bons estudos e Sucesso.

Edited March 15, 2017 by pauloeasy

iziplay · March 15, 2017

Codigo fonte para amigos que queiram aprofundar a ferramenta

https://www.lotterypost.com/thread/228056

DixieJoe · March 15, 2017

Valeu mesmo, pauloeasy,

Mais uma excelente ferramenta para construção de Wheels.

Jimmy · March 15, 2017

Obrigado pela colaboração com a comunidade.

Obs. movi para o fórum de programas.

Gnostico · March 15, 2017

Valeu pauloeasy , obrigado por compartilhar esta ferramenta conosco.

Jmil21 · March 16, 2017

Para melhor entendemos o post, segue abaixo a tradução do mesmo!

-----------------------------------------------------------------------------------------------

Jadex (Douglas Paul Smalish) lançou uma versão do windows

Um gerador simples da roda

Os links para download podem ser feitos abaixo:
Http://www.jadexcode.com/files/programs/asimplewheelgenerator.exe
Http://mail1.mediacombb.net/home/jadexcode@mediacombb.net/Files/Applications/ASimpleWheelGenerator.exe
Ftp://www.jadexcode.com/applications/ASimpleWheelGenerator.exe

Este é um gerador de rodas muito básico.
Nós lançamos o código fonte um tempo atrás em um post aqui no Post Lottery, uma fonte simples gerador de roda.
Na imagem abaixo, ele mostra o layout simples.
As configurações são: Set, Pick, Match e Win.
Conjunto é a quantidade de números usados para fazer uma combinação.
Pick é o tamanho do desenho da loteria, ou seja, Pick 6, Pick 5.
Correspondência é como muitos números desenhados correspondem ao conjunto de números usados.
Win é o número de números desenhados que aparecem em pelo menos uma combinação.
Estes são explicados na seção Condição da roda exibida.
Alterar essas configurações e pressionar Build gerará uma nova roda.
Cada roda, dependendo das configurações, irá criar uma roda diferente cada vez e uma roda diferente do que todos os outros.
Você também pode iniciar o aplicativo várias vezes para ter mais de um programa em execução ao mesmo tempo.
A roda pode ser exibida com números de linha e os combos podem ter os espaços substituídos por guias.
A tabulação funciona bem com o Excel ao colar uma cópia de uma roda; Permite que os números sejam colocados em colunas diferentes.

mikedj · August 27, 2022

Em 15/03/2017 em 07:31, iziplay disse:

Jadex (Douglas Paul Smalish) released a windows version

A Simple Wheel Generator

The links for download can be done at these below:

http://www.jadexcode.com/files/programs/asimplewheelgenerator.exe

http://mail1.mediacombb.net/home/jadexcode@mediacombb.net/Files/Applications/ASimpleWheelGenerator.exe

ftp://www.jadexcode.com/applications/ASimpleWheelGenerator.exe

This is a very basic wheel generator.

We released the source code a while back in a post here at the Lottery Post, A Simple Wheel Generator Source.

In the image below, it shows the simple layout.

The settings are: Set, Pick, Match and Win.

Set is the quantity of numbers used to make a combination.

Pick is the size of the lottery's drawing, i.e. Pick 6, Pick 5.

Match is how many drawn numbers match the set of numbers used.

Win is how many drawn numbers appear in at least 1 combination.

These are explained in the Condition section of the displayed wheel.

Changing these setting and pressing Build will generate a new wheel.

Each wheel, depending on the settings, will create a different wheel each time and a different wheel than everyone else.

You can also start the application multiple times to have more than one program running at the same time.

The wheel can be displayed with line numbers and the combos can have the spaces replaced with tabs.

The tabbing works well with Excel when pasting a copy of a wheel; it allows the numbers to be placed in different columns.

Infelizmente os links estão quebrados

RobSmith · August 27, 2022

40 minutos atrás, mikedj disse:

Infelizmente os links estão quebrados

Pode se gerar o executavel pois o codigo fonte está nesta pagina

https://www.lotterypost.com/thread/228056

Spoiler

MainPage.xaml
_____________________________________________________

_____________________________________________________

MainPage.xaml.vb
_____________________________________________________

Partial Public Class MainPage
Inherits UserControl

Private WithEvents BackgroundWorker1 As New System.ComponentModel.BackgroundWorker

Public Sub New()
InitializeComponent()
BackgroundWorker1.WorkerReportsProgress = True
BackgroundWorker1.WorkerSupportsCancellation = True
End Sub

Private Sub MainPage_Loaded(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles Me.Loaded
Randomize(Microsoft.VisualBasic.Timer)
End Sub

Private Sub BackgroundWorker1_RunWorkerCompleted(ByVal sender As Object, ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles BackgroundWorker1.RunWorkerCompleted
If e.Error IsNot Nothing Then
txtProgressUpdate.Text = "Build Error!"
TextBox1.Text = "We're sorry." & vbCrLf & vbCrLf & "An error has occurred." & vbCrLf & vbCrLf & "Please try again with different settings."
ElseIf e.Cancelled Then
txtProgressUpdate.Text = "Build Canceled."
Else
txtProgressUpdate.Text = "Build Done."
End If
ProgressBar1.Value = 0
sliderSet.IsEnabled = True
sliderPick.IsEnabled = True
sliderMatch.IsEnabled = True
sliderWin.IsEnabled = True
cmdBuild.IsEnabled = True
cmdCancel.IsEnabled = False
TextBox1.IsEnabled = True
chkIncludeIndexNumbers.IsEnabled = True
End Sub

Private Sub BackgroundWorker1_ProgressChanged(ByVal sender As Object, ByVal e As System.ComponentModel.ProgressChangedEventArgs) Handles BackgroundWorker1.ProgressChanged
Dim stateUpdate As WheelGenerator.StatusUpdate = CType(e.UserState, WheelGenerator.StatusUpdate)
ProgressBar1.Value = stateUpdate.ProgressPercentagePer1000
txtProgressUpdate.Text = stateUpdate.ProgressInformation
If (stateUpdate.WheelInformation <> "") Then
TextBox1.Text = stateUpdate.WheelInformation
End If
End Sub

Private Sub BackgroundWorker1_DoWork(ByVal sender As Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
Dim worker As System.ComponentModel.BackgroundWorker
worker = CType(sender, System.ComponentModel.BackgroundWorker)
Dim WG As WheelGenerator = CType(e.Argument, WheelGenerator)
WG.GenerateWheel(worker, e)
End Sub

Sub StartThread()
TextBox1.Text = ""
txtProgressUpdate.Text = ""
Dim WG As WheelGenerator = New WheelGenerator
WG.N = Val(Set_Value.Text)
WG.R = Val(Pick_Value.Text)
WG.X = Val(Match_Value.Text)
WG.Y = Val(Win_Value.Text)
If chkIncludeIndexNumbers.IsChecked Then
WG.IncludeIndexNumbers = True
Else
WG.IncludeIndexNumbers = False
End If
BackgroundWorker1.RunWorkerAsync(WG)
End Sub

Private Sub cmdBuild_Click(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles cmdBuild.Click
TextBox1.Text = ""
sliderSet.IsEnabled = False
sliderPick.IsEnabled = False
sliderMatch.IsEnabled = False
sliderWin.IsEnabled = False
cmdBuild.IsEnabled = False
cmdCancel.IsEnabled = True
TextBox1.IsEnabled = False
chkIncludeIndexNumbers.IsEnabled = False
StartThread()
End Sub

Private Sub cmdCancel_Click(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles cmdCancel.Click
BackgroundWorker1.CancelAsync()
End Sub

Function MaxR(ByVal N As Integer) As Integer
Select Case N
Case Is = 1
MaxR = 1
Case Is = 2
MaxR = 2
Case Is = 3
MaxR = 3
Case Is = 4, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99
MaxR = 4
Case Is = 5, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71
MaxR = 5
Case Is = 6, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49
MaxR = 6
Case Is = 7, 34, 35, 36, 37, 38
MaxR = 7
Case Is = 8, 30, 31, 32, 33
MaxR = 8
Case Is = 9, 29
MaxR = 9
Case Is = 10, 28
MaxR = 10
Case Is = 11, 27
MaxR = 11
Case Is = 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26
MaxR = 12
End Select
End Function

Private Sub sliderSet_ValueChanged(ByVal sender As Object, ByVal e As System.Windows.RoutedPropertyChangedEventArgs(Of Double)) Handles sliderSet.ValueChanged
Set_Value.Text = Int(sliderSet.Value)
If Val(Pick_Value.Text) > MaxR(Val(Set_Value.Text)) Then
If Val(Pick_Value.Text) > MaxR(Val(Set_Value.Text)) Then
Pick_Value.Text = MaxR(Val(Set_Value.Text)).ToString
sliderPick.Value = MaxR(Val(Set_Value.Text))
End If
sliderPick.Maximum = MaxR(Val(Set_Value.Text))
Pick_Range.Text = "[1 to " & MaxR(Val(Set_Value.Text)).ToString & "]"
Else
sliderPick.Maximum = MaxR(Val(Set_Value.Text))
Pick_Range.Text = "[1 to " & MaxR(Val(Set_Value.Text)).ToString & "]"
End If
End Sub

Private Sub sliderPick_ValueChanged(ByVal sender As Object, ByVal e As System.Windows.RoutedPropertyChangedEventArgs(Of Double)) Handles sliderPick.ValueChanged
Pick_Value.Text = Int(sliderPick.Value)
If Val(Match_Value.Text) > Val(Pick_Value.Text) Then
If Val(Match_Value.Text) > Val(Pick_Value.Text) Then
Match_Value.Text = Val(Pick_Value.Text).ToString
sliderMatch.Value = Val(Pick_Value.Text)
End If
sliderMatch.Maximum = Val(Pick_Value.Text)
Match_Range.Text = "[1 to " & Val(Pick_Value.Text).ToString & "]"
Else
sliderMatch.Maximum = Val(Pick_Value.Text)
Match_Range.Text = "[1 to " & Val(Pick_Value.Text).ToString & "]"
End If
End Sub

Private Sub sliderMatch_ValueChanged(ByVal sender As Object, ByVal e As System.Windows.RoutedPropertyChangedEventArgs(Of Double)) Handles sliderMatch.ValueChanged
Match_Value.Text = Int(sliderMatch.Value)
If Val(Win_Value.Text) > Val(Match_Value.Text) Then
If Val(Win_Value.Text) > Val(Match_Value.Text) Then
Win_Value.Text = Val(Match_Value.Text).ToString
sliderWin.Value = Val(Match_Value.Text)
End If
sliderWin.Maximum = Val(Match_Value.Text)
Win_Range.Text = "[1 to " & Val(Match_Value.Text).ToString & "]"
Else
sliderWin.Maximum = Val(Match_Value.Text)
Win_Range.Text = "[1 to " & Val(Match_Value.Text).ToString & "]"
End If
End Sub

Private Sub sliderWin_ValueChanged(ByVal sender As Object, ByVal e As System.Windows.RoutedPropertyChangedEventArgs(Of Double)) Handles sliderWin.ValueChanged
Win_Value.Text = Int(sliderWin.Value)
End Sub

End Class

_____________________________________________________

WheelGenerator.vb
_____________________________________________________

Public Class WheelGenerator
Public Class StatusUpdate
Public ProgressPercentagePer1000 As Integer
Public ProgressInformation As String
Public WheelInformation As String
End Class

Public N, R, X, Y As Integer
Public IncludeIndexNumbers As Boolean
Const IndexMax As Integer = 13983816
Private Numbers(IndexMax, 12) As Byte

Public Sub GenerateWheel(ByVal worker As System.ComponentModel.BackgroundWorker, ByVal e As System.ComponentModel.DoWorkEventArgs)
Dim T, Z, Zs, Zremain, Pos, Count, Index, MissingNumbers, MissingSelection, MissingIndex, RandNumRemain As Integer
Dim NumRemain As String = ""
Dim tempWheel As String = ""
Dim UpdateStatus As New StatusUpdate
UpdateStatus.ProgressPercentagePer1000 = 0
UpdateStatus.ProgressInformation = ""
UpdateStatus.WheelInformation = ""
Randomize(Microsoft.VisualBasic.Timer)
tempWheel = "Condition" & vbCrLf
If X > 1 Then
tempWheel &= "- If " & X.ToString & " Drawn Numbers are in the Set of " & N.ToString & " Numbers," & vbCrLf
Else
tempWheel &= "- If " & X.ToString & " Drawn Number is in the Set of " & N.ToString & " Numbers," & vbCrLf
End If
If Y > 1 Then
tempWheel &= "- Then at least 1 Combination has " & Y.ToString & " Winning Numbers." & vbCrLf
Else
tempWheel &= "- Then at least 1 Combination has " & Y.ToString & " Winning Number." & vbCrLf
End If
tempWheel &= "____________________________________________" & vbCrLf
T = Comb(N, R)
Z = Comb(N, X)
UpdateStatus.ProgressInformation = "Clearing Combination Set..."
worker.ReportProgress(0, UpdateStatus)
For a = 0 To Z
If worker.CancellationPending Then
e.Cancel = True
Exit Sub
End If
For b As Integer = 0 To 12
Numbers(a, b) = &H0
Next
Select Case Z
Case Is > 100
If Modulus(a, Int(Z / 100)) = 0 Then
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (a / Z))
worker.ReportProgress(0, UpdateStatus)
End If
Case Else
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (a / Z))
worker.ReportProgress(0, UpdateStatus)
End Select
Next
UpdateStatus.ProgressPercentagePer1000 = 0
If Y < R Then
UpdateStatus.ProgressInformation = "Building Match Condition..."
worker.ReportProgress(0, UpdateStatus)
For a As Integer = 1 To Z
WriteCombination(a, Index2Combin(N, X, a), WriteCombin.Add)
If worker.CancellationPending Then
e.Cancel = True
Exit Sub
End If
Select Case Z
Case Is > 100
If Modulus(a, Int(Z / 100)) = 0 Then
UpdateStatus.ProgressInformation = "Building Match Condition... " & Index2Combin(N, X, a)
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (a / Z))
worker.ReportProgress(0, UpdateStatus)
End If
Case Else
UpdateStatus.ProgressInformation = "Building Match Condition... " & Index2Combin(N, X, a)
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (a / Z))
worker.ReportProgress(0, UpdateStatus)
End Select
Next
UpdateStatus.ProgressInformation = "Building Win Condition..."
worker.ReportProgress(0, UpdateStatus)
Zremain = Z
Index = 0
Do
Zs = RandomLowerUpper(1, Zremain)
Pos = 0
Count = 0
Do
Pos += 1
If (CSTEBit(BitState.ExmBit, Numbers(Pos, 12), 4) = &H0) And (CSTEBit(BitState.ExmBit, Numbers(Pos, 12), 5) = &H0) Then
Count += 1
End If
Loop Until Count = Zs
Numbers(Pos, 12) = CSTEBit(BitState.SetBit, Numbers(Pos, 12), 4)
Zremain -= 1
Select Case Z
Case Is > 100
If Modulus(Zremain, Int(Z / 100)) = 0 Then
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (Zremain / Z))
worker.ReportProgress(0, UpdateStatus)
End If
Case Else
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (Zremain / Z))
worker.ReportProgress(0, UpdateStatus)
End Select
For a = 1 To Z
If worker.CancellationPending Then
e.Cancel = True
Exit Sub
End If
If (CSTEBit(BitState.ExmBit, Numbers(a, 12), 4) = &H0) And (CSTEBit(BitState.ExmBit, Numbers(a, 12), 5) = &H0) Then
If CompareCombination(a, ReadCombination(Pos, N, ReadCombin.GetStoredNumbers)) >= Y Then
Numbers(a, 12) = CSTEBit(BitState.SetBit, Numbers(a, 12), 5)
Zremain -= 1
Select Case Z
Case Is > 100
If Modulus(Zremain, Int(Z / 100)) = 0 Then
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (Zremain / Z))
worker.ReportProgress(0, UpdateStatus)
End If
Case Else
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (Zremain / Z))
worker.ReportProgress(0, UpdateStatus)
End Select
End If
End If
Next
If X < R Then
For a = X + 1 To R
NumRemain = ReadCombination(Pos, N, ReadCombin.GetNotStoredNumbers)
RandNumRemain = RandomLowerUpper(1, Int(Len(NumRemain) / 3))
WriteCombination(Pos, ReadCombination(Pos, N, ReadCombin.GetStoredNumbers) & Mid(NumRemain, 3 * RandNumRemain - 2, 3), WriteCombin.Add)
Next
For a = 1 To Z
If (CSTEBit(BitState.ExmBit, Numbers(a, 12), 4) = &H0) And (CSTEBit(BitState.ExmBit, Numbers(a, 12), 5) = &H0) Then
If CompareCombination(a, ReadCombination(Pos, N, ReadCombin.GetStoredNumbers)) >= Y Then
Numbers(a, 12) = CSTEBit(BitState.SetBit, Numbers(a, 12), 5)
Zremain -= 1
Select Case Z
Case Is > 100
If Modulus(Zremain, Int(Z / 100)) = 0 Then
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (Zremain / Z))
worker.ReportProgress(0, UpdateStatus)
End If
Case Else
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (Zremain / Z))
worker.ReportProgress(0, UpdateStatus)
End Select
End If
End If
Next
End If
Index += 1
WriteCombination(0, ReadCombination(Pos, N, ReadCombin.GetStoredNumbers), WriteCombin.Add)
If IncludeIndexNumbers Then
tempWheel &= Format(Index, "00000000 - ") & ReadCombination(Pos, N, ReadCombin.GetStoredNumbers) & vbCrLf
UpdateStatus.ProgressInformation = "Building Win Condition... " & Format(Index, "00000000 - ") & ReadCombination(Pos, N, ReadCombin.GetStoredNumbers)
Else
tempWheel &= ReadCombination(Pos, N, ReadCombin.GetStoredNumbers) & vbCrLf
UpdateStatus.ProgressInformation = "Building Win Condition... " & ReadCombination(Pos, N, ReadCombin.GetStoredNumbers)
End If
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (Zremain / Z))
worker.ReportProgress(0, UpdateStatus)
Loop Until Zremain = 0
If Len(ReadCombination(0, N, ReadCombin.GetNotStoredNumbers)) / 3 <> 0 Then
MissingNumbers = Len(ReadCombination(0, N, ReadCombin.GetNotStoredNumbers)) / 3
Count = 0
For a = 1 To Z
If (CompareCombination(a, ReadCombination(0, N, ReadCombin.GetNotStoredNumbers)) = MissingNumbers) And (CSTEBit(BitState.ExmBit, Numbers(a, 12), 5) = &H1) Then
Count += 1
End If
Select Case Z
Case Is > 100
If Modulus(a, Int(Z / 100)) = 0 Then
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (a / Z))
worker.ReportProgress(0, UpdateStatus)
End If
Case Else
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (a / Z))
worker.ReportProgress(0, UpdateStatus)
End Select
Next
MissingSelection = RandomLowerUpper(1, Count)
Count = 0
MissingIndex = 0
Do
MissingIndex += 1
If (CompareCombination(MissingIndex, ReadCombination(0, N, ReadCombin.GetNotStoredNumbers)) = MissingNumbers) And (CSTEBit(BitState.ExmBit, Numbers(MissingIndex, 12), 5) = &H1) Then
Count += 1
End If
Select Case Z
Case Is > 100
If Modulus(MissingIndex, Int(Z / 100)) = 0 Then
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (MissingIndex / Z))
worker.ReportProgress(0, UpdateStatus)
End If
Case Else
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (MissingIndex / Z))
worker.ReportProgress(0, UpdateStatus)
End Select
Loop Until Count = MissingSelection
UpdateStatus.ProgressPercentagePer1000 = 0
worker.ReportProgress(0, UpdateStatus)
Numbers(MissingIndex, 12) = CSTEBit(BitState.TogBit, Numbers(MissingIndex, 12), 4)
Numbers(MissingIndex, 12) = CSTEBit(BitState.TogBit, Numbers(MissingIndex, 12), 5)
If X < R Then
For a = X + 1 To R
NumRemain = ReadCombination(MissingIndex, N, ReadCombin.GetNotStoredNumbers)
RandNumRemain = RandomLowerUpper(1, Int(Len(NumRemain) / 3))
WriteCombination(MissingIndex, ReadCombination(MissingIndex, N, ReadCombin.GetStoredNumbers) & Mid(NumRemain, 3 * RandNumRemain - 2, 3), WriteCombin.Add)
Next
End If
Index += 1
If IncludeIndexNumbers Then
tempWheel &= Format(Index, "00000000 - ") & ReadCombination(MissingIndex, N, ReadCombin.GetStoredNumbers) & vbCrLf
Else
tempWheel &= ReadCombination(MissingIndex, N, ReadCombin.GetStoredNumbers) & vbCrLf
End If
End If
Else
For a = 1 To T
If worker.CancellationPending Then
e.Cancel = True
Exit Sub
End If
If IncludeIndexNumbers Then
tempWheel &= Format(a, "00000000 - ") & Index2Combin(N, R, a) & vbCrLf
UpdateStatus.ProgressInformation = "Building Win Condition... " & Format(a, "00000000 - ") & Index2Combin(N, R, a)
Else
tempWheel &= Index2Combin(N, R, a) & vbCrLf
UpdateStatus.ProgressInformation = "Building Win Condition... " & Index2Combin(N, R, a)
End If
Select Case T
Case Is > 100
If Modulus(a, Int(T / 100)) = 0 Then
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (a / T))
worker.ReportProgress(0, UpdateStatus)
End If
Case Else
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (a / T))
worker.ReportProgress(0, UpdateStatus)
End Select
Next
Index = T
End If
tempWheel &= "____________________________________________" & vbCrLf
If Index > 1 Then
UpdateStatus.WheelInformation = "Wheel" & vbCrLf & _
"- Pick " & R.ToString & vbCrLf & _
"- " & N.ToString & " Numbers" & vbCrLf & _
"- " & Format(Index, "##,###,###") & " Combinations" & vbCrLf & _
"- " & Format((Index / T), "##0.######% ") & "Coverage of " & Format(T, "##,###,### ") & "Combinations" & vbCrLf & vbCrLf & tempWheel
Else
UpdateStatus.WheelInformation = "Wheel" & vbCrLf & _
"- Pick " & R.ToString & vbCrLf & _
"- " & N.ToString & " Numbers" & vbCrLf & _
"- " & Format(Index, "##,###,###") & " Combination" & vbCrLf & _
"- " & Format((Index / T), "##0.######% ") & "Coverage of " & Format(T, "##,###,### ") & "Combinations" & vbCrLf & vbCrLf & tempWheel
End If
worker.ReportProgress(0, UpdateStatus)
End Sub

Enum WriteCombin
Add = True
Remove = False
End Enum

Enum ReadCombin
GetStoredNumbers = True
GetNotStoredNumbers = False
End Enum

Enum BitState As Byte
ClrBit = 0
SetBit = 1
TogBit = 2
ExmBit = 3
End Enum

Function Modulus(ByVal a As Double, ByVal b As Double) As Long
Modulus = a - b * Int(a / b)
End Function

Function RandomLowerUpper(ByVal L As Long, ByVal U As Long) As Long
RandomLowerUpper = Int(Rnd() * (U - (L - 1))) + L
End Function

Function Fact(ByVal N As Integer) As Double
If (N <= 1) Then
Fact = 1
Else
Fact = N * Fact(N - 1)
End If
End Function

Function Perm(ByVal N As Integer, ByVal R As Integer) As Double
Dim a As Integer
Dim b As Double
b = 1
If (N < R) Then
Perm = 0
Else
For a = (N - (R - 1)) To N
b = b * a
Next a
Perm = b
End If
End Function

Function Comb(ByVal N As Integer, ByVal R As Integer) As Long
If (N < R) Then
Comb = 0
Else
Comb = Perm(N, R) / Fact(R)
End If
End Function

Function Cdist(ByVal N As Integer, ByVal R As Integer, ByVal C As Integer, ByVal Z As Integer) As Long
If ((Z < C) Or (Z > (N - (R - C))) Or (Z > N) Or (C > R) Or (N < 1) Or (R < 1) Or (C < 1) Or (Z < 1)) Then
Cdist = 0
Else
Cdist = Comb((Z - 1), (C - 1)) * Comb((N - Z), (R - C))
End If
End Function

Function fColumnSum(ByVal N As Integer, ByVal R As Integer, ByVal Z As Integer) As Long
Dim a As Integer
Dim ColumnSum As Double
If (Z < 1) Then
fColumnSum = 0
ElseIf ((Z >= 1) And (Z < (N - (R - 1)))) Then
ColumnSum = 0
For a = 1 To Z
ColumnSum = ColumnSum + Cdist(N, R, 1, a)
Next a
fColumnSum = ColumnSum
ElseIf (Z >= (N - (R - 1))) Then
fColumnSum = Comb(N, R)
End If
End Function

Function Index2Combin(ByVal N As Integer, ByVal R As Integer, ByVal I As Long) As String
Dim a, Combination(), Z As Integer
Dim J As Double
ReDim Combination(R)
Dim tmpString As String
Dim NumberFound As Boolean
tmpString = ""
J = I
J = J - 1
Z = 0
For a = 1 To R
If ((I >= 1) And (I <= Comb(N, R))) Then
If (a = 1) Then
Combination(a) = 1
Else
Combination(a) = Combination(a - 1) + 1
End If
NumberFound = False
Do
Select Case (J - fColumnSum((N - Z), (R - (a - 1)), (Combination(a) - (Z + 1))))
Case Is < 0
Combination(a) = Combination(a) - 1
NumberFound = True
Case Is = 0
NumberFound = True
Case Is > 0
Combination(a) = Combination(a) + 1
End Select
Loop Until NumberFound
J = J - fColumnSum((N - Z), (R - (a - 1)), (Combination(a) - (Z + 1)))
Z = Combination(a)
Else
Combination(a) = 0
End If
tmpString = tmpString & Format(Combination(a), "00 ")
Next a
Index2Combin = tmpString
End Function

Function Combin2Index(ByVal N As Integer, ByVal R As Integer, ByVal Combination As String) As Long
Dim a As Integer
Dim fSum As Double
fSum = 1
For a = 1 To R
If (a = 1) Then
fSum = fSum + fColumnSum(N, R, (Val(Mid(Combination, 3 * a - 2, 2)) - 1))
Else
fSum = fSum + fColumnSum((N - Val(Mid(Combination, 3 * (a - 1) - 2, 2))), (R - (a - 1)), (Val(Mid(Combination, 3 * a - 2, 2)) - (Val(Mid(Combination, 3 * (a - 1) - 2, 2)) + 1)))
End If
Next a
Combin2Index = fSum
End Function

Sub WriteCombination(ByVal I As Integer, ByVal Combination As String, ByVal Add As Boolean)
Dim bytPos As Integer
Dim bitPos As Byte
Dim R As Integer
Dim Z As Integer
R = Int(Len(Combination) / 3)
If R <> 0 Then
For a As Integer = 1 To R
Z = CInt(Val(Mid(Combination, 3 * a - 2, 2)))
bytPos = CInt(IntPart(CDbl(Z) / 8))
bitPos = CByte(8 * DecPart(CDbl(Z) / 8))
If Add Then
Numbers(I, bytPos) = CSTEBit(BitState.SetBit, Numbers(I, bytPos), bitPos)
Else
Numbers(I, bytPos) = CSTEBit(BitState.ClrBit, Numbers(I, bytPos), bitPos)
End If
Next
End If
End Sub

Function ReadCombination(ByVal I As Integer, ByVal N As Integer, ByVal GetStoredValues As Boolean) As String
Dim tmpText As String = ""
Dim bytPos As Integer
Dim bitPos As Byte
For a As Byte = 1 To N
bytPos = CInt(IntPart(CDbl(a) / 8))
bitPos = CByte(8 * DecPart(CDbl(a) / 8))
If GetStoredValues Then
If CSTEBit(BitState.ExmBit, Numbers(I, bytPos), bitPos) = 1 Then
tmpText &= Format(a, "00 ")
End If
Else
If CSTEBit(BitState.ExmBit, Numbers(I, bytPos), bitPos) = 0 Then
tmpText &= Format(a, "00 ")
End If
End If
Next
ReadCombination = tmpText
End Function

Function CompareCombination(ByVal I As Integer, ByVal Combination As String) As Integer
Dim T As Integer = 0
Dim bytPos As Integer
Dim bitPos As Byte
For a As Integer = 1 To Int(Len(Combination) / 3)
bytPos = CInt(IntPart(CDbl(Val(Mid(Combination, 3 * a - 2, 2))) / 8))
bitPos = CByte(8 * DecPart(CDbl(Val(Mid(Combination, 3 * a - 2, 2))) / 8))
T += CSTEBit(BitState.ExmBit, Numbers(I, bytPos), bitPos)
Next
CompareCombination = T
End Function

Public Function CSTEBit(ByVal CSTE As Byte, ByVal Byt As Byte, ByVal Bit As Byte) As Byte
If Bit < 8 Then
Dim Mask As Byte = 2 ^ Bit
Select Case CSTE
Case BitState.ClrBit
Return Byt And Not Mask
Case BitState.SetBit
Return Byt Or Mask
Case BitState.TogBit
Return Byt Xor Mask
Case BitState.ExmBit
If ((Byt And Mask) > 0) Then
Return 1
Else
Return 0
End If
Case Else
Return Byt
End Select
Else
Return Byt
End If
End Function

Function IntPart(ByVal n As Double) As Integer
Select Case Math.Sign(n)
Case -1
Return Math.Ceiling(n)
Case 0
Return 0
Case 1
Return Math.Floor(n)
End Select
End Function

Function DecPart(ByVal n As Double) As Double
Select Case Math.Sign(n)
Case -1
Return (n - Math.Ceiling(n))
Case 0
Return 0
Case 1
Return (n - Math.Floor(n))
End Select
End Function

End Class

RobSmith · August 27, 2022

é usado

Silverlight 3 in Visual Basic

mikedj · August 27, 2022

6 minutos atrás, RobSmith disse:

Pode se gerar o executavel pois o codigo fonte está nesta pagina

https://www.lotterypost.com/thread/228056

Mostrar conteúdo oculto

MainPage.xaml
_____________________________________________________

<UserControl x:Class="ASimpleWheelGenerator.MainPage"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" Width="480" Height="640">
<Border Width="480" Height="640" HorizontalAlignment="Left" VerticalAlignment="Top" BorderBrush="#FF929BCF" BorderThickness="1">
<Grid x:Name="LayoutRoot">
<Grid.Background>
<LinearGradientBrush EndPoint="0.5,1" StartPoint="0.5,0">
<GradientStop Color="White" Offset="0"/>
<GradientStop Color="#FFB6C3F3" Offset="1"/>
</LinearGradientBrush>
</Grid.Background>
<Grid>
<TextBlock Height="31" Margin="8,8,8,0" VerticalAlignment="Top" Text="A Simple Wheel Generator" TextWrapping="Wrap" FontFamily="Verdana" FontSize="18.667" TextAlignment="Center"/>
<Slider x:Name="sliderSet" Height="18" Margin="95,59,110,0" VerticalAlignment="Top" Minimum="1" Maximum="99" LargeChange="3" SmallChange="1" Value="15" IsTabStop="False" TabIndex="0"/>
<Slider x:Name="sliderPick" VerticalAlignment="Top" Margin="95,81,110,0" LargeChange="2" Maximum="12" Minimum="1" SmallChange="1" Value="6" Height="18" TabIndex="1" IsTabStop="False"/>
<Slider x:Name="sliderMatch" Margin="95,103,110,0" VerticalAlignment="Top" LargeChange="2" Maximum="6" Minimum="1" SmallChange="1" Value="5" Height="18" TabIndex="2" IsTabStop="False"/>
<Slider x:Name="sliderWin" Margin="95,125,110,0" VerticalAlignment="Top" Maximum="5" Minimum="1" SmallChange="1" Value="4" TabIndex="3" IsTabStop="False"/>
<TextBlock HorizontalAlignment="Left" Margin="44,59,0,0" VerticalAlignment="Top" Text="Set" TextWrapping="Wrap" Width="40" TextAlignment="Right" FontSize="13.333" FontFamily="Verdana"/>
<TextBlock HorizontalAlignment="Left" Margin="44,81,0,0" VerticalAlignment="Top" Text="Pick" TextWrapping="Wrap" Height="16" Width="40" TextAlignment="Right" FontSize="13.333" FontFamily="Verdana"/>
<TextBlock HorizontalAlignment="Left" Margin="44,103,0,0" VerticalAlignment="Top" Text="Match" TextWrapping="Wrap" Height="16" Width="40" TextAlignment="Right" FontSize="13.333" FontFamily="Verdana"/>
<TextBlock HorizontalAlignment="Left" Margin="44,125,0,0" VerticalAlignment="Top" Text="Win" TextWrapping="Wrap" Height="16" Width="40" TextAlignment="Right" FontSize="13.333" FontFamily="Verdana"/>
<TextBlock x:Name="Set_Value" Margin="372,59,87,0" VerticalAlignment="Top" Text="15" TextWrapping="Wrap" TextAlignment="Right" Width="19"/>
<TextBlock x:Name="Pick_Value" Margin="372,81,87,0" VerticalAlignment="Top" Text="6" TextWrapping="Wrap" Width="19" TextAlignment="Right"/>
<TextBlock x:Name="Match_Value" Margin="372,103,87,0" VerticalAlignment="Top" Text="5" TextWrapping="Wrap" Width="19" TextAlignment="Right"/>
<TextBlock x:Name="Win_Value" Margin="372,125,87,0" VerticalAlignment="Top" Text="4" TextWrapping="Wrap" Width="19" TextAlignment="Right"/>
<TextBlock x:Name="Set_Range" Height="16" HorizontalAlignment="Left" Margin="407,59,0,0" VerticalAlignment="Top" Width="56" Text="[1 to 99]" TextWrapping="Wrap"/>
<TextBlock x:Name="Pick_Range" Height="16" HorizontalAlignment="Left" Margin="407,81,0,0" VerticalAlignment="Top" Width="56" Text="[1 to 12]" TextWrapping="Wrap"/>
<TextBlock x:Name="Match_Range" Height="16" HorizontalAlignment="Left" Margin="407,103,0,0" VerticalAlignment="Top" Width="56" Text="[1 to 6]" TextWrapping="Wrap"/>
<TextBlock x:Name="Win_Range" Height="16" HorizontalAlignment="Left" Margin="407,125,0,0" VerticalAlignment="Top" Width="56" Text="[1 to 5]" TextWrapping="Wrap"/>
<TextBlock HorizontalAlignment="Left" Margin="16,43,0,0" VerticalAlignment="Top" TextWrapping="Wrap" FontSize="13.333" FontFamily="Verdana" TextDecorations="Underline"><Run Text="Conditions"/></TextBlock>
<TextBlock HorizontalAlignment="Left" Margin="90,43,0,0" VerticalAlignment="Top" Text=" Value " TextWrapping="Wrap" FontSize="13.333" FontFamily="Verdana" Width="313" TextAlignment="Center" TextDecorations="Underline"/>
<TextBlock Margin="407,43,0,0" VerticalAlignment="Top" Text="Range " TextWrapping="Wrap" FontSize="13.333" FontFamily="Verdana" HorizontalAlignment="Left" Width="56" TextDecorations="Underline"/>
<TextBox x:Name="TextBox1" HorizontalAlignment="Left" Margin="15,239,0,60" Width="448" Text="" TabIndex="6" FontFamily="Verdana" VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Auto" TextWrapping="Wrap" FontSize="13.333"/>
<Button x:Name="cmdBuild" Height="24" Margin="168,156,0,0" VerticalAlignment="Top" Content="Build" HorizontalAlignment="Left" Width="70" TabIndex="5" FontFamily="Verdana"/>
<Button x:Name="cmdCancel" Height="24" Margin="0,156,156,0" VerticalAlignment="Top" Content="Cancel" HorizontalAlignment="Right" Width="70" d:LayoutOverrides="HorizontalAlignment" IsEnabled="False" TabIndex="6" FontFamily="Verdana"/>
<TextBlock Height="48" Margin="16,0,0,8" VerticalAlignment="Bottom" TextWrapping="Wrap" FontSize="9.333" FontFamily="Verdana" HorizontalAlignment="Left" Width="222"><Run Text="To Copy"/><LineBreak/><Run Text="- Click anywhere on the combination list."/><LineBreak/><Run Text="- Use Ctrl+A or Command+A to Select All."/><LineBreak/><Run Text="- Use Ctrl+C or Command+C to Copy."/></TextBlock>
<ProgressBar x:Name="ProgressBar1" Height="10" Margin="15,222,15,0" VerticalAlignment="Top" Maximum="1000" SmallChange="1" Foreground="#FFE47200" Background="#FF5563FF"/>
<TextBox x:Name="txtProgressUpdate" Height="24" Margin="15,191,15,0" VerticalAlignment="Top" Text="" TextWrapping="Wrap" FontFamily="Verdana" FontSize="10.667" IsTabStop="False" IsReadOnly="True"/>
<CheckBox x:Name="chkIncludeIndexNumbers" Height="17" HorizontalAlignment="Right" Margin="0,160,-1,0" VerticalAlignment="Top" Width="158" Content="Include Line Numbers" FontSize="12" FontFamily="Verdana" RenderTransformOrigin="0.5,0.5">
<CheckBox.RenderTransform>
<TransformGroup>
<ScaleTransform ScaleX="0.75" ScaleY="0.75"/>
<SkewTransform/>
<RotateTransform/>
<TranslateTransform/>
</TransformGroup>
</CheckBox.RenderTransform>
</CheckBox>
</Grid>
<TextBlock x:Name="txtVersion" Text="v1.0.10" Height="15" HorizontalAlignment="Right" Margin="0,0,23,8" VerticalAlignment="Bottom" Width="64" TextWrapping="Wrap" FontFamily="Verdana" FontSize="8" TextAlignment="Right"/>
</Grid>
</Border>
</UserControl>

_____________________________________________________

MainPage.xaml.vb
_____________________________________________________

Partial Public Class MainPage
Inherits UserControl

Private WithEvents BackgroundWorker1 As New System.ComponentModel.BackgroundWorker

Public Sub New()
InitializeComponent()
BackgroundWorker1.WorkerReportsProgress = True
BackgroundWorker1.WorkerSupportsCancellation = True
End Sub

Private Sub MainPage_Loaded(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles Me.Loaded
Randomize(Microsoft.VisualBasic.Timer)
End Sub

Private Sub BackgroundWorker1_RunWorkerCompleted(ByVal sender As Object, ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles BackgroundWorker1.RunWorkerCompleted
If e.Error IsNot Nothing Then
txtProgressUpdate.Text = "Build Error!"
TextBox1.Text = "We're sorry." & vbCrLf & vbCrLf & "An error has occurred." & vbCrLf & vbCrLf & "Please try again with different settings."
ElseIf e.Cancelled Then
txtProgressUpdate.Text = "Build Canceled."
Else
txtProgressUpdate.Text = "Build Done."
End If
ProgressBar1.Value = 0
sliderSet.IsEnabled = True
sliderPick.IsEnabled = True
sliderMatch.IsEnabled = True
sliderWin.IsEnabled = True
cmdBuild.IsEnabled = True
cmdCancel.IsEnabled = False
TextBox1.IsEnabled = True
chkIncludeIndexNumbers.IsEnabled = True
End Sub

Private Sub BackgroundWorker1_ProgressChanged(ByVal sender As Object, ByVal e As System.ComponentModel.ProgressChangedEventArgs) Handles BackgroundWorker1.ProgressChanged
Dim stateUpdate As WheelGenerator.StatusUpdate = CType(e.UserState, WheelGenerator.StatusUpdate)
ProgressBar1.Value = stateUpdate.ProgressPercentagePer1000
txtProgressUpdate.Text = stateUpdate.ProgressInformation
If (stateUpdate.WheelInformation <> "") Then
TextBox1.Text = stateUpdate.WheelInformation
End If
End Sub

Private Sub BackgroundWorker1_DoWork(ByVal sender As Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
Dim worker As System.ComponentModel.BackgroundWorker
worker = CType(sender, System.ComponentModel.BackgroundWorker)
Dim WG As WheelGenerator = CType(e.Argument, WheelGenerator)
WG.GenerateWheel(worker, e)
End Sub

Sub StartThread()
TextBox1.Text = ""
txtProgressUpdate.Text = ""
Dim WG As WheelGenerator = New WheelGenerator
WG.N = Val(Set_Value.Text)
WG.R = Val(Pick_Value.Text)
WG.X = Val(Match_Value.Text)
WG.Y = Val(Win_Value.Text)
If chkIncludeIndexNumbers.IsChecked Then
WG.IncludeIndexNumbers = True
Else
WG.IncludeIndexNumbers = False
End If
BackgroundWorker1.RunWorkerAsync(WG)
End Sub

Private Sub cmdBuild_Click(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles cmdBuild.Click
TextBox1.Text = ""
sliderSet.IsEnabled = False
sliderPick.IsEnabled = False
sliderMatch.IsEnabled = False
sliderWin.IsEnabled = False
cmdBuild.IsEnabled = False
cmdCancel.IsEnabled = True
TextBox1.IsEnabled = False
chkIncludeIndexNumbers.IsEnabled = False
StartThread()
End Sub

Private Sub cmdCancel_Click(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles cmdCancel.Click
BackgroundWorker1.CancelAsync()
End Sub

Function MaxR(ByVal N As Integer) As Integer
Select Case N
Case Is = 1
MaxR = 1
Case Is = 2
MaxR = 2
Case Is = 3
MaxR = 3
Case Is = 4, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99
MaxR = 4
Case Is = 5, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71
MaxR = 5
Case Is = 6, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49
MaxR = 6
Case Is = 7, 34, 35, 36, 37, 38
MaxR = 7
Case Is = 8, 30, 31, 32, 33
MaxR = 8
Case Is = 9, 29
MaxR = 9
Case Is = 10, 28
MaxR = 10
Case Is = 11, 27
MaxR = 11
Case Is = 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26
MaxR = 12
End Select
End Function

Private Sub sliderSet_ValueChanged(ByVal sender As Object, ByVal e As System.Windows.RoutedPropertyChangedEventArgs(Of Double)) Handles sliderSet.ValueChanged
Set_Value.Text = Int(sliderSet.Value)
If Val(Pick_Value.Text) > MaxR(Val(Set_Value.Text)) Then
If Val(Pick_Value.Text) > MaxR(Val(Set_Value.Text)) Then
Pick_Value.Text = MaxR(Val(Set_Value.Text)).ToString
sliderPick.Value = MaxR(Val(Set_Value.Text))
End If
sliderPick.Maximum = MaxR(Val(Set_Value.Text))
Pick_Range.Text = "[1 to " & MaxR(Val(Set_Value.Text)).ToString & "]"
Else
sliderPick.Maximum = MaxR(Val(Set_Value.Text))
Pick_Range.Text = "[1 to " & MaxR(Val(Set_Value.Text)).ToString & "]"
End If
End Sub

Private Sub sliderPick_ValueChanged(ByVal sender As Object, ByVal e As System.Windows.RoutedPropertyChangedEventArgs(Of Double)) Handles sliderPick.ValueChanged
Pick_Value.Text = Int(sliderPick.Value)
If Val(Match_Value.Text) > Val(Pick_Value.Text) Then
If Val(Match_Value.Text) > Val(Pick_Value.Text) Then
Match_Value.Text = Val(Pick_Value.Text).ToString
sliderMatch.Value = Val(Pick_Value.Text)
End If
sliderMatch.Maximum = Val(Pick_Value.Text)
Match_Range.Text = "[1 to " & Val(Pick_Value.Text).ToString & "]"
Else
sliderMatch.Maximum = Val(Pick_Value.Text)
Match_Range.Text = "[1 to " & Val(Pick_Value.Text).ToString & "]"
End If
End Sub

Private Sub sliderMatch_ValueChanged(ByVal sender As Object, ByVal e As System.Windows.RoutedPropertyChangedEventArgs(Of Double)) Handles sliderMatch.ValueChanged
Match_Value.Text = Int(sliderMatch.Value)
If Val(Win_Value.Text) > Val(Match_Value.Text) Then
If Val(Win_Value.Text) > Val(Match_Value.Text) Then
Win_Value.Text = Val(Match_Value.Text).ToString
sliderWin.Value = Val(Match_Value.Text)
End If
sliderWin.Maximum = Val(Match_Value.Text)
Win_Range.Text = "[1 to " & Val(Match_Value.Text).ToString & "]"
Else
sliderWin.Maximum = Val(Match_Value.Text)
Win_Range.Text = "[1 to " & Val(Match_Value.Text).ToString & "]"
End If
End Sub

Private Sub sliderWin_ValueChanged(ByVal sender As Object, ByVal e As System.Windows.RoutedPropertyChangedEventArgs(Of Double)) Handles sliderWin.ValueChanged
Win_Value.Text = Int(sliderWin.Value)
End Sub

End Class

_____________________________________________________

WheelGenerator.vb
_____________________________________________________

Public Class WheelGenerator
Public Class StatusUpdate
Public ProgressPercentagePer1000 As Integer
Public ProgressInformation As String
Public WheelInformation As String
End Class

Public N, R, X, Y As Integer
Public IncludeIndexNumbers As Boolean
Const IndexMax As Integer = 13983816
Private Numbers(IndexMax, 12) As Byte

Public Sub GenerateWheel(ByVal worker As System.ComponentModel.BackgroundWorker, ByVal e As System.ComponentModel.DoWorkEventArgs)
Dim T, Z, Zs, Zremain, Pos, Count, Index, MissingNumbers, MissingSelection, MissingIndex, RandNumRemain As Integer
Dim NumRemain As String = ""
Dim tempWheel As String = ""
Dim UpdateStatus As New StatusUpdate
UpdateStatus.ProgressPercentagePer1000 = 0
UpdateStatus.ProgressInformation = ""
UpdateStatus.WheelInformation = ""
Randomize(Microsoft.VisualBasic.Timer)
tempWheel = "Condition" & vbCrLf
If X > 1 Then
tempWheel &= "- If " & X.ToString & " Drawn Numbers are in the Set of " & N.ToString & " Numbers," & vbCrLf
Else
tempWheel &= "- If " & X.ToString & " Drawn Number is in the Set of " & N.ToString & " Numbers," & vbCrLf
End If
If Y > 1 Then
tempWheel &= "- Then at least 1 Combination has " & Y.ToString & " Winning Numbers." & vbCrLf
Else
tempWheel &= "- Then at least 1 Combination has " & Y.ToString & " Winning Number." & vbCrLf
End If
tempWheel &= "____________________________________________" & vbCrLf
T = Comb(N, R)
Z = Comb(N, X)
UpdateStatus.ProgressInformation = "Clearing Combination Set..."
worker.ReportProgress(0, UpdateStatus)
For a = 0 To Z
If worker.CancellationPending Then
e.Cancel = True
Exit Sub
End If
For b As Integer = 0 To 12
Numbers(a, b) = &H0
Next
Select Case Z
Case Is > 100
If Modulus(a, Int(Z / 100)) = 0 Then
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (a / Z))
worker.ReportProgress(0, UpdateStatus)
End If
Case Else
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (a / Z))
worker.ReportProgress(0, UpdateStatus)
End Select
Next
UpdateStatus.ProgressPercentagePer1000 = 0
If Y < R Then
UpdateStatus.ProgressInformation = "Building Match Condition..."
worker.ReportProgress(0, UpdateStatus)
For a As Integer = 1 To Z
WriteCombination(a, Index2Combin(N, X, a), WriteCombin.Add)
If worker.CancellationPending Then
e.Cancel = True
Exit Sub
End If
Select Case Z
Case Is > 100
If Modulus(a, Int(Z / 100)) = 0 Then
UpdateStatus.ProgressInformation = "Building Match Condition... " & Index2Combin(N, X, a)
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (a / Z))
worker.ReportProgress(0, UpdateStatus)
End If
Case Else
UpdateStatus.ProgressInformation = "Building Match Condition... " & Index2Combin(N, X, a)
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (a / Z))
worker.ReportProgress(0, UpdateStatus)
End Select
Next
UpdateStatus.ProgressInformation = "Building Win Condition..."
worker.ReportProgress(0, UpdateStatus)
Zremain = Z
Index = 0
Do
Zs = RandomLowerUpper(1, Zremain)
Pos = 0
Count = 0
Do
Pos += 1
If (CSTEBit(BitState.ExmBit, Numbers(Pos, 12), 4) = &H0) And (CSTEBit(BitState.ExmBit, Numbers(Pos, 12), 5) = &H0) Then
Count += 1
End If
Loop Until Count = Zs
Numbers(Pos, 12) = CSTEBit(BitState.SetBit, Numbers(Pos, 12), 4)
Zremain -= 1
Select Case Z
Case Is > 100
If Modulus(Zremain, Int(Z / 100)) = 0 Then
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (Zremain / Z))
worker.ReportProgress(0, UpdateStatus)
End If
Case Else
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (Zremain / Z))
worker.ReportProgress(0, UpdateStatus)
End Select
For a = 1 To Z
If worker.CancellationPending Then
e.Cancel = True
Exit Sub
End If
If (CSTEBit(BitState.ExmBit, Numbers(a, 12), 4) = &H0) And (CSTEBit(BitState.ExmBit, Numbers(a, 12), 5) = &H0) Then
If CompareCombination(a, ReadCombination(Pos, N, ReadCombin.GetStoredNumbers)) >= Y Then
Numbers(a, 12) = CSTEBit(BitState.SetBit, Numbers(a, 12), 5)
Zremain -= 1
Select Case Z
Case Is > 100
If Modulus(Zremain, Int(Z / 100)) = 0 Then
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (Zremain / Z))
worker.ReportProgress(0, UpdateStatus)
End If
Case Else
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (Zremain / Z))
worker.ReportProgress(0, UpdateStatus)
End Select
End If
End If
Next
If X < R Then
For a = X + 1 To R
NumRemain = ReadCombination(Pos, N, ReadCombin.GetNotStoredNumbers)
RandNumRemain = RandomLowerUpper(1, Int(Len(NumRemain) / 3))
WriteCombination(Pos, ReadCombination(Pos, N, ReadCombin.GetStoredNumbers) & Mid(NumRemain, 3 * RandNumRemain - 2, 3), WriteCombin.Add)
Next
For a = 1 To Z
If (CSTEBit(BitState.ExmBit, Numbers(a, 12), 4) = &H0) And (CSTEBit(BitState.ExmBit, Numbers(a, 12), 5) = &H0) Then
If CompareCombination(a, ReadCombination(Pos, N, ReadCombin.GetStoredNumbers)) >= Y Then
Numbers(a, 12) = CSTEBit(BitState.SetBit, Numbers(a, 12), 5)
Zremain -= 1
Select Case Z
Case Is > 100
If Modulus(Zremain, Int(Z / 100)) = 0 Then
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (Zremain / Z))
worker.ReportProgress(0, UpdateStatus)
End If
Case Else
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (Zremain / Z))
worker.ReportProgress(0, UpdateStatus)
End Select
End If
End If
Next
End If
Index += 1
WriteCombination(0, ReadCombination(Pos, N, ReadCombin.GetStoredNumbers), WriteCombin.Add)
If IncludeIndexNumbers Then
tempWheel &= Format(Index, "00000000 - ") & ReadCombination(Pos, N, ReadCombin.GetStoredNumbers) & vbCrLf
UpdateStatus.ProgressInformation = "Building Win Condition... " & Format(Index, "00000000 - ") & ReadCombination(Pos, N, ReadCombin.GetStoredNumbers)
Else
tempWheel &= ReadCombination(Pos, N, ReadCombin.GetStoredNumbers) & vbCrLf
UpdateStatus.ProgressInformation = "Building Win Condition... " & ReadCombination(Pos, N, ReadCombin.GetStoredNumbers)
End If
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (Zremain / Z))
worker.ReportProgress(0, UpdateStatus)
Loop Until Zremain = 0
If Len(ReadCombination(0, N, ReadCombin.GetNotStoredNumbers)) / 3 <> 0 Then
MissingNumbers = Len(ReadCombination(0, N, ReadCombin.GetNotStoredNumbers)) / 3
Count = 0
For a = 1 To Z
If (CompareCombination(a, ReadCombination(0, N, ReadCombin.GetNotStoredNumbers)) = MissingNumbers) And (CSTEBit(BitState.ExmBit, Numbers(a, 12), 5) = &H1) Then
Count += 1
End If
Select Case Z
Case Is > 100
If Modulus(a, Int(Z / 100)) = 0 Then
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (a / Z))
worker.ReportProgress(0, UpdateStatus)
End If
Case Else
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (a / Z))
worker.ReportProgress(0, UpdateStatus)
End Select
Next
MissingSelection = RandomLowerUpper(1, Count)
Count = 0
MissingIndex = 0
Do
MissingIndex += 1
If (CompareCombination(MissingIndex, ReadCombination(0, N, ReadCombin.GetNotStoredNumbers)) = MissingNumbers) And (CSTEBit(BitState.ExmBit, Numbers(MissingIndex, 12), 5) = &H1) Then
Count += 1
End If
Select Case Z
Case Is > 100
If Modulus(MissingIndex, Int(Z / 100)) = 0 Then
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (MissingIndex / Z))
worker.ReportProgress(0, UpdateStatus)
End If
Case Else
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (MissingIndex / Z))
worker.ReportProgress(0, UpdateStatus)
End Select
Loop Until Count = MissingSelection
UpdateStatus.ProgressPercentagePer1000 = 0
worker.ReportProgress(0, UpdateStatus)
Numbers(MissingIndex, 12) = CSTEBit(BitState.TogBit, Numbers(MissingIndex, 12), 4)
Numbers(MissingIndex, 12) = CSTEBit(BitState.TogBit, Numbers(MissingIndex, 12), 5)
If X < R Then
For a = X + 1 To R
NumRemain = ReadCombination(MissingIndex, N, ReadCombin.GetNotStoredNumbers)
RandNumRemain = RandomLowerUpper(1, Int(Len(NumRemain) / 3))
WriteCombination(MissingIndex, ReadCombination(MissingIndex, N, ReadCombin.GetStoredNumbers) & Mid(NumRemain, 3 * RandNumRemain - 2, 3), WriteCombin.Add)
Next
End If
Index += 1
If IncludeIndexNumbers Then
tempWheel &= Format(Index, "00000000 - ") & ReadCombination(MissingIndex, N, ReadCombin.GetStoredNumbers) & vbCrLf
Else
tempWheel &= ReadCombination(MissingIndex, N, ReadCombin.GetStoredNumbers) & vbCrLf
End If
End If
Else
For a = 1 To T
If worker.CancellationPending Then
e.Cancel = True
Exit Sub
End If
If IncludeIndexNumbers Then
tempWheel &= Format(a, "00000000 - ") & Index2Combin(N, R, a) & vbCrLf
UpdateStatus.ProgressInformation = "Building Win Condition... " & Format(a, "00000000 - ") & Index2Combin(N, R, a)
Else
tempWheel &= Index2Combin(N, R, a) & vbCrLf
UpdateStatus.ProgressInformation = "Building Win Condition... " & Index2Combin(N, R, a)
End If
Select Case T
Case Is > 100
If Modulus(a, Int(T / 100)) = 0 Then
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (a / T))
worker.ReportProgress(0, UpdateStatus)
End If
Case Else
UpdateStatus.ProgressPercentagePer1000 = Int(1000 * (a / T))
worker.ReportProgress(0, UpdateStatus)
End Select
Next
Index = T
End If
tempWheel &= "____________________________________________" & vbCrLf
If Index > 1 Then
UpdateStatus.WheelInformation = "Wheel" & vbCrLf & _
"- Pick " & R.ToString & vbCrLf & _
"- " & N.ToString & " Numbers" & vbCrLf & _
"- " & Format(Index, "##,###,###") & " Combinations" & vbCrLf & _
"- " & Format((Index / T), "##0.######% ") & "Coverage of " & Format(T, "##,###,### ") & "Combinations" & vbCrLf & vbCrLf & tempWheel
Else
UpdateStatus.WheelInformation = "Wheel" & vbCrLf & _
"- Pick " & R.ToString & vbCrLf & _
"- " & N.ToString & " Numbers" & vbCrLf & _
"- " & Format(Index, "##,###,###") & " Combination" & vbCrLf & _
"- " & Format((Index / T), "##0.######% ") & "Coverage of " & Format(T, "##,###,### ") & "Combinations" & vbCrLf & vbCrLf & tempWheel
End If
worker.ReportProgress(0, UpdateStatus)
End Sub

Enum WriteCombin
Add = True
Remove = False
End Enum

Enum ReadCombin
GetStoredNumbers = True
GetNotStoredNumbers = False
End Enum

Enum BitState As Byte
ClrBit = 0
SetBit = 1
TogBit = 2
ExmBit = 3
End Enum

Function Modulus(ByVal a As Double, ByVal b As Double) As Long
Modulus = a - b * Int(a / b)
End Function

Function RandomLowerUpper(ByVal L As Long, ByVal U As Long) As Long
RandomLowerUpper = Int(Rnd() * (U - (L - 1))) + L
End Function

Function Fact(ByVal N As Integer) As Double
If (N <= 1) Then
Fact = 1
Else
Fact = N * Fact(N - 1)
End If
End Function

Function Perm(ByVal N As Integer, ByVal R As Integer) As Double
Dim a As Integer
Dim b As Double
b = 1
If (N < R) Then
Perm = 0
Else
For a = (N - (R - 1)) To N
b = b * a
Next a
Perm = b
End If
End Function

Function Comb(ByVal N As Integer, ByVal R As Integer) As Long
If (N < R) Then
Comb = 0
Else
Comb = Perm(N, R) / Fact(R)
End If
End Function

Function Cdist(ByVal N As Integer, ByVal R As Integer, ByVal C As Integer, ByVal Z As Integer) As Long
If ((Z < C) Or (Z > (N - (R - C))) Or (Z > N) Or (C > R) Or (N < 1) Or (R < 1) Or (C < 1) Or (Z < 1)) Then
Cdist = 0
Else
Cdist = Comb((Z - 1), (C - 1)) * Comb((N - Z), (R - C))
End If
End Function

Function fColumnSum(ByVal N As Integer, ByVal R As Integer, ByVal Z As Integer) As Long
Dim a As Integer
Dim ColumnSum As Double
If (Z < 1) Then
fColumnSum = 0
ElseIf ((Z >= 1) And (Z < (N - (R - 1)))) Then
ColumnSum = 0
For a = 1 To Z
ColumnSum = ColumnSum + Cdist(N, R, 1, a)
Next a
fColumnSum = ColumnSum
ElseIf (Z >= (N - (R - 1))) Then
fColumnSum = Comb(N, R)
End If
End Function

Function Index2Combin(ByVal N As Integer, ByVal R As Integer, ByVal I As Long) As String
Dim a, Combination(), Z As Integer
Dim J As Double
ReDim Combination(R)
Dim tmpString As String
Dim NumberFound As Boolean
tmpString = ""
J = I
J = J - 1
Z = 0
For a = 1 To R
If ((I >= 1) And (I <= Comb(N, R))) Then
If (a = 1) Then
Combination(a) = 1
Else
Combination(a) = Combination(a - 1) + 1
End If
NumberFound = False
Do
Select Case (J - fColumnSum((N - Z), (R - (a - 1)), (Combination(a) - (Z + 1))))
Case Is < 0
Combination(a) = Combination(a) - 1
NumberFound = True
Case Is = 0
NumberFound = True
Case Is > 0
Combination(a) = Combination(a) + 1
End Select
Loop Until NumberFound
J = J - fColumnSum((N - Z), (R - (a - 1)), (Combination(a) - (Z + 1)))
Z = Combination(a)
Else
Combination(a) = 0
End If
tmpString = tmpString & Format(Combination(a), "00 ")
Next a
Index2Combin = tmpString
End Function

Function Combin2Index(ByVal N As Integer, ByVal R As Integer, ByVal Combination As String) As Long
Dim a As Integer
Dim fSum As Double
fSum = 1
For a = 1 To R
If (a = 1) Then
fSum = fSum + fColumnSum(N, R, (Val(Mid(Combination, 3 * a - 2, 2)) - 1))
Else
fSum = fSum + fColumnSum((N - Val(Mid(Combination, 3 * (a - 1) - 2, 2))), (R - (a - 1)), (Val(Mid(Combination, 3 * a - 2, 2)) - (Val(Mid(Combination, 3 * (a - 1) - 2, 2)) + 1)))
End If
Next a
Combin2Index = fSum
End Function

Sub WriteCombination(ByVal I As Integer, ByVal Combination As String, ByVal Add As Boolean)
Dim bytPos As Integer
Dim bitPos As Byte
Dim R As Integer
Dim Z As Integer
R = Int(Len(Combination) / 3)
If R <> 0 Then
For a As Integer = 1 To R
Z = CInt(Val(Mid(Combination, 3 * a - 2, 2)))
bytPos = CInt(IntPart(CDbl(Z) / 8))
bitPos = CByte(8 * DecPart(CDbl(Z) / 8))
If Add Then
Numbers(I, bytPos) = CSTEBit(BitState.SetBit, Numbers(I, bytPos), bitPos)
Else
Numbers(I, bytPos) = CSTEBit(BitState.ClrBit, Numbers(I, bytPos), bitPos)
End If
Next
End If
End Sub

Function ReadCombination(ByVal I As Integer, ByVal N As Integer, ByVal GetStoredValues As Boolean) As String
Dim tmpText As String = ""
Dim bytPos As Integer
Dim bitPos As Byte
For a As Byte = 1 To N
bytPos = CInt(IntPart(CDbl(a) / 8))
bitPos = CByte(8 * DecPart(CDbl(a) / 8))
If GetStoredValues Then
If CSTEBit(BitState.ExmBit, Numbers(I, bytPos), bitPos) = 1 Then
tmpText &= Format(a, "00 ")
End If
Else
If CSTEBit(BitState.ExmBit, Numbers(I, bytPos), bitPos) = 0 Then
tmpText &= Format(a, "00 ")
End If
End If
Next
ReadCombination = tmpText
End Function

Function CompareCombination(ByVal I As Integer, ByVal Combination As String) As Integer
Dim T As Integer = 0
Dim bytPos As Integer
Dim bitPos As Byte
For a As Integer = 1 To Int(Len(Combination) / 3)
bytPos = CInt(IntPart(CDbl(Val(Mid(Combination, 3 * a - 2, 2))) / 8))
bitPos = CByte(8 * DecPart(CDbl(Val(Mid(Combination, 3 * a - 2, 2))) / 8))
T += CSTEBit(BitState.ExmBit, Numbers(I, bytPos), bitPos)
Next
CompareCombination = T
End Function

Public Function CSTEBit(ByVal CSTE As Byte, ByVal Byt As Byte, ByVal Bit As Byte) As Byte
If Bit < 8 Then
Dim Mask As Byte = 2 ^ Bit
Select Case CSTE
Case BitState.ClrBit
Return Byt And Not Mask
Case BitState.SetBit
Return Byt Or Mask
Case BitState.TogBit
Return Byt Xor Mask
Case BitState.ExmBit
If ((Byt And Mask) > 0) Then
Return 1
Else
Return 0
End If
Case Else
Return Byt
End Select
Else
Return Byt
End If
End Function

Function IntPart(ByVal n As Double) As Integer
Select Case Math.Sign(n)
Case -1
Return Math.Ceiling(n)
Case 0
Return 0
Case 1
Return Math.Floor(n)
End Select
End Function

Function DecPart(ByVal n As Double) As Double
Select Case Math.Sign(n)
Case -1
Return (n - Math.Ceiling(n))
Case 0
Return 0
Case 1
Return (n - Math.Floor(n))
End Select
End Function

End Class

Muito obrigado!!!

Sign In

A Simple Wheel Generator

Recommended Posts

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Join the conversation

Recently Browsing 0 members