|
31
|
Programación / Programación C/C++ / [duda] implementando la clase reverse_iterator
|
en: 17 Junio 2011, 10:11 am
|
. Estoy probando las plantillas que trae la STL y me viene a la mente usar la clase reverse_iterator. La cuestión es como la uso, hasta ahora solo hice una cutre pero sin usar la plantilla reverse_iterator? #ifndef cbyte_H #define cbyte_H #include <string.h> #include <iterator> using namespace std; #ifndef _BYTE_ #define _BYTE_ typedef unsigned char byte; #endif //#ifndef _BYTE_ class bytesiterator : public iterator<input_iterator_tag, byte> { private: const byte *__p_vbyte; public: bytesiterator ( const byte *__pv_byte ) : __p_vbyte(__pv_byte) { }; virtual ~bytesiterator() {}; bytesiterator &operator++() {++this->__p_vbyte;return *this;} bytesiterator operator++(int) {bytesiterator tmp(*this); operator++(); return tmp;} bytesiterator &operator--() {--this->__p_vbyte;return *this;} bytesiterator operator--(int) {bytesiterator tmp(*this); operator--(); return tmp;} bool operator ==(const bytesiterator &__r_cbyte) {return this->__p_vbyte==__r_cbyte.__p_vbyte;} bool operator !=(const bytesiterator &__r_cbyte) {return this->__p_vbyte!=__r_cbyte.__p_vbyte;} int operator *() {return *this->__p_vbyte;} }; class bytesiteratorreverse : public iterator<input_iterator_tag, byte> { private: const byte *__p_vbyte; public: bytesiteratorreverse ( const byte *__pv_byte ) : __p_vbyte(__pv_byte) { }; virtual ~bytesiteratorreverse() {}; bytesiteratorreverse &operator++() {--this->__p_vbyte;return *this;} bytesiteratorreverse operator++(int) {bytesiteratorreverse tmp(*this); operator++(); return tmp;} bytesiteratorreverse &operator--() {++this->__p_vbyte;return *this;} bytesiteratorreverse operator--(int) {bytesiteratorreverse tmp(*this); operator--(); return tmp;} bool operator ==(const bytesiteratorreverse &__r_cbyte) {return this->__p_vbyte==__r_cbyte.__p_vbyte;} bool operator !=(const bytesiteratorreverse &__r_cbyte) {return this->__p_vbyte!=__r_cbyte.__p_vbyte;} int operator *() {return *this->__p_vbyte;} }; #ifndef _bytecontainer_ #define _bytecontainer_ class bytes { protected: byte *__p_vbytes; size_t _ln; public: typedef bytesiterator iterator; typedef bytesiteratorreverse reverse_iterator; bytes ( const byte* __p_vbytes , size_t _ln) { this->__p_vbytes = new byte[_ln]; this->_ln = _ln; memcpy( this ->__p_vbytes , __p_vbytes , _ln ); } bytes ( ) { this->__p_vbytes = NULL; this->_ln = 0; } bytes ( size_t _ln ) { this->__p_vbytes = new byte[_ln]; this->_ln = _ln; memset( this ->__p_vbytes , 0 , _ln ); } virtual ~bytes () { delete[] this->__p_vbytes; } size_t leght() { return this->_ln; } byte* __p() { return this->__p_vbytes; } void clear() { if ( this->__p_vbytes ) delete[] this->__p_vbytes; this->_ln = 0; } iterator begin() { //bytesiterator _v_tmp( (const byte*)this->__p_vbytes ); iterator _v_tmp( (const byte*)this->__p_vbytes ); return _v_tmp; } iterator end() { //bytesiterator _v_tmp( (const byte*)(&this->__p_vbytes[this->_ln]) ); iterator _v_tmp( (const byte*)(&this->__p_vbytes[this->_ln]) ); return _v_tmp; } reverse_iterator rbegin() { //reverse_iterator _v_tmp( (const byte*)(&this->__p_vbytes[this->_ln-1]) ); reverse_iterator _v_tmp( (const byte*)(&this->__p_vbytes[this->_ln-1]) ); return _v_tmp; } reverse_iterator rend() { //reverse_iterator _v_tmp( (const byte*)(this->__p_vbytes-sizeof(byte)) ); reverse_iterator _v_tmp( (const byte*)(this->__p_vbytes-sizeof(byte)) ); return _v_tmp; } bytes &operator+=( bytes &__p_cbyte) { byte *__p_vbytes = this->__p_vbytes; size_t _ln = 0; size_t _pos = 0; if ( __p_cbyte.__p_vbytes!=NULL && __p_cbyte._ln>0 ) { if ( this->_ln>0 && this->__p_vbytes!=NULL ) { _ln = this->_ln + __p_cbyte._ln; _pos = this->_ln; } else { _ln = __p_cbyte._ln; } __p_vbytes = new byte[_ln]; memcpy( &__p_vbytes [_pos ] , __p_cbyte.__p_vbytes , __p_cbyte._ln ); if ( this->__p_vbytes!=NULL && this->_ln>0 ) { memcpy( __p_vbytes , this ->__p_vbytes , this ->_ln ); delete[] this->__p_vbytes; } } this->__p_vbytes = __p_vbytes; this->_ln = _ln; return *this; } bytes &operator=( bytes &__p_cbyte ) { byte *__p_vbytes = NULL; if ( this != &__p_cbyte ) { this->_ln = __p_cbyte._ln; if ( this->_ln>0 && __p_cbyte.__p_vbytes != NULL ) { __p_vbytes = new byte[this->_ln]; memcpy( __p_vbytes , __p_cbyte.__p_vbytes , this ->_ln ); } else { this->_ln = 0; } delete[] this->__p_vbytes; this->__p_vbytes = __p_vbytes; } return *this; } operator byte*() { return this->__p_vbytes; } operator size_t() { return this->_ln; } operator long int() { return (long int)this->_ln; } operator unsigned long int() { return (unsigned long int)this->_ln; } bool operator ==( bytes &__pc_byte ) { size_t _szt_pos = 0; if ( __pc_byte.__p_vbytes == this->__p_vbytes ) { return true; } if ( (this->_ln == __pc_byte._ln) && (__p_vbytes != NULL) && (this->__p_vbytes!=NULL) ) { while ( _szt_pos<this->_ln ) { if ( __pc_byte.__p_vbytes[_szt_pos] == this->__p_vbytes[_szt_pos] ) { _szt_pos++; } else { return false; } }; return true; } return false; } }; #endif //#ifndef _bytecontainer_ #endif // cbyte_H
P.D.: Revise esta liga http://www.cplusplus.com/reference/std/iterator/reverse_iterator/reverse_iterator/ pero cuando la implemento no me sirve ( con respecto a esta clase ). Dulces Lunas!¡.
|
|
|
32
|
Foros Generales / Sugerencias y dudas sobre el Foro / [Sugerencia] Tareas en foros
|
en: 13 Junio 2011, 23:43 pm
|
. No estaría mal que pusieran una leyenda debajo de los temas destacados la leyenda "No se hacen tareas" o a la hora de crear un nuevo tema arriba/abajo/izquierda/derecha del campo del cuerpo del tema en esta ultima zona a mi me sobra espacio en la pagina y no estaría mal dicha leyenda o poner las reglas mas destacadas en alguna zona ( reglas que sean aleatorias o que cambien entre ellas. ).
Esto seria para que los moderadores solo lleguen lean y borren sin aviso alguno.
P.D.: la sugerencia se que puede no ser valida con respecto a que existe la sección de reglas del foro pero no estaria mal solo poner dicha leyenda.
Dulces Lunas!¡.
|
|
|
33
|
Programación / Programación C/C++ / [Duda] Sobrecarga de operadores
|
en: 13 Junio 2011, 09:20 am
|
Estoy haciendo infinidad de pruebas con estas sobrecargas que me han gustado demasiado a tal grado que veo por que dicen que c es tan potente, pero bueno yendo al punto mi problema surge al momento de sobrecargar el operador "+" y realizo varias sumas de mi clase. El resultado de la prueba debería de ser: 620 pero me da 20 alguien sabe a que se debe?. class clstest { public: clstest(); virtual ~clstest(); clstest &operator +( clstest &c1 ) { clstest tmp; int i = c1; tmp = (this->sMsg + i); return tmp; } clstest &operator +( int c1 ) { clstest tmp ; int a = (this->sMsg + c1); tmp = a; return tmp; } clstest &operator = (clstest &c1) { if ( this != &c1 ) { this->sMsg = c1; } return *this; } clstest &operator = (int c1) { this->sMsg = c1; return *this; } operator int() { return sMsg; } operator double() { return (double)sMsg; } protected: private: int sMsg; }; clstest::clstest() { //ctor this->sMsg=0; } clstest::~clstest() { //dtor } int main() { clstest a; a = 45; a = a + a + 10; a = a + a + 10 + a; a = a + a; int res = a; return 0; }
Dulces Lunas!¡.
|
|
|
34
|
Foros Generales / Foro Libre / Consejos para deteccion en 3D.
|
en: 11 Junio 2011, 11:31 am
|
. Estoy realizando un pequeño motor para un juego en C+OpenGL y me veo en la necesidad de crear una técnica viable para detectar las colisiones
Hay alguna manera lógica de detectar colisiones ( con rangos de error para no exigirle al procesador demasiado ) de manera que dichos objetos estén constantemente en movimiento y cambiando de forma, se que lo puedo hacer con la formula para saber la distancia entre dos puntos, pero la verdadera pregunta es como detectar la colisión entre dos masas?.
Mis opciones hasta ahora son: *Definir el centro de la masa(figura) (Detección de colisión por círculos) ( me parece viable, aunque definir el centro lo tendria que hacer en tiempo de diseño de las masas, y estos centros tendrían que ser "invisibles" cosa que no me agrada. ).
*Crear una masa "invisible" (Detección de choques por rectángulos) ( Es decir definir tantos rectángulos en lugares X de la masa y definir los centros de estos rectángulos y posteriormente por medio de 3 de sus vértices de un rectángulo (Coordenadas X,Y,Z de los 3 vértices) la una 4 ajena a este rectángulo. ).
Algunas sugerencias o ideas?
P.D.: No meto códigos ya que solo deseo obtener ideas.
Temibles Lunas!¡.
|
|
|
36
|
Programación / Programación Visual Basic / [Reto] Barrido de Bits.
|
en: 10 Junio 2011, 04:02 am
|
. Crear una función que mueva los bit's ( Por si se aparece Karkrack, Cobein o similares NO ASM-Inline) a la izquierda o derecha. (Los Números binarios se leen de izquierda a derecha, quien no tenga idea use la calculadora de windows o investigue en google como determinar el valor en Base 10). Los ejemplos son considerando { 1 Byte = 8 Bits, con el byte de signo.} la función deberá trabajar con (4 Bytes = 32 bit's = Long) Ejemplo 1:Se ingresa el numero 45 de desplazan 2 bit's a la izquierda el resultado es 180 es decir en binario:00101101 {Desplazando 2 bit's Resultado--->} 10110100 Ejemplo 2:Se ingresa el numero (-128) se desplazan 5 bit's a la izquierda el resultado es: 0 es decir en binario:10000000 {Desplazando 5 bit's Resultado--->} 00000000 Ejemplo 3:Se ingresa el numero 1 se desplazan 5 bit's a la izquierda el resultado es: 32 es decir en binario:00000001 {Desplazando 5 bit's Resultado--->} 00100000 Ejemplo 4:Se ingresa el numero 1 se desplazan 5 bit's a la derecha el resultado es: 0 es decir en binario:00000001 {Desplazando 5 bit's Resultado--->} 00000000 Ejemplo 5:Se ingresa el numero (-2) se desplazan 5 bit's a la derecha el resultado es: -1 es decir en binario:11111110 {Desplazando 5 bit's Resultado--->} 11111111 Ejemplo 6:Se ingresa el numero (-1) se desplazan 5 bit's a la derecha el resultado es: -1 es decir en binario:11111111 {Desplazando 5 bit's Resultado--->} 11111111 Formato de la funcion: Public Function Bits_d(ByVal lVal As Long, Optional lDesplazamiento As Integer) As Long '   //  lVal                Indica el valor ingresado (Base 10). '   //  lDesplazamiento     Indica la longitud de bit's a dezplazar. '   //  Bits_d              Retorna el resultado Final (Base 10)    ... End Function
Edito: Codigo para probar los resultados: Private Sub Form_Load() Dim lres As Long lres = DebugAndRet(Bits_d(267614144, (-1))) lres = DebugAndRet(Bits_d(lres, (-6))) lres = DebugAndRet(Bits_d(lres, 2)) lres = DebugAndRet(Bits_d(lres, 2)) lres = DebugAndRet(Bits_d(lres, 2)) lres = DebugAndRet(Bits_d(lres, 2)) lres = DebugAndRet(Bits_d(lres, (-2))) lres = DebugAndRet(Bits_d(lres, (-24))) End Sub Private Function DebugAndRet(ByVal lVal As Long) As Long Debug.Print lVal DebugAndRet = lVal End Function
Resultados en el Debug: 535228288 -105127936 -26281984 -6570496 -1642624 -410656 -1642624 -2147483648
Resultados en Binario: Pruebas con Test Manual... 00001111111100110111011111000000 <-- {267614144} <--- De este binario se parte... 00011111111001101110111110000000 <-- {-01} 11111001101110111110000000000000 <-- {-06} 11111110011011101111100000000000 <-- {+02} 11111111100110111011111000000000 <-- {+02} 11111111111001101110111110000000 <-- {+02} 11111111111110011011101111100000 <-- {+02} 11111111111001101110111110000000 <-- {-02} 10000000000000000000000000000000 <-- {-24} <-- {-2147483648}
Dulces Lunas!¡.
|
|
|
37
|
Programación / Programación Visual Basic / ASM en VB6 [Respuesta a Myserik]
|
en: 9 Junio 2011, 09:17 am
|
. el código lo pongo publico ya que a mas de a uno le interese a la larga, no soy experto en ASM pero bueno. Option Explicit Private Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long Private Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long Private Declare Function CallWindowProc Lib "USER32" Alias "CallWindowProcW" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Sub form_load() Dim bASM(0 To 27) As Byte Dim i As Integer Dim sMsg As String Dim sTitulo As String sMsg = "Hola Mundo" sTitulo = "Titulo de un msgbox" ' Cada Instruccion pesa {1 Bytes} y el numero de "_" son la cantidad de bytes esperados habitualmente si son 4 es que sea normalmente un puntero, pero eso depende del formato de la instruccion. ' Para informacion de los OpCodes: ' // http://ref.x86asm.net/geek.html ' PUSH ____ ' PUSH ____ ' PUSH ____ ' PUSH ____ ' MOV EAX, ____ ' CALL EAX ' RET i = 0 bASM(i) = &H68: i = LongToByte(vbYesNoCancel, bASM(), i + 1) ' PUSH {vbYesNoCancel} 5 bytes ( 1(&H68) + long(vbYesNoCancel) ). bASM(i) = &H68: i = LongToByte(StrPtr(sTitulo), bASM(), i + 1) ' PUSH {StrPtr(sTitulo)} 5 bytes ( 1(&H68) + long(StrPtr(sTitulo)) ).. bASM(i) = &H68: i = LongToByte(StrPtr(sMsg), bASM(), i + 1) ' PUSH {StrPtr(sMsg)} 5 bytes ( 1(&H68) + long(StrPtr(sMsg)) ).. bASM(i) = &H68: i = LongToByte(&H0, bASM(), i + 1) ' PUSH {&H0} 5 bytes ( 1(&H68) + long(&H0) ).. ' MOV {EAX},{LongToByte(GetProcAddress(LoadLibrary("user32.dll"), "MessageBoxW")} bASM(i) = &HB8: i = LongToByte(GetProcAddress(LoadLibrary("user32.dll"), "MessageBoxW"), bASM(), i + 1) ' 5 bytes bASM(i) = &HFF: i = i + 1 ' CALL ___ 1 bytes bASM(i) = &HD0: i = i + 1 ' EAX 1 bytes bASM(i) = &HC3: i = i + 1 ' RET 1 bytes MsgBox CallWindowProc(ByVal VarPtr(bASM(0)), 0&, 0&, 0&, 0&) ' Run ASM End Sub Private Function LongToByte(ByVal lLong As Long, ByRef bReturn() As Byte, Optional i As Integer = 0) As Long bReturn(i) = lLong And &HFF bReturn(i + 1) = (lLong And &HFF00&) \ &H100 bReturn(i + 2) = (lLong And &HFF0000) \ &H10000 bReturn(i + 3) = (lLong And &HFF000000) \ &H1000000 LongToByte = i + 4 End Function
Dulces Lunas!¡.
|
|
|
38
|
Programación / Programación Visual Basic / Recopilacion de Funciones con operaciones Binarias.
|
en: 5 Junio 2011, 08:07 am
|
Bueno ya sabemos que las funciones con operaciones binarias son mas rápidas y mas practicas a la hora de ejecutarse. La intención de este tema es que se creen una sola publicacion donde se pueden encontrar estas funciones de manera amena. ' // Para valores tipo Long Private Sub lSwap(ByRef lVal1 As Long, ByRef lVal2 As Long) ' // Intercambia {lVal1} por {lVal2} y {lVal2} a {lVal1} sin variable temporal lVal1 = lVal1 Xor lVal2 lVal2 = lVal2 Xor lVal1 lVal1 = lVal1 Xor lVal2 End Sub Private Function lIsNegative(ByRef lVal As Long) ' // Para cualquier valor que lVal pueda tomar. ' // Comprueba si lval es negativo. lIsNegative = (lVal And &H80000000) End Function Private Function iIsNegative(ByRef iVal As Integer) As Boolean ' // Para cualquier valor que iVal pueda tomar. ' // Comprueba si lval es negativo. iIsNegative = (iVal And 32768) End Function Private Sub iSwap(ByRef iVal1 As Integer, ByRef iVal2 As Integer) ' // Intercambia {iVal1} por {iVal2} y {iVal2} a {iVal1} sin variable temporal iVal1 = iVal1 Xor iVal2 iVal2 = iVal2 Xor iVal1 iVal1 = iVal1 Xor iVal2 End Sub Private Sub bSwap(ByRef iVal1 As byte, ByRef iVal2 As byte) ' // Intercambia {iVal1} por {iVal2} y {iVal2} a {iVal1} sin variable temporal iVal1 = iVal1 Xor iVal2 iVal2 = iVal2 Xor iVal1 iVal1 = iVal1 Xor iVal2 End Sub Function max(ByVal val1 As Long, ByVal val2 As Long) As Long If (val1 > val2) Then max = val1 Else max = val2 End If End Function Function min(ByVal val1 As Long, ByVal val2 As Long) As Long If (val1 > val2) Then min = val2 Else min = val1 End If End Function Function bSwapBit(ByVal myLong As Long, ByVal bit1 As Byte, ByVal bit2 As Byte) As Long ' Los bits se CUENTAS DE DERECHA A IZQUIERDA es decir: 31, 30, ... , 3, 2, 1, 0 ' Solo se admite rango 0 al 31. Dim aux As Long Dim mask As Long aux = max(bit1, bit2) bit2 = min(bit1, bit2) bit1 = aux ' max Debug.Assert (bit1 > 31) ' No se permiten numero mayores a 32 Debug.Assert (bit2 < 0) ' No se permiten valores negativos mask = Not ((2 ^ bit1) Or (2 ^ bit2)) aux = (2 ^ (bit1 - bit2)) bSwapBit = (myLong And mask) Or _ (myLong And (2 ^ bit1)) / aux Or _ (myLong And (2 ^ bit2)) * aux End Function
Si alguien se sabe mas y quiere aportarlas están en el lugar indicado. Temibles Lunas!¡.
|
|
|
39
|
Programación / Programación Visual Basic / [Src] cRndNumbersNR ( Generar números aleatorios sin repetir [Very-Fast] )
|
en: 28 Mayo 2011, 10:47 am
|
. @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 ' ' //////////////////////////////////////////////////////////////// ' // 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: 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!¡.
|
|
|
40
|
Programación / Programación Visual Basic / [source] Numeros Aleatorio desde X a Y con excepciones.
|
en: 24 Mayo 2011, 08:08 am
|
. 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. 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) }
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: 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!¡.
|
|
|
|
|
|
|