Share

the class to get close wheel.

Avatar

    i had test the code  in vb6 ,and it do work. now i write it again in vb.net.  i had not debug and test it.

 to use the code ,it need build a class, and copy the code to the class.

 

 

 Public Class closewheel
    'If you have a wheel name "firwheel". the "firwheel" is of  "M pick N" and "L if K".
    'Then you can use this class to get all close wheel of "firwheel".
    'those close wheels differ from "firwheel" at only one line.
    'in fact there are some close wheels to "firwheel".
    '
    'How to use the class?
    '1,dim a new object myclosewheel:                  dim myclosewheel as new closewheel
    '2,initialize the object myclosewheel:              myclosewheel.inims(m,n,k,l)
    '3,get you close wheels eith myclosewheel:          myclosewheel.getwheel(firwheel,endwheel)
    'must run at the order. or it will do wrong.
    '
    'the firwheel is 2 dimension array. it include some lines.
    'exp:
    '  the wheel include 3 lines. (1 2 3 4)  (2 3 4 5)  ( 1 3 4 6)
    '  the firwheel is :  1 2 3 4
    '                      2 3 4 5
    '                      1 3 4 6
    '
    'the endwheel is 3 dimension array. the modul is :  endwheel(the i wheel,  the j line,  the k number)
    '
    'the class can be ameliorated to do other thing.
    '
    'i must provide for exam, so i had not debug it. the principle is not difficult to know. you can debug it.
    '
    '                                        good luck!
    'MAIL:  xuzijiewz@yahoo.com.cn
    Private Shared ms(,,,,) As Integer
    Private Shared MYM As Byte
    Private Shared MYN As Byte
    Private Shared MYK As Byte
    Private Shared MYL As Byte
    Public Sub inims(ByVal M As Byte, ByVal N As Byte, ByVal K As Byte, ByVal L As Byte)
        If M < N Or N < K Or K < L Or L < 1 Then
            MsgBox("there is somee wrong with input wheel .", MsgBoxStyle.OKOnly, "CLOSE LOTTO WHEEL")
            Exit Sub
        End If
        Dim I1 As Integer, I2 As Integer, IWS As Long = 1
        MYM = M : MYK = K : MYN = N : MYL = L
        If L < M / 2 And N > M / 2 Then
            I2 = Int(M / 2)
        ElseIf L > M / 2 Then
            I2 = L
        ElseIf N < M / 2 Then
            I2 = N
        End If
        For I1 = 1 To I2
            IWS = IWS * (M - I1 + 1) / I1
        Next
        ReDim ms(M, 1, 1, IWS, N - 1)
        For I1 = L To K
            Call creams(N, I1, 1, 1)
            Call creams(M - N, N - I1, 1, 0)
            Call creams(K, I1, 0, 1)
            Call creams(M - K, K - I1, 0, 0)
        Next
    End Sub

    Public Sub GETWHEEL(ByVal INWHEEL(,) As Byte, ByRef OUTWHEEL(,,) As Byte)
        Dim FIRWHEEL(UBound(INWHEEL, 1), MYN - 1) As Byte, I As Byte, MIDLINES(,) As Byte, ENDLINES(,) As Byte, i1 As Byte, I2 As Byte, I3 As Byte, IWHEEL As Integer = -1
        For I = 0 To UBound(INWHEEL, 1)
            For i1 = 0 To MYN - 1
                FIRWHEEL(I, i1) = INWHEEL(I, i1) - 1
            Next
        Next
        For I = 0 To UBound(INWHEEL, 1)
10:        i1 = 0
            For I2 = 0 To MYN - 1
                If FIRWHEEL(I, I2) = FIRWHEEL(I, I2 + 1) Then
                    MsgBox("there is somee wrong with input wheel.", MsgBoxStyle.OKOnly, "CLOSE LOTTO WHEEL")
                    Exit Sub
                ElseIf FIRWHEEL(I, I2) > FIRWHEEL(I, I2 + 1) Then
                    I3 = FIRWHEEL(I, I2)
                    FIRWHEEL(I, I2) = FIRWHEEL(I, I2 + 1)
                    FIRWHEEL(I, I2 + 1) = I3
                    i1 = i1 + 1
                End If
            Next
            If i1 > 0 Then GoTo 10
        Next
        For I = 0 To UBound(INWHEEL, 1)
            Call FIT(FIRWHEEL, I, 1, MIDLINES)
            Call FIT(MIDLINES, 1, 0, ENDLINES)
            For i1 = 0 To UBound(ENDLINES, 1)
                For I2 = 0 To MYN - 1
                    If FIRWHEEL(I, I2) <> ENDLINES(i1, I2) Then GoTo 100
                Next
                GoTo 200
100:            ReDim Preserve OUTWHEEL(IWHEEL + 1, UBound(FIRWHEEL, 1), MYN - 1)
                For I2 = 0 To UBound(FIRWHEEL, 1)
                    For I3 = 0 To MYN - 1
                        OUTWHEEL(IWHEEL, I2, I3) = FIRWHEEL(I2, I3) + 1
                    Next
                Next
                For I3 = 0 To MYN - 1
                    OUTWHEEL(IWHEEL, I, I3) = ENDLINES(i1, I3) + 1
                Next
                IWHEEL = IWHEEL + 1
200:        Next
        Next
    End Sub

    Private Sub FIT(ByVal INWHEEL1(,) As Byte, ByVal IN1 As Byte, ByVal IN2 As Byte, ByRef OUTLINES(,) As Byte)
        Dim LINES(UBound(INWHEEL1, 2)) As Byte, OTHERNUM(MYM - 1) As Byte, OTHERNUM1(MYM - 1) As Integer
        Dim I As Byte, i1 As Long, I2 As Long, I3 As Long, I4 As Byte, i5 As Byte, IFJ As Long, IBC As Byte, IBCI As Long, i6 As Byte, i7 As Byte
        Dim LINEFJ(MYN) As Byte, LINEBC(MYN) As Byte, LINE(MYN) As Byte, ILINES As Integer = -1
        For I = 0 To MYM - 1
            OTHERNUM1(I) = I
        Next
        For I = 0 To UBound(INWHEEL1, 2)
            LINES(I) = INWHEEL1(IN1, I)
            OTHERNUM1(LINES(I)) = -1
        Next
        i1 = 0
        For I = 0 To MYM - 1
            If OTHERNUM1(I) > -1 Then
                OTHERNUM(i1) = OTHERNUM1(I)
                i1 = i1 + 1
            End If
        Next
        For I = MYL To MYK
            For i1 = 0 To ms(I, IN2, 1, 0, 0)
                For I2 = 0 To I - 1
                    LINEFJ(I2) = LINES(ms(I, IN2, 1, i1, I2))
                Next I2
                If (IN2 = 1 And MYK = I) Or (IN2 = 0 And MYN = I) Then
                    IBCI = 0
                Else
                    If IN2 = 1 Then
                        IBCI = ms(MYK - I, 0, 0, 0, 0)
                    Else
                        IBCI = ms(MYN - I, 1, 0, 0, 0)
                    End If
                End If
                For I2 = 0 To IBCI
                    If IBCI = 0 Then
                        For I3 = 0 To I - 1
                            LINE(I3) = LINEFJ(I3)
                        Next
                        GoTo 50
                    Else
                        If IN2 = 1 Then
                            For I3 = 0 To MYK - I - 1
                                LINEBC(I3) = OTHERNUM(ms(MYK - I, 0, 0, I2, I3))
                            Next I3
                        Else
                            For I3 = 0 To MYN - I - 1
                                LINEBC(I3) = OTHERNUM(ms(MYN - I, 1, 0, I2, I3))
                            Next I3
                        End If
                    End If
                    I3 = 0 : I4 = 0 : i6 = 0
                    If IN2 = 1 Then
                        i7 = MYK - I
                    Else
                        i7 = MYN - I
                    End If
                    Do While I3 < I And I4 < i7
                        If LINEFJ(I3) < LINEBC(I4) Then
                            LINE(i6) = LINEFJ(I3)
                            I3 = I3 + 1
                        Else
                            LINE(i6) = LINEBC(I4)
                            I4 = I4 + 1
                        End If
                        i6 = i6 + 1
                    Loop
                    If I3 = I Then
                        For i5 = I4 To i7 - 1
                            LINE(i6 + i5 - I4) = LINEBC(i5)
                        Next
                    Else
                        For i5 = I3 To I - 1
                            LINE(i6 + i5 - I3) = LINEFJ(i5)
                        Next
                    End If
50:
                    If IN2 = 1 Then
                        i7 = MYN
                    Else
                        i7 = MYK
                    End If
                    For I3 = 0 To UBound(INWHEEL1, 1)
                        I4 = 0 : i5 = 0 : i6 = 0
                        Do While i5 < i7 And I4 < i7
                            If LINE(I4) < INWHEEL1(I3, i5) Then
                                I4 = I4 + 1
                            ElseIf LINE(I4) > INWHEEL1(I3, i5) Then
                                i5 = i5 + 1
                            ElseIf LINE(I4) = INWHEEL1(I3, i5) Then
                                I4 = I4 + 1 : i5 = i5 + 1 : i6 = i6 + 1
                            End If
                        Loop
                        If IN2 = 1 Then
                            If i6 > MYL - 1 Then GoTo 100
                        Else
                            If i6 < MYL Then GoTo 100
                        End If
                    Next
                    ILINES = ILINES + 1
                    ReDim Preserve OUTLINES(ILINES, i7 - 1)
                    For I3 = 0 To i7 - 1
                        OUTLINES(ILINES, I3) = LINE(I3)
                    Next
100:            Next
            Next i1
        Next I
    End Sub

    Private Sub creams(ByVal m As Byte, ByVal n As Byte, ByVal in1 As Byte, ByVal in2 As Byte)
        Dim num(n + 1) As Byte, i As Byte, iP As Byte = n, IWS As Long = 1
        If n = 0 Then Exit Sub
        For i = 1 To n
            num(i) = i
        Next
        Do While iP > 0
            For i = 1 To n
                ms(n, in1, in2, IWS, i - 1) = num(i) - 1
            Next
100:        num(iP) = num(iP) + 1
            If num(iP) > m - n + iP Then
                iP = iP - 1
                If iP = 0 Then
                    ms(n, in1, in2, 0, 0) = IWS
                    Exit Sub
                End If
                GoTo 100
            End If
            For i = iP To n - 1
                num(i + 1) = num(i) + 1
            Next
            IWS = IWS + 1
            iP = n
        Loop
    End Sub
End Class

 

Todd's avatar - Cylon 200.jpg

"GoTo" - yuk! Confused

spy153's avatar - maren

I think calling it the "close wheel" is naming perfectly.Wink

bellyache's avatar - 64x64a9wg

I have no idea what any of that "close wheel" means. LOL

Avatar

I do not know what you mean?

Is it something wrong with the code? i had not test it.  but i had try it in VB5, and it do something. 

with the code, we can find out all wheel. 

Avatar

Not sure what you are doing here.

Can you show an example?

Todd's avatar - Cylon 200.jpg

I do not know what you mean?

Is it something wrong with the code? i had not test it.  but i had try it in VB5, and it do something. 

with the code, we can find out all wheel. 

If you're talking about my "GoTo" comment, I am referring to the fact that people writing structured coding should avoid the use of all GoTos and GoSubs.  They make code extremely difficult to follow, and are a throwback to the very first versions of the BASIC programming language, not something that should be used in VB.

LANTERN's avatar - kilroy 28_173_reasonably_small.jpg

Right, I guess, but I do love those Goto and Gosub basic commands myself, at least I did, when I was taking a look at Commodore 64 Basic a long time ago, too bad that I didn't keep at it.

LANTERN's avatar - kilroy 28_173_reasonably_small.jpg

lottoweave

"Weave" or "Knit" us some nice lottery workouts and or tools, if you want to know what we need, we can tell you and or surprise us.

Todd's avatar - Cylon 200.jpg

Right, I guess, but I do love those Goto and Gosub basic commands myself, at least I did, when I was taking a look at Commodore 64 Basic a long time ago, too bad that I didn't keep at it.

I know what you mean, because I coded on a C64 myself, quite extensively.  (Both BASIC and Assembler.)  Back then, you HAD to use Goto and Gosub, because the basic programming language was truly basic, and did not have the ability to have true subroutines and functions.  Nowadays, Goto and Gosub are not good.

TopEnd of thread (1 page)

Welcome Guest

Your last visit: Wed, Oct 27, 2021, 11:49 pm

Log In

Log InCancel

Forgot your username?

Forgot your password?