iziplay Posted March 15, 2017 Share Posted March 15, 2017 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. 2 Quote Link to comment Share on other sites More sharing options...
iziplay Posted March 15, 2017 Author Share Posted March 15, 2017 (edited) 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 Quote Link to comment Share on other sites More sharing options...
iziplay Posted March 15, 2017 Author Share Posted March 15, 2017 Codigo fonte para amigos que queiram aprofundar a ferramenta https://www.lotterypost.com/thread/228056 1 Quote Link to comment Share on other sites More sharing options...
DixieJoe Posted March 15, 2017 Share Posted March 15, 2017 Valeu mesmo, pauloeasy, Mais uma excelente ferramenta para construção de Wheels. Quote Link to comment Share on other sites More sharing options...
Administrador Jimmy Posted March 15, 2017 Administrador Share Posted March 15, 2017 Obrigado pela colaboração com a comunidade. Obs. movi para o fórum de programas. Quote Link to comment Share on other sites More sharing options...
Gnostico Posted March 15, 2017 Share Posted March 15, 2017 Valeu pauloeasy , obrigado por compartilhar esta ferramenta conosco. Quote Link to comment Share on other sites More sharing options...
Jmil21 Posted March 16, 2017 Share Posted 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.exeHttp://mail1.mediacombb.net/home/jadexcode@mediacombb.net/Files/Applications/ASimpleWheelGenerator.exeFtp://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. Quote Link to comment Share on other sites More sharing options...
mikedj Posted August 27, 2022 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
RobSmith Posted August 27, 2022 Share Posted 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 _____________________________________________________ <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 Quote Link to comment Share on other sites More sharing options...
RobSmith Posted August 27, 2022 Share Posted August 27, 2022 é usado Silverlight 3 in Visual Basic Quote Link to comment Share on other sites More sharing options...
mikedj Posted August 27, 2022 Share Posted 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!!! Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.