VERSION 5.00
Begin VB.Form FormLoto 
   Caption         =   "Formulario LOTO"
   ClientHeight    =   5880
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   9300
   LinkTopic       =   "Form1"
   ScaleHeight     =   5880
   ScaleWidth      =   9300
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton BtnGenerarCombinaciones 
      Caption         =   "Generar Combinaciones"
      Height          =   495
      Left            =   360
      TabIndex        =   6
      Top             =   5160
      Width           =   3615
   End
   Begin VB.TextBox TextResult2 
      Enabled         =   0   'False
      Height          =   4095
      Left            =   7200
      MultiLine       =   -1  'True
      TabIndex        =   5
      Top             =   960
      Width           =   1455
   End
   Begin VB.TextBox TextResult1 
      Enabled         =   0   'False
      Height          =   4095
      Left            =   5640
      MultiLine       =   -1  'True
      TabIndex        =   1
      Top             =   960
      Width           =   1455
   End
   Begin VB.TextBox TextCombinaciones 
      Height          =   4095
      Left            =   360
      MultiLine       =   -1  'True
      TabIndex        =   0
      Top             =   960
      Width           =   4815
   End
   Begin VB.Label Label6 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Aciertos"
      Height          =   255
      Left            =   3480
      TabIndex        =   9
      Top             =   720
      Width           =   975
   End
   Begin VB.Label Label5 
      Caption         =   "GENERADOR AUTOMATICO DE COMBINACIONES"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   13.5
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   495
      Left            =   1200
      TabIndex        =   8
      Top             =   120
      Width           =   6855
   End
   Begin VB.Label Label4 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "RESULTADOS ESTADISTICOS"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   5640
      TabIndex        =   7
      Top             =   720
      Width           =   3015
   End
   Begin VB.Label Label3 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Posicion"
      Height          =   255
      Left            =   4440
      TabIndex        =   4
      Top             =   720
      Width           =   735
   End
   Begin VB.Label Label2 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Reg"
      Height          =   255
      Left            =   360
      TabIndex        =   3
      Top             =   720
      Width           =   735
   End
   Begin VB.Label Label1 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Combinacion"
      Height          =   255
      Left            =   1080
      TabIndex        =   2
      Top             =   720
      Width           =   2415
   End
End
Attribute VB_Name = "FormLoto"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Type Combinacion
    num(1 To 6) As Integer
    aciertos As Integer
End Type


' se tendra que generar las estadistica para las combinaciones
' existentes, de la forma
' 1   1,2%
' 2   1,34%
' 3   2,22%
    
    
Private Sub Form_Load()

    Dim arrComb() As Combinacion
    Dim numRegs As Integer

    Call descargarArchivo(arrComb, numRegs)

    If numRegs > 0 Then
        Me.TextCombinaciones = generarStringArrComb(arrComb, numRegs)
    End If

End Sub


Private Sub BtnGenerarCombinaciones_Click()

    Dim arrComb() As Combinacion
    Dim numGen As Integer
    
    numGen = InputBox("Cuantas combinaciones deseas generar?")

    ReDim arrComb(1 To numGen) As Combinacion

    Call simularCombinaciones(arrComb, numGen)

    Call GuardarArregloEnArchivo(arrComb, numGen)

    Call descargarArchivo(arrComb, numGen)
     
    Me.TextCombinaciones = generarStringArrComb(arrComb, numGen)
    Me.TextCombinaciones.Refresh
   

End Sub

Private Function generarNumAleatorio(ByVal limInf As Integer, ByVal limSup As Integer) As Integer
    
    Dim generado  As Boolean, num As Integer
    Dim cont As Integer
    
    cont = 0
    generado = False

    Randomize

    Do While Not generado
        num = limInf + Rnd * Abs(limSup * 2 - limInf)
        If (num >= limInf And num <= limSup) Then
            generado = True
        End If
        
        cont = cont + 1
    
        If cont > 100 Then    ' en caso que despues de 100 iteraciones no
            num = limInf      ' se haya generado un numero en el tramo
            generado = True
        End If
    
    Loop

    generarNumAleatorio = num

End Function

Private Sub generarCombinacion(ByRef cmb As Combinacion)

    Dim i As Integer
    
    'en esta funcion hay que implementar un algoritmo que compruebe
    'que el numero generado no existe
    ' en caso de existir hay que seguir iterando, con un limite 100 iter.
    
    With cmb
        For i = 1 To 6
            .num(i) = generarNumAleatorio(1, 36)
        Next
        .aciertos = generarNumAleatorio(0, 3)
    End With

End Sub

Private Sub simularCombinaciones(ByRef arrCmb() As Combinacion, n As Integer)
    
    Dim i As Integer
    Dim aux As Combinacion
    
    ' en este procedimiento hay que implementar un procedimiento
    ' que ordene de menor a mayor la combinacion generada
    
    For i = 1 To n
        Call generarCombinacion(aux)
        arrCmb(i) = aux
    Next

End Sub

Private Sub GuardarArregloEnArchivo(ByRef arrComb() As Combinacion, n As Integer)
    
    Dim i As Integer
    Dim numRegs As Integer, posicion As Integer, numArchivo As Integer
    Dim tam As Integer ' tamagno (bytes) de la estructura Combinacion

    numRegs = 0
    numArchivo = FreeFile
    tam = Len(arrComb(1))

    Open "bdLoto.bin" For Binary As #numArchivo Len = tam

    numRegs = LOF(numArchivo) \ tam

    For i = 1 To n
        posicion = numRegs * tam + 1
        Put #numArchivo, posicion, arrComb(i)
        numRegs = numRegs + 1
    Next i

    Close #numArchivo
   
End Sub


Private Sub descargarArchivo(ByRef arrComb() As Combinacion, ByRef numeroDeRegistros)

    Dim i As Integer
    Dim numRegs As Integer, posicion As Integer, numArchivo As Integer
    Dim tam As Integer ' tamagno (bytes) de la estructura Combinacion

    ReDim Preserve arrComb(1 To 2) As Combinacion
    
    numRegs = 0
    numArchivo = FreeFile
    tam = Len(arrComb(1))

    Open "bdLoto.bin" For Binary As #numArchivo Len = tam
    
    numRegs = LOF(numArchivo) \ tam
    
    numeroDeRegistros = numRegs
    
    If (numRegs > 0) Then
    
        ReDim arrComb(1 To numRegs) As Combinacion
        posicion = 1
        For i = 1 To numRegs
            Get #numArchivo, posicion, arrComb(i)
            posicion = posicion + tam
        Next i
    End If
    
    Close #numArchivo

End Sub

Private Function StrCombinacion(ByRef cmb As Combinacion) As String
    Dim i As Integer, msg As String
    msg = ""
    
    For i = 1 To 6
        With cmb
            If (.num(i) < 10) Then
                msg = msg & "0"
            End If
            msg = msg & Str(.num(i))
        End With
    
        If i <> 6 Then
            msg = msg & " , "
        End If
    Next

    msg = msg & "          " & Str(cmb.aciertos)

    StrCombinacion = msg

End Function


Private Function generarStringArrComb(ByRef arrComb() As Combinacion, ByVal n As Integer) As String
    
    Dim msg As String, i As Integer
    Dim posicion As Integer, tam As Integer
    tam = Len(arrComb(1))
    msg = ""
    posicion = 1
    
    For i = 1 To n
        If i < 10 Then
            msg = msg & " "
        End If
        msg = msg & Str(i) & "           "
        msg = msg & StrCombinacion(arrComb(i))
        msg = msg & "                 " & Str(posicion) & vbCrLf
        posicion = posicion + tam
    Next
    
    generarStringArrComb = msg
    
End Function