Mensajes

[PISTA:]

La única cosa que hecho en falta es la posibilidad de excluir números.
Ya pensaré algo...

PISTA:
Debes buscar el indice del array donde se encuentre el valor a excluir y pasarlo por la función:

Private Sub SeparateRange(ByVal lDivVal As Long, ByVal lindex As Long, ByRef vArray() As stRangos)

Reformando la funcion ItsInArray se puede hacer, no me gustaría ver un For Next que recorra todos elementos del array ya que es algo muy feo y no entra en la relación Tiempo-Procesador ya que alentaria mucho el proceso.

Dulces Lunas!¡.

[do ... while until]

.
Evita ecaresidamente usar Goto es una mala practica y de paso para otros quisas no sea entendible en tu caso seria usar

do ... while until

PD: No puedo creerme que la gente no se aclare con esta función. 

El objetivo es hacer que se generen Números aleatorios SIN REPETIR sin perder tiempo y no saturar el procesador con bucles o bucles anidados, cosa que no es rentable con rangos de números amplios ya que la relación Tiempo-Procesador.

Este modulo de clase es mas rápida y mas optimizada que este código (este hilo) con rangos de números mas amplios, claro que tiene mas código pero es por una pequeña heuristica para saber que números generar o no generar sin usar For Next lo cual aumenta el rendimiento en relación Procesador-Tiempo pero no memoria  :¬¬.
[Src] cRndNumbersNR ( Generar números aleatorios sin repetir [Very-Fast] )

Dulces Lunas!¡.

.
Calculas las coordenadas X,Y con respecto aun radio y un punto X,Y de centro.

Esto te puede ayudar lee bien hay esta la bibliográfica de mi información.

Temibles Lunas!¡.

[cRndNumbersNR.cls]

.

@Psyke1

Mas que una matriz quedaría precioso en una clase... al rato lo traslado a una clase para aumentar la velocidad de procesamiento, ya que de este modo se le aumenta el peformance ( en relación procesador/tiempo, pero no memoria ) con una clase.

Este código es una mera actualización directa de este otro, se puede decir que es la version 2.0

[source] Números Aleatorio desde X a Y con excepciones.

Vaya solo le falta una opción a mi punto de vista y es meterle una lista de números antes de generar alguno tal cual se le hace en la función solo que ahora seria una propiedad, y podría modificarse en cualquier instante, pero eso se los dejo a ustedes, yo ya hice mi labor.

* El ordenamiento QuickSort se sustituyo por una heuristica mas eficiente.

En un modulo de clase:

cRndNumbersNR.cls

Código (vb) [Seleccionar] Expandir



'
' ////////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
' //                                                            //
' // Web: http://InfrAngeluX.Sytes.Net/                         //
' //                                                            //
' // |-> Pueden Distribuir Este Codigo siempre y cuando         //
' // no se eliminen los creditos originales de este codigo      //
' // No importando que sea modificado/editado o engrandesido    //
' // o achicado, si es en base a este codigo                    //
' ////////////////////////////////////////////////////////////////

Option Explicit

Private Declare Function VarPtrA Lib "msvbvm60.dll" Alias "VarPtr" (ByRef Ptr() As Any) As Long
Private Declare Sub lCopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)

Private Type stRangos
   lValIni         As Long
   lValEnd         As Long
End Type

Private lcvalmax    As Long
Private lcvalmin    As Long

Private lvcsplit()  As stRangos
Private lacexcep()  As Long

Private bChange     As Long

Private Sub Swapnumbers(ByRef lvalone As Long, ByRef lvaltwo As Long)
'   //  Intercambia el contenido de las variables.
Dim lvaltmp         As Long
   lvaltmp = lvalone
   lvalone = lvaltwo
   lvaltwo = lvaltmp
End Sub

Private Function Fixnumbers(ByRef lvalmin As Long, lvalmax As Long) As Boolean
'   //  Corrige los valores dados.
   If lvalmax < lvalmin Then
       Call Swapnumbers(lvalmin, lvalmax)
       Fixnumbers = True
   End If
End Function

Private Function NumRandom(lvalmin As Long, lvalmax As Long) As Long
'   //  Genera un Numero aleatorio de acuerdo a un rango dado.
   Call Fixnumbers(lvalmin, lvalmax)
   Call Randomize
   NumRandom = (lvalmin - lvalmax) * Rnd + lvalmax
End Function

Public Sub Reset()
'   //  Reinicia y permite nuevamente generar los números aleatorios desde el principio, si no aplica este al generar todos los numeros, entonces no generara mas números y devolverá únicamente 0..
   Erase lvcsplit()
   Erase lacexcep()
   ReDim lvcsplit(0 To 0)
   lvcsplit(0).lValIni = lcvalmin
   lvcsplit(0).lValEnd = lcvalmax
   bChange = False
End Sub

Public Property Get GetMore() As Boolean
'   //  Hay mas ocurrencias? cuando ya no hay se elimina el array de ocurrencias.
   GetMore = Itsarrayini(VarPtrA(lvcsplit)) Or bChange = True
End Property

Private Function Itsarrayini(ByVal lpszv As Long, Optional llen As Long = 4) As Boolean
'   //  Obtiene el limite superior de los numeros a generar de manera aleatoria sin repetir.
Dim lpsz                    As Long
   If lpszv <> 0 And llen > 0 Then
       Call lCopyMemory(ByVal VarPtr(lpsz), ByVal lpszv, llen)
       Itsarrayini = Not lpsz = 0
   End If
End Function

Private Sub SeparateRange(ByVal lDivVal As Long, ByVal lindex As Long, ByRef vArray() As stRangos)
'   //  Es un proceso para aplicar el dicho "Divide y Venceras", esto aumenta mucho la velocidad para no repetir numeros dentro de un rango dado y generados de manera aleatoria.
'   //  Repeti un poco de codigo lo siento xP...
Dim lu          As Long
Dim lpsz        As Long
   
   If (vArray(lindex).lValIni <= lDivVal And lDivVal <= vArray(lindex).lValEnd) Then
       lu = UBound(vArray)
       lpsz = VarPtr(vArray(lindex))
       If (vArray(lindex).lValIni = lDivVal) Then
           vArray(lindex).lValIni = vArray(lindex).lValIni + 1
           If (vArray(lindex).lValIni > vArray(lindex).lValEnd) Then
               If (lu > 0) Then
                   lCopyMemory lpsz, lpsz + &H8, ((lu - lindex) * &H8)
                   lu = lu - 1
                   ReDim Preserve vArray(0 To lu)
               Else
                   Erase vArray()
               End If
           End If
       ElseIf (vArray(lindex).lValEnd = lDivVal) Then
           vArray(lindex).lValEnd = vArray(lindex).lValEnd - 1
           If (vArray(lindex).lValIni > vArray(lindex).lValEnd) Then
               If (lu > 0) Then
                   lCopyMemory lpsz, lpsz + &H8, ((lu - lindex) * &H8)
                   lu = lu - 1
                   ReDim Preserve vArray(0 To lu)
               Else
                   Erase vArray()
               End If
           End If
       Else
           lu = lu + 1
           ReDim Preserve vArray(0 To lu)
           lpsz = VarPtr(vArray(lindex))
           lCopyMemory lpsz + &H10, (lpsz + &H8), (((lu - 1) - lindex) * &H8)
           vArray(lindex + 1).lValEnd = vArray(lindex).lValEnd
           vArray(lindex + 1).lValIni = (lDivVal + 1)
           vArray(lindex).lValEnd = (lDivVal - 1)
           
       End If
   End If
   
End Sub

Public Property Get GetNumRandom() As Long
'   //  Genera un numero aleatorio sin repetir de acuerdo a un rango de valores dados.
Dim lindex          As Long
Dim lu              As Long
Dim lret            As Long
   If (bChange = True) Then
       Call Fixnumbers(lcvalmin, lcvalmax)
       Call Reset
   End If
   If (GetMore = True) Then
       lindex = NumRandom(0, UBound(lvcsplit))
       lret = NumRandom(lvcsplit(lindex).lValIni, lvcsplit(lindex).lValEnd)
       SeparateRange lret, lindex, lvcsplit
       If (Itsarrayini(VarPtrA(lacexcep)) = True) Then
           lu = UBound(lacexcep) + 1
       Else
           lu = 0
       End If
       ReDim Preserve lacexcep(0 To lu)
       lacexcep(lu) = lret
       GetNumRandom = lret
   End If
End Property

Public Property Let minval(ByVal ldata As Long)
'   //  Establece el limite inferior de los numeros a generar de manera aleatoria sin repetir.
   lcvalmin = ldata
   bChange = True
End Property

Public Property Get minval() As Long
'   //  Obtiene el limite inferior de los numeros a generar de manera aleatoria sin repetir.
   minval = lcvalmin
End Property

Public Property Let maxval(ByVal ldata As Long)
'   //  Establece el limite superior de los numeros a generar de manera aleatoria sin repetir.
   lcvalmax = ldata
   bChange = True
End Property

Public Property Get maxval() As Long
'   //  Obtiene el limite superior de los numeros a generar de manera aleatoria sin repetir.
   maxval = lcvalmax
End Property

Public Property Get GetNumbers() As Long()
'   //  Devueve una coleccion de los numeros generados.
   GetNumbers() = lacexcep()
End Property

Public Function RegenerateThis(ByVal lVal As Long) As Boolean
Dim ii              As Long
Dim lub             As Long
    If (lcvalmin <= lVal) And (lcvalmax >= lVal) Then
        If (breglist = True) Then
            If (Itsarrayini(VarPtrA(lacexcep)) = True) Then
                For ii = 0 To UBound(lacexcep)
                    If (lacexcep(ii) = lVal) Then
                        RemoveInArrayLong ii, lacexcep()
                        Exit For
                    End If
                Next ii
            End If
        End If
        If (Itsarrayini(VarPtrA(lvcsplit)) = True) Then
            lub = UBound(lvcsplit)
            For ii = 0 To (lub - 1)
                If (lvcsplit(ii).lValEnd > lVal) And (lvcsplit(ii + 1).lValIni < lVal) Then
                    If ((lvcsplit(ii).lValEnd + 1) = lVal) Then
                        lvcsplit(ii).lValEnd = lVal
                    ElseIf ((lvcsplit(ii + 1).lValIni) = lVal) Then
                        lvcsplit(ii + 1).lValIni = lVal
                    End If
                    Select Case (lvcsplit(ii).lValEnd = lvcsplit(ii + 1).lValIni)
                        Case 0, 1
                            lub = (lub - 1)
                            lvcsplit(ii).lValEnd = lvcsplit(ii + 1).lValEnd
                            ReDim Preserve lvcsplit(0 To lub)
                        Case Else
                            If Not ((lvcsplit(ii).lValEnd + 1) = lvcsplit(ii + 1).lValIni) Then
                                lub = (lub + 1)
                                ReDim Preserve lvcsplit(0 To lub)
                                SwapBlockMemoryInCicle VarPtr(lvcsplit(ii)), (VarPtr(lvcsplit(lub)) + LenB(lvcsplit(0))), LenB(lvcsplit(0))
                                lvcsplit(ii + 1).lValIni = lVal
                                lvcsplit(ii + 1).lValEnd = lVal
                            End If
                    End Select
                    RegenerateThis = True
                Else
                    Exit For
                End If
            Next ii
        Else
            ReDim lvcsplit(0 To 0)
            lvcsplit(0).lValIni = lVal
            lvcsplit(0).lValEnd = lVal
        End If
    End If
End Function

Private Sub Class_Initialize()
'   //  Constructor de la clase, no tengo por que hacer lo siguiente pero como me estoy adaptando a un standart lo hare.
   bChange = False
End Sub



uso simple:

Código (vb) [Seleccionar] Expandir



Option Explicit

Private Sub Form_Load()
Dim cls     As cRndNumber
Dim lc      As Long
   Set cls = New cRndNumber
   With cls
   '   //  Este simple codigo probara la velocidad, que de hecho ya es rapido a consideracion de otros que conozco.
       .minval = 0
       .maxval = 99999
       Do While (.GetMore = True)
           DoEvents
           lc = .GetNumRandom
       Loop
       MsgBox "Se recorrieron todos los numeros sin repetir alguno xD"
   '   //  Si se cambian los valores menor y mayor entonces es como si se le aplicara call .Reset
   '   //  Este codigo hara un test de repeticion
       .minval = 0
       .maxval = 99
       Do While (.GetMore = True)
           DoEvents
           Debug.Print .GetNumRandom
       Loop
       
       MsgBox "Se recorrieron todos los numeros sin repetir alguno xD"
   End With
End Sub



Temibles Lunas!¡.

.
en vb6 puedes usar el ocx del winsock, aun que no tiene caso en el framework ya trae una clase para esto, te puedes informar mas apliamente en el sub-foro correspondiente, ve a .NET-

P.D.: la clase para usar socket en .NEt en Sysmte.NET  ( http://www.elguille.info/colabora/puntoNET/PabloTilli_SocketsVBNET.htm )

Dulces Lunas!¡.

@Psyke1

Mas que una matriz quedaría precioso en una clase... al rato lo traslado a una clase para aumentar la velocidad de procesamiento, ya que de este modo se le aumenta el peformance ( en relación procesador/tiempo, pero no memoria ) con una clase.

@seba123neo

Te juro que busque con google como escribirla....
.

Dulces Lunas!¡.

[For Next]

.
Por si acaso ya hice una funcion Extentidad para generar un Numero Aleatorio, sin usar los For Next:  http://foro.elhacker.net/programacion_visual_basic/source_numeros_aleatorio_desde_x_a_y_con_esecciones-t328566.0.html

Temibles Lunas!¡.

[valor mínimo]

.
Lo que hace este código es que crea numero aleatorio desde un valor mínimo a uno valor máximo pero si se encuentra un numero Z entre los mismo JAMAS saldrá como numero aleatorio.

Una breve introducción antes del código fuente...

Aun no pruebo la velocidad...

OJO: Las esecciones no deben repetirse.

Código [Seleccionar] Expandir


NumerosAleatoriosEx (Numero Inicio, Numero Final, Array de valores a no considerar) {
MatrixRangos() = Realizar una búsqueda de valores para verificar si alguno de los numeros del array estan entre el valor de Inicio o el valor del Final: (un For Next bastara) , y generamos cortes de array's por ejemplo (  Inicio=0 final=10 array={5,8}  este paso genera 3 array que son:  {0,4},{6,7},{9,10} )
iIndice = Generamos un numero aleatorio desde Lbound(MatrixRangos()) hasta Ubound(MatrixRangos())
Retornamos el numero que se genera un numero aleatorio según los rangos que indique MatrixRangos( iIndice )(0) y MatrixRangos( iIndice )(1)
}


Código (Vb) [Seleccionar] Expandir



Option Explicit

Private Type stRangos
   lValIni         As Long
   lValEnd         As Long
End Type

Public Sub swapNumbers(ByRef lValOne As Long, ByRef lValTwo As Long)
Dim lValTmp         As Long
   lValTmp = lValOne
   lValOne = lValTwo
   lValTwo = lValTmp
End Sub

Public Function FixNumbers(ByRef lValMin As Long, lValMax As Long) As Boolean
   If lValMax < lValMin Then
       Call swapNumbers(lValMin, lValMax)
       FixNumbers = True
   End If
End Function

Public Function NumeroAleatorio(lValMin As Long, lValMax As Long) As Long
   Call FixNumbers(lValMin, lValMax)
   Call Randomize
   NumeroAleatorio = (lValMin - lValMax) * Rnd + lValMax
End Function

Public Function NumeroAleatorioEx(ByVal lValIni As Long, ByVal lValEnd As Long, ParamArray aNoRepet() As Variant) As Long
'   //  Debera pasarse el parametro {aNoRepet} ordenado de menor a mayor ( indice lbound siendo el valor menor y ubound el valor mayor ).
'   //  La funcion Si no puede generar un numero aleatorio retornara {lValIni-1}
On Error GoTo GetNumber
Dim avArray()       As Variant
Dim lUB             As Long
Dim lNextVal        As Long
Dim li              As Long, lIndex         As Long
Dim tRangos()       As stRangos

   If (Not IsMissing(aNoRepet)) Then
       If (IsArray(aNoRepet(0))) Then
           avArray = aNoRepet(0)
       Else
           avArray = aNoRepet
       End If
       
       lUB = UBound(avArray)
       Call Start_QuickSort(avArray, AcendetOrder)     '   //  http://infrangelux.hostei.com/index.php?option=com_content&view=article&id=14:artquicksortybublesort&catid=2:catprocmanager&Itemid=8
       
       ReDim tRangos(0 To (lUB + 1))                   '   //  Cache de memoria...
       With tRangos(0)
           .lValIni = lValIni
           .lValEnd = lValEnd
       End With
       lNextVal = lValIni
       lIndex = 0
       
       For li = 0 To lUB
           If (avArray(li) <= lValEnd And _
               avArray(li) > lValIni And _
               lNextVal <> avArray(li)) Then
               If (lNextVal > lValIni) Then
                   lIndex = lIndex + 1
                   With tRangos(lIndex)
                       .lValIni = lNextVal
                       .lValEnd = avArray(li) - 1
                   End With
                   lNextVal = (avArray(li) + 1)
                   
               ElseIf (lNextVal = lValIni) Then
                   tRangos(lIndex).lValEnd = avArray(li) - 1
                   lNextVal = (avArray(li) + 1)
                   
               End If
           ElseIf (avArray(li) = tRangos(0).lValIni) Then
               lIndex = lIndex - 1
               lNextVal = tRangos(0).lValIni + 1
           Else
               lNextVal = lNextVal + 1
           End If
       Next
       
       If (lIndex > -1) Then
           If ((tRangos(lIndex).lValEnd + 1) <= lValEnd And lNextVal <= lValEnd) Then
               lIndex = lIndex + 1
               ReDim Preserve tRangos(0 To lIndex)
               With tRangos(lIndex)
                   .lValIni = avArray(lUB) + 1
                   .lValEnd = lValEnd
               End With
           Else
               ReDim Preserve tRangos(0 To lIndex)
           End If
           
       ElseIf (lNextVal > lValEnd) Then
           NumeroAleatorioEx = lValIni - 1
           Exit Function
           
       Else
           lIndex = 0
           tRangos(lIndex).lValIni = lNextVal
           
       End If
       
       li = NumeroAleatorio(0, lIndex)
       NumeroAleatorioEx = NumeroAleatorio(tRangos(li).lValIni, tRangos(li).lValEnd)
       Exit Function
       
   End If
GetNumber:
   NumeroAleatorioEx = NumeroAleatorio(lValIni, lValEnd)
End Function

Private Sub Form_Load()
Dim ii              As Integer
Dim lres            As Long
Dim vArray()        As Variant

Const lValIni       As Long = 5
Const lValEnd       As Long = 10
   
   lres = NumeroAleatorioEx(lValIni, lValEnd)
   ReDim vArray(0 To 0)
   vArray(ii) = lres
   Debug.Print lres
   For ii = 1 To 11
       lres = NumeroAleatorioEx(lValIni, lValEnd, vArray)
       ReDim Preserve vArray(0 To ii)
       vArray(ii) = lres
       If (lres = (lValIni - 1)) Then
           Debug.Print "Ya no se pueden crear mas numeros aleatorios, las esecciones llenan todas las opciones."
       Else
           Debug.Print lres
       End If
   Next ii
End Sub



Salida del ejemplo:

Código [Seleccionar] Expandir



10
7
9
8
6
5
Ya no se pueden crear mas numeros aleatorios, las esecciones llenan todas las opciones.
Ya no se pueden crear mas numeros aleatorios, las esecciones llenan todas las opciones.
Ya no se pueden crear mas numeros aleatorios, las esecciones llenan todas las opciones.
Ya no se pueden crear mas numeros aleatorios, las esecciones llenan todas las opciones.
Ya no se pueden crear mas numeros aleatorios, las esecciones llenan todas las opciones.
Ya no se pueden crear mas numeros aleatorios, las esecciones llenan todas las opciones.



Temibles Lunas!¡.

[WH_KEYBOARD_LL]

Estero sepas leer, si no sabes ingles, hay esta el traductor de google.

Hooks.
SetWindowsHookEx Function (puedes usar alguna de estas dos constantes: WH_KEYBOARD_LL o WH_KEYBOARD).

P.D.: raul338 tiene un Ctl que te puede ayudar en esto que deseas hacer.

Dulces Lunas!¡.

Código [Seleccionar] Expandir



Function Split(expression As String, [Delimiter], [Limit As Long = -1], [Compare As VbCompareMethod = vbBinaryCompare])
    Miembro de VBA.Strings
    Divide una cadena a un arreglo de los mismo.
Donde:
    expression: Cadena a dividir
    Parámetros opcionales (Puedes ponerlos o no ponerlos):
        Delimiter: cadena imitadora ( Es con la que se corta una cadena )
        Limit: Limita el numero de particiones de una cadena ( izquierda a derecha ).
        Compare: Tipo de comparación
            vbBinaryCompare: Comparación binaria, debe ser exactamente igual ( ignora igualdades de mayúsculas de minúsculas Eje: A distinto de a ).
            vbTextCompare: Comparación binaria pero reconoce las igualdades de A y a.
            vbDatabaseCompare: lo desconozco; En la MSDN debería existir información sobre esta constante.


Dulces Lunas!¡.