Welcome Guest
Log In | Register )
You last visited December 5, 2016, 1:37 pm
All times shown are
Eastern Time (GMT-5:00)

the class to get close wheel.

Topic closed. 9 replies. Last post 11 years ago by Todd.

Page 1 of 1
PrintE-mailLink
Avatar
New Member

China
Member #5361
July 1, 2004
17 Posts
Offline
Posted: May 2, 2006, 8:11 am - IP Logged

    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 2.gif
    Chief Bottle Washer
    New Jersey
    United States
    Member #1
    May 31, 2000
    23260 Posts
    Offline
    Posted: May 2, 2006, 9:23 am - IP Logged

    "GoTo" - yuk! Confused

     

    Check the State Lottery Report Card
    What grade did your lottery earn?

     

    Sign the Petition for True Lottery Drawings
    Help eliminate computerized drawings!

      spy153's avatar - maren

      United States
      Member #28409
      December 15, 2005
      1198 Posts
      Offline
      Posted: May 2, 2006, 9:40 am - IP Logged

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

      voir-vous dans mes reves!Cool

        bellyache's avatar - 64x64a9wg

        United States
        Member #12618
        March 18, 2005
        2060 Posts
        Offline
        Posted: May 2, 2006, 1:11 pm - IP Logged

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

        Dance like no one is watching.

          Avatar
          New Member

          China
          Member #5361
          July 1, 2004
          17 Posts
          Offline
          Posted: May 3, 2006, 9:13 am - IP Logged

          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
            New Jersey
            United States
            Member #20729
            August 24, 2005
            30 Posts
            Offline
            Posted: May 3, 2006, 9:59 am - IP Logged

            Not sure what you are doing here.

            Can you show an example?

              Todd's avatar - Cylon 2.gif
              Chief Bottle Washer
              New Jersey
              United States
              Member #1
              May 31, 2000
              23260 Posts
              Offline
              Posted: May 3, 2006, 11:24 am - IP Logged

              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.

               

              Check the State Lottery Report Card
              What grade did your lottery earn?

               

              Sign the Petition for True Lottery Drawings
              Help eliminate computerized drawings!

                LANTERN's avatar - kilroy 28_173_reasonably_small.jpg
                Tx
                United States
                Member #4570
                May 4, 2004
                5180 Posts
                Offline
                Posted: May 3, 2006, 12:50 pm - IP Logged

                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
                  Tx
                  United States
                  Member #4570
                  May 4, 2004
                  5180 Posts
                  Offline
                  Posted: May 3, 2006, 1:03 pm - IP Logged

                  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 2.gif
                    Chief Bottle Washer
                    New Jersey
                    United States
                    Member #1
                    May 31, 2000
                    23260 Posts
                    Offline
                    Posted: May 3, 2006, 1:12 pm - IP Logged

                    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.

                     

                    Check the State Lottery Report Card
                    What grade did your lottery earn?

                     

                    Sign the Petition for True Lottery Drawings
                    Help eliminate computerized drawings!