Temas

....
vean este tema... dice que lo creo el usuario DesSy pero solo se ve mi poublicacion ...

http://foro.elhacker.net/programacion_visual_basic/ayuda_iquestcomo_se_puede_ejecutar_pagina_web_clickeando_en_un_label_en_vb6-t324107.0.html

Dulces Lunas!¡.

[hWnd]

.
mmm en lugar de solo criticar la funcion pondre una de mi tutela que uso para esto, es decir centrar las cosas por medio de su hWnd, Sirve con:

* Objetos del form ( Botones, frames, etc... ).
* Ventanas ( de la aplicacion o externas ).
* Pantalla  ( Centra el objeto con restecto a la pantalla ).
* Funciona con TODO lo que tenga un hWnd valido.

Codigo Actualizado:

Código (vb) [Seleccionar] Expandir



'
' ////////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
' //                                                            //
' // Web: http://InfrAngeluX.Sytes.Net/                         //
' //                                                            //
' // |-> Pueden Distribuir Este Código siempre y cuando         //
' // no se eliminen los créditos originales de este código      //
' // No importando que sea modificado/editado o engrandecido    //
' // o achicado, si es en base a este código                    //
' ////////////////////////////////////////////////////////////////
' //
' ////////////////////////////////////////////////////////////////

Option Explicit

Private Type POINTAPI
    x       As Long
    y       As Long
End Type
Private Type RECT
    Left    As Long
    Top     As Long
    Right   As Long
    Bottom  As Long
End Type

Enum WS_InCenterOpt
    InScreen = 0
    InObject = 1
    InParent = 2
    InWinExtern = 3
End Enum

Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long

Public Function WinCenterIn(ByVal hwnd As Long, Optional ByVal InhWnd As Long = 0, Optional ByVal Opt As WS_InCenterOpt = InParent)
Dim st_retm         As RECT
Dim st_retd         As RECT
Dim st_pt           As POINTAPI

    If GetWindowRect(hwnd, st_retm) <> 0 Then
   
        Select Case Opt
       
            Case InObject, InParent, InWinExtern
                If Opt = InParent Then
                    InhWnd = GetParent(hwnd)
                    If InhWnd = 0 Then
                        WinCenterIn = WinCenterIn(hwnd, 0, InScreen)
                    End If
                End If
                If GetWindowRect(InhWnd, st_retd) = 0 Then
                    Exit Function
                End If

            Case InScreen
                st_retd.Bottom = GetSystemMetrics(&H1)
                st_retd.Right = GetSystemMetrics(&H0)
               
            Case Else
                Exit Function
               
        End Select
   
        st_pt.x = st_retd.Left + ((st_retd.Right - st_retd.Left) - (st_retm.Right - st_retm.Left)) \ 2
        st_pt.y = st_retd.Top + ((st_retd.Bottom - st_retd.Top) - (st_retm.Bottom - st_retm.Top)) \ 2
       
        If Opt <> InWinExtern Then
            Call ScreenToClient(InhWnd, st_pt)
        End If
       
        WinCenterIn = MoveWindow(hwnd, st_pt.x, st_pt.y, (st_retm.Right - st_retm.Left), (st_retm.Bottom - st_retm.Top), 1) <> 0

    End If
   
End Function



Ejemplo:

Código (vb) [Seleccionar] Expandir



Option Explicit

Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Sub Command2_Click()
    WinCenterIn Me.hwnd
    WinCenterIn FindWindowA(vbNullString, "Administrador de tareas de Windows"), Me.hwnd, InWinExtern
    'WinCenterIn Me.hwnd, FindWindowA(vbNullString, "Administrador de tareas de Windows"), InWinExtern
End Sub



Version Anterior:

Código [Seleccionar] Expandir



'
' ////////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
' //                                                            //
' // Web: http://InfrAngeluX.Sytes.Net/                         //
' //                                                            //
' // |-> Pueden Distribuir Este Código siempre y cuando         //
' // no se eliminen los créditos originales de este código      //
' // No importando que sea modificado/editado o engrandecido    //
' // o achicado, si es en base a este código                    //
' ////////////////////////////////////////////////////////////////
' //
' ////////////////////////////////////////////////////////////////

Option Explicit

Private Type POINTAPI
    x       As Long
    y       As Long
End Type
Private Type RECT
    Left    As Long
    Top     As Long
    Right   As Long
    Bottom  As Long
End Type

Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long

Public Function WinCenterIn(ByVal hwnd As Long, Optional ByVal InhWnd As Long = 0, Optional ByVal WinExterna As Boolean)
Dim st_retm         As RECT
Dim st_retd         As RECT
Dim st_pt           As POINTAPI


    If GetWindowRect(hwnd, st_retm) = 0 Then
        Exit Function
    End If
   
    If InhWnd = 0 Then
        st_retd.Bottom = GetSystemMetrics(&H1)
        st_retd.Right = GetSystemMetrics(&H0)
    Else
        If GetWindowRect(InhWnd, st_retd) = 0 Then
            Exit Function
        End If
    End If
   
    st_pt.x = st_retd.Left + (Abs((st_retd.Right - st_retd.Left) - (st_retm.Right - st_retm.Left))) \ 2
    st_pt.y = st_retd.Top + (Abs((st_retd.Bottom - st_retd.Top) - (st_retm.Bottom - st_retm.Top))) \ 2
   
    If Not WinExterna And InhWnd = 0 Then
        Call ScreenToClient(InhWnd, st_pt)
    Else
        Call ScreenToClient(InhWnd, st_pt)
        st_pt.x = st_pta.x + st_pt.x
        st_pt.y = st_pta.y + st_pt.y
    End If
    WinCenterIn = MoveWindow(hwnd, st_pt.x, st_pt.y, (st_retm.Right - st_retm.Left), (st_retm.Bottom - st_retm.Top), 1) <> 0
   
End Function



La implementacion es bastante sencilla.

Código (Vb) [Seleccionar] Expandir



WinCenterIn Command1.hwnd, Me.hwnd
WinCenterIn Command1.hwnd, 0
WinCenterIn me.hwnd, 0



Temibles Lunas!¡.

[undefined reference to ´...´]

.
bueno ando provando OpenGL en C++ y todo perfecto con GLUT, pero cuando intento usar las apis:

Código (cpp) [Seleccionar] Expandir



    glClearColor(0.0,0.0,0.0,0.0);
    glClear(GL_COLOR_BUFFER_BIT);
    glMatrixMode(GL_PROJECTION);
    glLoadIdentity();
    glOrtho(-1.0,1.0,-1.0,1.0,-1.0,1.0);
    glMatrixMode(GL_MODELVIEW);
    glBegin(GL_TRIANGLES);
    glColor3f(1.0,0.0,0.0);
    glVertex3f(0.0,0.8,0.0);
    glColor3f(0.0,1.0,0.0);
    glVertex3f(-0.6,-0.2,0.0);
    glColor3f(0.0,0.0,1.0);
    glVertex3f(0.6,-0.2,0.0);
    glEnd();
    glFlush();



Me sale error de undefined reference to ´...´ a cada una de estas apis.

caso contrario con:

Código (cpp) [Seleccionar] Expandir



    glutInitDisplayMode(GLUT_SINGLE | GLUT_RGBA);
    glutInitWindowPosition(20,20);
    glutInitWindowSize(500,500);
    glutCreateWindow((const char*)&argv[0]);
    glutDisplayFunc(display);
    glutMainLoop();



Que me falta linkear?.

P.D.: tengo el linkeada la libreria glut32.lib, en el proyecto.

Dulces Lunas!¡.

[Great Cow Basic]

.
El compilador se llama Great Cow Basic y sirve para programar en los microchips.

* Es de codigo abierto.
* Free.
* Instalacion en Windows y Linux.
* Las variables tal y como son declaras, se ven reflejados en el codigo ASM final es decir no agrega nombres raros al codigo ASM final.

Manual es Español

http://gcbasic.sourceforge.net/index.html

Código (vb) [Seleccionar] Expandir



'Led parpadeante

#chip 16F628A, 20      'modelo de pic y velocidad de reloj: 20 Mhz

#define led PORTB.1

Main:
   TRISB=0
   PORTB=0

   led = 1
   wait 500 ms
   led = 0
   wait 500 ms

goto Main



Codigo ASM generado de manera limpia.

Código (asm) [Seleccionar] Expandir



;Program compiled by Great Cow BASIC (0.9 13/9/2008)
;Need help? See the GCBASIC forums at http://sourceforge.net/forum/?group_id=169286,
;check the documentation or email w_cholmondeley@users.sourceforge.net.

;********************************************************************************

;Set up the assembler options (Chip type, clock source, other bits and pieces)
LIST p=16F628A, r=DEC
#include
__CONFIG _HS_OSC & _WDT_OFF & _LVP_OFF & _MCLRE_OFF

;********************************************************************************

;Set aside memory locations for variables
DELAYTEMP    equ    32
DELAYTEMP2    equ    33
RANDOMSEED    equ    34
RANDOMSEED_H    equ    35
SysWaitTempMS    equ    36
SysWaitTempMS_H    equ    37

;********************************************************************************

;Jump to initialisation code when PIC is reset
   ORG    0
   call    INITSYS
   goto    SystemInitialise

;********************************************************************************

;Interrupt vector
   ORG    4
;Various initialisation routines, automatically called by GCBASIC
SystemInitialise

;********************************************************************************

;Start of the main program
MAIN
   banksel    TRISB
   clrf    TRISB
   banksel    PORTB
   clrf    PORTB
   bsf    PORTB,1
   movlw    244
   movwf    SysWaitTempMS
   movlw    1
   movwf    SysWaitTempMS_H
   call    Delay_MS
   bcf    PORTB,1
   movlw    244
   movwf    SysWaitTempMS
   movlw    1
   movwf    SysWaitTempMS_H
   call    Delay_MS
   goto    MAIN
BASPROGRAMEND
   sleep
   goto    $

;********************************************************************************
;Subroutines included in program
;********************************************************************************

Delay_MS
   incf    SysWaitTempMS_H, F
DMS_START
   movlw    10
   movwf    DELAYTEMP2
DMS_OUTER
   movlw    166
   movwf    DELAYTEMP
DMS_INNER
   decfsz    DELAYTEMP, F
   goto    DMS_INNER
   decfsz    DELAYTEMP2, F
   goto    DMS_OUTER
   decfsz    SysWaitTempMS, F
   goto    DMS_START
   decfsz    SysWaitTempMS_H, F
   goto    DMS_START
   return

;********************************************************************************

INITSYS
   movlw    7
   movwf    CMCON
   clrf    PORTA
   clrf    PORTB
   return

;********************************************************************************

END



Dulces Lunas!¡.

[S.O.]

.

Bueno ya NO pueden decir que no se puede hacer un S.O.. en el lenguaje Basic ni denigrarlo tanto.

http://wiki.osdev.org/FreeBasic_Barebones

Dulces Lunas!¡.

[R]

.
Realizar un Codigo fuente que se imprima a si mismo exactamente SIN EXCEPCIÓN ALGUNA, de manera EXACTA (cadenas declaraciones procesos, etc.).

* De 1 a l 10 en conocimientos donde 1 sabe manejar y se sabe las condiciones del lenguaje, como minimo 4.
* El codigo imprimido puede ser porun msgbox impresora, por un Debugger, un archivo de texto ne fin solo que devuelva su propio codigo fuente ( Recomiendo hacerlo en el Sub main() ).
* NO VALE LEER ARCHIVOS EXTERNOS de ninguna indole.

Publicar su codigo el dia 26/02/2011 ( en este día publicare mi código ) , esto es solo para dar tiempo para que piensen como hacerlo, y que no vean otros un codigo fuente y se inspiren en el, USEN SU MATERIA GRIS!¡.

--------------------

* No vale extraer el codigo fuente de otro lado externo a el programa, recurso, etc debera ser un codigo simple.
* Si tu codigo hace mension a una dll externa igual cuenta como codigo del mismo programa, asi que cuidado con los mañosos.
* Como vez dice A SI MISMO, debera ser lo mismo si esta o no esta compilado, es decir que si funciona en el IDE pero no en un exe no vale.
* En otras palabras si haces un Addin vas a tener que mostrar el codigo fuente del Addin no hay otra. si lo compilas te devera mostrar el codigo fuente original, si lo ejecutas debera realizar lo mismo; es decir

Si tu codigo fuente es:

Código:

Código (vb) [Seleccionar] Expandir



sub main()
    codigo
end sub



El programa al ejecutarlo debera mostrarte su mismo codigo es decir TODO Sub main() con TODO lo que haya dentro y fuera de el mismo, si metes modulo, clases, comentarios funciones procesos, de igual manera.

La cosa es pensar, en como rayos hacerlo pero de que se puede se puede NO hay que manejar APIS estructuras ni nada similar, es solo y unicamente LÓGICA.


---------------

Debido a los amigos que dieron demasiados detalles ahora el limite de tiempo ya no tiene caso.

La parte comentada es mi codigo resultante.

Código (Vb) [Seleccionar] Expandir



Sub main(): Const s As String = "Sub main(): Const s As String = @: msgbox Replace$(s, Chr(64), Chr(34) & s & Chr(34)): End Sub": MsgBox Replace$(s, Chr(64), Chr(34) & s & Chr(34)): End Sub
'Sub main(): Const s As String = "Sub main(): Const s As String = @: msgbox Replace$(s, Chr(64), Chr(34) & s & Chr(34)): End Sub": MsgBox Replace$(s, Chr(64), Chr(34) & s & Chr(34)): End Sub



Temibles Lunas!¡.

[setnewptr]

.
mi problema es que en TEORIA mi funcion setnewptr deberia de asignar y/o devolver en el parametro old el puntero a New, pero solo lo afecta dentro de la funcion mas cuando termina no me afecta a c_pstr... ¿Como puedo solucionar esto?...

Aquí lo que digo...

Código (cpp) [Seleccionar] Expandir



#include<iostream>
#include<cstdlib>
#include<cstring>

using namespace std;

void* setnewptr( void *old , void *New);

int main() {
   char *c_pstr = NULL;
   char *c_str = (char*)malloc(sizeof(char)*10);
   strcpy(c_str , (const char*)"Hola");
   cout << (char*)setnewptr( c_pstr , c_str );
   cout << c_pstr << endl;
   return 0;
}

void* setnewptr( void *old , void *New)
/**
   Libera a [*old] si apunta a algo y le establece [*New];
   By BlackZeroX ( http://Infrangelux.sytes.net/ )
**/
{
   if ( old != NULL )
       free (old);
   return old=New;
}



.
Como se lee e interpreta esto?



P.D.: mi problema es ese simbolo que parece M invertida, recuerdo que era una suma pero ya se me olvido el como se usa, lee e interpreta.

Dulces Lunas!¡.

[WH_CBT]

.
Tengo un problema al realizar el hook al mensaje WH_CBT de forma global mas no por Theard y es que no se instala dicho hook, obtube el error y su descripción pero ni idea a que se refiere  .

Código (c) [Seleccionar] Expandir



#include <iostream>
#include <windows.h>

HHOOK hHRes;

LRESULT CALLBACK CBTProc( int , WPARAM , LPARAM );
void ErrorExit(LPTSTR lpszFunction);

int main()
{
    char s[500] ={};
    hHRes = ::SetWindowsHookExA( WH_CBT , &CBTProc , GetModuleHandle( NULL ) , 0 );
    if ( hHRes == NULL ) {
       /* le resto 2 para establecer un caracter nulo en formato WCHAR */
       ::FormatMessage( FORMAT_MESSAGE_FROM_SYSTEM , NULL , ::GetLastError() , NULL , (WCHAR*)&s , (DWORD) strlen(&s[0])/2 - 2 , NULL );
       ::MessageBoxExW(NULL,(WCHAR*)&s,NULL,0,NULL);
    }
    return 0;
}

LRESULT CALLBACK CBTProc( int nCode, WPARAM wParam, LPARAM lParam )
{
    ::UnhookWindowsHookEx( hHRes );
    return ::CallNextHookEx( hHRes , nCode , wParam , lParam );
}



Edito: Lei por hay que se debe hacer esto en una dll, que tan cierto es?...

Temibles Lunas!¡.
.

.
Puedo redirigir un proceso por medio de funciones normales, pero lo que realmente quiero es redirrecionar a un miembro (una funcion) dentro de la clase, pero me marca error.

Como se puede hacer un CallBack a un miembro( Funcion ) de una clase?.

Código (c) [Seleccionar] Expandir


/* Con y sin & me marca error */
/* Intento cambiar el proceso que resive los mensajes de "this->v_hWinSock" a otro proceso/mienbro de una clase */
this->v_PrevProc = SetWindowLongA( this->v_hWinSock , GWL_WNDPROC, (DWORD)&this->WndProc);


Dulces Lunas!¡.
.

.
¿Siempre se debe declarar int a un puntero de una funcion/proceso?, me estoy leyendo un articulo al respecto que es de C++, pero quisiera saber si en ANSI C es lo mismo o si los punteros a funciones ANSI C son de otra forma.

[congetura]
    * Creo y supongo que se declara con el tipo que devuelve la funcion, similar a la declaracion de un prototipo pero difiriendo de esta.
[/congetura]

Dulces Lunas!¡.

[split()]

.
Esta es la version de split() ya esta corregida debugeada y sirve en todo caso.

Quien no sepa usar Vectores en C esta muerto ( ** ), es decir Puntero a Puntero.

Corregido por segunda vez:

Código (c) [Seleccionar] Expandir



#include<stdlib.h>
#include<stdio.h>

#ifndef bool
typedef enum bool { false, true } bool;
#endif

unsigned int rectific_num(unsigned int vval,unsigned int vmin,unsigned int vmax);
bool fix_numbers_range(unsigned int* vIndexIni,unsigned int* vIndexEnd, unsigned int* vLen, unsigned int vMin, unsigned int vMax);
unsigned long strlen(char* string);
unsigned long instr(unsigned long start,char* string1,char* string2);
char* mid(char* str, unsigned int start, unsigned int len);
char* strcpy(char* str_dest,char* str_src);
char** split(char* str, char* delimiter, long* limit);

int main()
{

   long lim=-1;
   long i=0;
   char **array = split((char*)".Este.es.Hola.Mundo.Hola.mundo.",(char*)".",&lim);

   if ( array != 0 )
   {
       printf("Index\tValue\n",lim);
       for ( i=0 ; i <= lim ;i++ )
       {
           printf("%d\t%s\n",i,array[i]);
           free (array[i]);
       }
       free(array);
   }
   getchar();
   return 0;
}

unsigned int rectific_num(unsigned int vval,unsigned int vmin,unsigned int vmax)
/**
   Corrige [vVal] con respecto a un minimo y a un maximo valor.
   By BlackZeroX ( http://Infrangelux.sytes.net/ )
**/
{
   if (vval < vmin)
       return vmin;
   else if ( vval > vmax )
       return vmax;
   else
       return vval;
}

bool fix_numbers_range(unsigned int* vIndexIni,unsigned int* vIndexEnd, unsigned int* vLen, unsigned int vMin, unsigned int vMax)
/**
   Corrige los rangos de [vIndexIni],[vIndexEnd], [vLen] con respecto a un minimo y a un maximo valor.
   [vLen] corresponde a la distancia entre [vIndexIni] y [vIndexEnd].
   Se retorna false solo si [vMax] es menor que que [vIndexIni] o que [*vLen] es igual o menor a [0]
   By BlackZeroX ( http://Infrangelux.sytes.net/ )
**/
{
   if ( vMax >= *vIndexIni && *vLen != 0 )
   {
       *vIndexIni = rectific_num(*vIndexIni,vMin,vMax);
       *vIndexEnd = rectific_num(*vIndexIni + *vLen,*vIndexIni,vMax);
       *vLen= *vIndexEnd - *vIndexIni+1;
       return ( (*vLen > 0) ? true: false);
   } else {
       return false;
   }
}

unsigned long strlen(char* string)
/**
   Retorna la longitud de [string]
   By BlackZeroX ( http://Infrangelux.sytes.net/ )
**/
{
   unsigned long i=0;
   while (*(string++)) i++;
   return i;
}

char* strcpy(char* str_dest,char* str_src)
/**
   Copia [*str_src] a [*str_dest].
   Retorna el puntero a [str_dest]
   By BlackZeroX ( http://Infrangelux.sytes.net/ )
**/
{
   char *copyreturn = str_dest;
   while(*(str_dest++)=*(str_src++));
   return copyreturn;
}

unsigned long instr(unsigned long start,char* string1,char* string2)
/**
   [Start] indica la posicion inicial donde se empesara a buscar en [string1]
   Retorna la posicion de [*string2] en [*string1].
   By BlackZeroX ( http://Infrangelux.sytes.net/ )
**/
{
   unsigned long  q,c,limit;
   q=c=limit=0;
   long ls2len=0;

   ls2len = strlen(string2) - 1;

   if ( ls2len >= 0 )
   {
       limit = strlen(string1)-ls2len;

       if ( limit > 1 )
       {
           q = start-1;
           while ( q < limit )
           {
               while ( string1[q+c] == string2[c] )
                   if ( (c++) == (unsigned long)ls2len )
                       return q+1;
               q+=c+1;
               c=0;
           }
       }
   } else if (*string1 > '\0') {
       return 1;
   }
   return 0;
}
char* mid(char* str, unsigned int start, unsigned int len)
/**
   Se obtiene el fragmento deseado de [*str]
   [Start] Indica desde donde se empesara
   [Len] Indica la distancia.
   Retorna el puntero al clon del fragmento deseado de [*str]
   By BlackZeroX ( http://Infrangelux.sytes.net/ )
**/
{
   char* pch_t = 0;
   unsigned int ul_str=strlen(str);
   unsigned int ul_end=start+len;
   start--;
   if ( fix_numbers_range(&start,&ul_end,&len,0,ul_str) == true )
   {
       if ( (pch_t = (char*)malloc(sizeof(char)*len)) != 0 )
       {
           for (ul_str=0;ul_str < (len-1) ;start++,ul_str++ )
               pch_t[ul_str] = str[start];
           pch_t[len-1]='\0';
       }
   } else {
       if ( (pch_t = (char*)malloc(sizeof(char))) != 0 )
           pch_t[0]='\0';
   }
   return pch_t;
}

char** split(char* str, char* delimiter, long* limit)
/**
   Separa a [*str] cada vez que se encuentre a [*delimiter] con un limite definido en [*limit]
   Si [*limit] = -1 se crea un Maximo mayor a [-1] en el indice del vector retornado
   Si [*limit] > -1 Se indica y establece un indice mayor [pero no fijo] del indice mayor del vector retornado
   En ambos casos [*limit] retorna el Indice maximo del vector retornado por la funcion y la funcion retorna el puntero a el vector retultante.
   En casos contrarios no crea un vector y retorna 0 y [*limit] = [-1]
   By BlackZeroX ( http://Infrangelux.sytes.net/ )
**/
{
   unsigned int ui_lp  =1;
   unsigned int ui_inc =1;
   unsigned int ui_lns =0;
   unsigned int ui_del =0;
   unsigned long ui_ub =0;
   char **pi_out       =0;

   if ( *limit >= -1 )
   {
       if ( strlen(delimiter) == 0 )
           delimiter = (char*)" ";
       ui_lns = strlen(str);
       ui_del = strlen(delimiter);
       pi_out = (char**)malloc(sizeof(char*));
       for(;pi_out!=0;)
       {
           if ( ui_ub == *limit )
           {
               pi_out[ui_ub] = mid(str, ui_lp,ui_lns);
               ui_ub = *limit;
               break;
           }
           ui_inc = instr(ui_inc, str, delimiter);
           if ( ui_inc == 0 )
           {
               pi_out[ui_ub] = mid(str, ui_lp,ui_lns);
               break;
           }
           pi_out[ui_ub] = mid(str, ui_lp, ui_inc - ui_lp);
           pi_out = (char**)realloc(pi_out,sizeof(char*)*(++ui_ub+1));
           ui_lp = ui_inc + ui_del;
           ui_inc = ui_lp;
       }
       *limit = ui_ub;
       return pi_out;
   }
   *limit=-1;
   return 0;
}



Nota.: Si alguien ve algun fallo por favor de no golpearme gracias!¡.

Temibles Lunas!¡.

.
Version Anterior Go To ListView 1.0

• Este Control Esta Re-Programado al 100% ademas de que el codigo esta 100% mas legible que el anterior.
• Iconos Independientes en cada Celda, o Columnas ( Alineacion Izquierda Derecha )
• Agregado Multiseleccion Con Shift y Control
• Agregado FullRowSelection
• Los Iconos se Pueden reajustar sus dimensiones sin que se reasigne la Coleccion de imagenes
• Las celdas que no contengan Icono asignado no tienen espaciado inensesario
• Texto En Negrita de forma independiente apra cada celda/Header
• Texto En Cursiva de forma independiente apra cada celda/Header
• Texto En Sub-raya dode forma independiente apra cada celda/Header
• Font Name exclusivo para los TODOS los Header
• Font Name exclusivo Para TODAS las Filas
• Tag Independiente apra cada Fila
• Tag independiente para cada Header
• Eventos Por Regiones ( Zona Header, Zona Filas )
• Eventos Habituales y Comunes
• ToolTip para cada Fila de forma independiente
• ToolTip para cada Header de forma independiente
• Texto En Negrita de forma independiente apra cada celda/Header
• Texto Colorido para cada celda de forma Independiente
• Texto Alineado para cada celda de forma Independiente ( Izquierda Derecha o Centrado )
• Texto Colorido para cada Header de forma Independiente
• Texto Alineado para cada Header de forma Independiente( Izquierda Derecha o Centrado )
• A Cada header sele puede asignar un color de forma independiente
• Color Independiente a la Seleccion de Filas
• Depende Solo de la Clase Cls_Imagelist 2.0 o superior ( Viene incluida en la descarga )
• Dezplazamiento de una Cantidad Dada de columnas a una posicion X
• Dezplazamiento de una Cantidad Dada de filas a una posicion X

<Download>

Dulces Lunas!¡.
.

[Array() BIDIMENSIONAL]

.
El Reto es el siguiente consiste en generar un proceso que al ingresar un Numero (en el Ejemplo es 64) Retorne un Array() BIDIMENSIONAL que al imprimir contenga el siguiente codigo, (donde el 4280 se encuentre en el primer indice),

Código [Seleccionar] Expandir



4280 4315 4355 4398 4442 4485 4525 4560 2080
1 2 4 7 11 16 22 29 92
3 5 8 12 17 23 30 37 135
6 9 13 18 24 31 38 44 183
10 14 19 25 32 39 45 50 234
15 20 26 33 40 46 51 55 286
21 27 34 41 47 52 56 59 337
28 35 42 48 53 57 60 62 385
36 43 49 54 58 61 63 64 428
120 155 195 238 282 325 365 400 2080



• Donde empiesa a llenarse desde el Numero 1 (Sigan la secuencia numerica...).
• Suma Vertical.
• Suma Horizontal
• El Resto es un Analisis Numerico... No es dificil (Numeros de la 1ra fila Superior y esquina Inferior Derecha).

Debe Hacer y Procesar numeros Con Punto Decimal y Negativos (Ignoren los Negativos). Solo del 0 en adelante.

• IMPORTANTE: Si la tabla no se acompleta por ejemplo si se ingresa el numero 10... se queda hasta q sea un cuadrado la parte interna Pero sin superar a dicho numero... en este caso termina en el numero 9 dicha secuencia, y de forma posterior se calculan los demas valores...

Corregido este ejemplo... Disculpen los hice a mano ¬¬"

Código [Seleccionar] Expandir



100 105 110 45
1 2 4 7
3 5 7 15
6 8 9 23
10 15 20 45



• El codigo debera de ser legible, lo mas corto y con velocidad en su procesar.
• Pueden usarse APIS.

Ejemplos:



Ejmplo con el Numero 0

Código [Seleccionar] Expandir



0
0


Ejmplo con el Numero 1

Código [Seleccionar] Expandir



3 1
1 1
1 1


Ejmplo con el Numero 4

Código [Seleccionar] Expandir



24 26 10
1 2 3
3 4 7
4 6 10


Ejmplo con el Numero 9

Código [Seleccionar] Expandir



100 105 110 45
1 2 4 7
3 5 7 15
6 8 9 23
10 15 20 45


Ejmplo con el Numero 16

Código [Seleccionar] Expandir



292 301 311 320 136
1 2 4 7 14
3 5 8 11 27
6 9 12 14 41
10 13 15 16 54
20 29 39 48 136


Ejmplo con el Numero 25

Código [Seleccionar] Expandir



685 699 715 731 745 325
1 2 4 7 11 25
3 5 8 12 16 44
6 9 13 17 20 65
10 14 18 21 23 86
15 19 22 24 25 105
35 49 65 81 95 325


Ejmplo con el Numero 36

Código [Seleccionar] Expandir



1388 1408 1431 1455 1478 1498 666
1 2 4 7 11 16 41
3 5 8 12 17 22 67
6 9 13 18 23 27 96
10 14 19 24 28 31 126
15 20 25 29 32 34 155
21 26 30 33 35 36 181
56 76 99 123 146 166 666


Ejmplo con el Numero 49

Código [Seleccionar] Expandir



2534 2561 2592 2625 2658 2689 2716 1225
1 2 4 7 11 16 22 63
3 5 8 12 17 23 29 97
6 9 13 18 24 30 35 135
10 14 19 25 31 36 40 175
15 20 26 32 37 41 44 215
21 27 33 38 42 45 47 253
28 34 39 43 46 48 49 287
84 111 142 175 208 239 266 1225


Ejmplo con el Numero 64

Código [Seleccionar] Expandir



4280 4315 4355 4398 4442 4485 4525 4560 2080
1 2 4 7 11 16 22 29 92
3 5 8 12 17 23 30 37 135
6 9 13 18 24 31 38 44 183
10 14 19 25 32 39 45 50 234
15 20 26 33 40 46 51 55 286
21 27 34 41 47 52 56 59 337
28 35 42 48 53 57 60 62 385
36 43 49 54 58 61 63 64 428
120 155 195 238 282 325 365 400 2080


Ejmplo con el Numero 81

Código [Seleccionar] Expandir



6807 6851 6901 6955 7011 7067 7121 7171 7215 3321
1 2 4 7 11 16 22 29 37 129
3 5 8 12 17 23 30 38 46 182
6 9 13 18 24 31 39 47 54 241
10 14 19 25 32 40 48 55 61 304
15 20 26 33 41 49 56 62 67 369
21 27 34 42 50 57 63 68 72 434
28 35 43 51 58 64 69 73 76 497
36 44 52 59 65 70 74 77 79 556
45 53 60 66 71 75 78 80 81 609
165 209 259 313 369 425 479 529 573 3321


Ejmplo con el Numero 100

Código [Seleccionar] Expandir



10320 10374 10435 10501 10570 10640 10709 10775 10836 10890 5050
1 2 4 7 11 16 22 29 37 46 175
3 5 8 12 17 23 30 38 47 56 239
6 9 13 18 24 31 39 48 57 65 310
10 14 19 25 32 40 49 58 66 73 386
15 20 26 33 41 50 59 67 74 80 465
21 27 34 42 51 60 68 75 81 86 545
28 35 43 52 61 69 76 82 87 91 624
36 44 53 62 70 77 83 88 92 95 700
45 54 63 71 78 84 89 93 96 98 771
55 64 72 79 85 90 94 97 99 100 835
220 274 335 401 470 540 609 675 736 790 5050


Ejmplo con el Numero 121

Código [Seleccionar] Expandir



15048 15113 15186 15265 15348 15433 15518 15601 15680 15753 15818 7381
1 2 4 7 11 16 22 29 37 46 56 231
3 5 8 12 17 23 30 38 47 57 67 307
6 9 13 18 24 31 39 48 58 68 77 391
10 14 19 25 32 40 49 59 69 78 86 481
15 20 26 33 41 50 60 70 79 87 94 575
21 27 34 42 51 61 71 80 88 95 101 671
28 35 43 52 62 72 81 89 96 102 107 767
36 44 53 63 73 82 90 97 103 108 112 861
45 54 64 74 83 91 98 104 109 113 116 951
55 65 75 84 92 99 105 110 114 117 119 1035
66 76 85 93 100 106 111 115 118 120 121 1111
286 351 424 503 586 671 756 839 918 991 1056 7381


Ejmplo con el Numero 144

Código [Seleccionar] Expandir



21244 21321 21407 21500 21598 21699 21801 21902 22000 22093 22179 22256 10440
1 2 4 7 11 16 22 29 37 46 56 67 298
3 5 8 12 17 23 30 38 47 57 68 79 387
6 9 13 18 24 31 39 48 58 69 80 90 485
10 14 19 25 32 40 49 59 70 81 91 100 590
15 20 26 33 41 50 60 71 82 92 101 109 700
21 27 34 42 51 61 72 83 93 102 110 117 813
28 35 43 52 62 73 84 94 103 111 118 124 927
36 44 53 63 74 85 95 104 112 119 125 130 1040
45 54 64 75 86 96 105 113 120 126 131 135 1150
55 65 76 87 97 106 114 121 127 132 136 139 1255
66 77 88 98 107 115 122 128 133 137 140 142 1353
78 89 99 108 116 123 129 134 138 141 143 144 1442
364 441 527 620 718 819 921 1022 1120 1213 1299 1376 10440


Ejmplo con el Numero 169

Código [Seleccionar] Expandir



29185 29275 29375 29483 29597 29715 29835 29955 30073 30187 30295 30395 30485 14365
1 2 4 7 11 16 22 29 37 46 56 67 79 377
3 5 8 12 17 23 30 38 47 57 68 80 92 480
6 9 13 18 24 31 39 48 58 69 81 93 104 593
10 14 19 25 32 40 49 59 70 82 94 105 115 714
15 20 26 33 41 50 60 71 83 95 106 116 125 841
21 27 34 42 51 61 72 84 96 107 117 126 134 972
28 35 43 52 62 73 85 97 108 118 127 135 142 1105
36 44 53 63 74 86 98 109 119 128 136 143 149 1238
45 54 64 75 87 99 110 120 129 137 144 150 155 1369
55 65 76 88 100 111 121 130 138 145 151 156 160 1496
66 77 89 101 112 122 131 139 146 152 157 161 164 1617
78 90 102 113 123 132 140 147 153 158 162 165 167 1730
91 103 114 124 133 141 148 154 159 163 166 168 169 1833
455 545 645 753 867 985 1105 1225 1343 1457 1565 1665 1755 14365


Ejmplo con el Numero 196

Código [Seleccionar] Expandir



39172 39276 39391 39515 39646 39782 39921 40061 40200 40336 40467 40591 40706 40810 19306
1 2 4 7 11 16 22 29 37 46 56 67 79 92 469
3 5 8 12 17 23 30 38 47 57 68 80 93 106 587
6 9 13 18 24 31 39 48 58 69 81 94 107 119 716
10 14 19 25 32 40 49 59 70 82 95 108 120 131 854
15 20 26 33 41 50 60 71 83 96 109 121 132 142 999
21 27 34 42 51 61 72 84 97 110 122 133 143 152 1149
28 35 43 52 62 73 85 98 111 123 134 144 153 161 1302
36 44 53 63 74 86 99 112 124 135 145 154 162 169 1456
45 54 64 75 87 100 113 125 136 146 155 163 170 176 1609
55 65 76 88 101 114 126 137 147 156 164 171 177 182 1759
66 77 89 102 115 127 138 148 157 165 172 178 183 187 1904
78 90 103 116 128 139 149 158 166 173 179 184 188 191 2042
91 104 117 129 140 150 159 167 174 180 185 189 192 194 2171
105 118 130 141 151 160 168 175 181 186 190 193 195 196 2289
560 664 779 903 1034 1170 1309 1449 1588 1724 1855 1979 2094 2198 19306


Ejmplo con el Numero 225

Código [Seleccionar] Expandir



51530 51649 51780 51921 52070 52225 52384 52545 52706 52865 53020 53169 53310 53441 53560 25425
1 2 4 7 11 16 22 29 37 46 56 67 79 92 106 575
3 5 8 12 17 23 30 38 47 57 68 80 93 107 121 709
6 9 13 18 24 31 39 48 58 69 81 94 108 122 135 855
10 14 19 25 32 40 49 59 70 82 95 109 123 136 148 1011
15 20 26 33 41 50 60 71 83 96 110 124 137 149 160 1175
21 27 34 42 51 61 72 84 97 111 125 138 150 161 171 1345
28 35 43 52 62 73 85 98 112 126 139 151 162 172 181 1519
36 44 53 63 74 86 99 113 127 140 152 163 173 182 190 1695
45 54 64 75 87 100 114 128 141 153 164 174 183 191 198 1871
55 65 76 88 101 115 129 142 154 165 175 184 192 199 205 2045
66 77 89 102 116 130 143 155 166 176 185 193 200 206 211 2215
78 90 103 117 131 144 156 167 177 186 194 201 207 212 216 2379
91 104 118 132 145 157 168 178 187 195 202 208 213 217 220 2535
105 119 133 146 158 169 179 188 196 203 209 214 218 221 223 2681
120 134 147 159 170 180 189 197 204 210 215 219 222 224 225 2815
680 799 930 1071 1220 1375 1534 1695 1856 2015 2170 2319 2460 2591 2710 25425


Ejmplo con el Numero 256

Código [Seleccionar] Expandir



66608 66743 66891 67050 67218 67393 67573 67756 67940 68123 68303 68478 68646 68805 68953 69088 32896
1 2 4 7 11 16 22 29 37 46 56 67 79 92 106 121 696
3 5 8 12 17 23 30 38 47 57 68 80 93 107 122 137 847
6 9 13 18 24 31 39 48 58 69 81 94 108 123 138 152 1011
10 14 19 25 32 40 49 59 70 82 95 109 124 139 153 166 1186
15 20 26 33 41 50 60 71 83 96 110 125 140 154 167 179 1370
21 27 34 42 51 61 72 84 97 111 126 141 155 168 180 191 1561
28 35 43 52 62 73 85 98 112 127 142 156 169 181 192 202 1757
36 44 53 63 74 86 99 113 128 143 157 170 182 193 203 212 1956
45 54 64 75 87 100 114 129 144 158 171 183 194 204 213 221 2156
55 65 76 88 101 115 130 145 159 172 184 195 205 214 222 229 2355
66 77 89 102 116 131 146 160 173 185 196 206 215 223 230 236 2551
78 90 103 117 132 147 161 174 186 197 207 216 224 231 237 242 2742
91 104 118 133 148 162 175 187 198 208 217 225 232 238 243 247 2926
105 119 134 149 163 176 188 199 209 218 226 233 239 244 248 251 3101
120 135 150 164 177 189 200 210 219 227 234 240 245 249 252 254 3265
136 151 165 178 190 201 211 220 228 235 241 246 250 253 255 256 3416
816 951 1099 1258 1426 1601 1781 1964 2148 2331 2511 2686 2854 3013 3161 3296 32896


Ejmplo con el Numero 289

Código [Seleccionar] Expandir



84779 84931 85097 85275 85463 85659 85861 86067 86275 86483 86689 86891 87087 87275 87453 87619 87771 41905
1 2 4 7 11 16 22 29 37 46 56 67 79 92 106 121 137 833
3 5 8 12 17 23 30 38 47 57 68 80 93 107 122 138 154 1002
6 9 13 18 24 31 39 48 58 69 81 94 108 123 139 155 170 1185
10 14 19 25 32 40 49 59 70 82 95 109 124 140 156 171 185 1380
15 20 26 33 41 50 60 71 83 96 110 125 141 157 172 186 199 1585
21 27 34 42 51 61 72 84 97 111 126 142 158 173 187 200 212 1798
28 35 43 52 62 73 85 98 112 127 143 159 174 188 201 213 224 2017
36 44 53 63 74 86 99 113 128 144 160 175 189 202 214 225 235 2240
45 54 64 75 87 100 114 129 145 161 176 190 203 215 226 236 245 2465
55 65 76 88 101 115 130 146 162 177 191 204 216 227 237 246 254 2690
66 77 89 102 116 131 147 163 178 192 205 217 228 238 247 255 262 2913
78 90 103 117 132 148 164 179 193 206 218 229 239 248 256 263 269 3132
91 104 118 133 149 165 180 194 207 219 230 240 249 257 264 270 275 3345
105 119 134 150 166 181 195 208 220 231 241 250 258 265 271 276 280 3550
120 135 151 167 182 196 209 221 232 242 251 259 266 272 277 281 284 3745
136 152 168 183 197 210 222 233 243 252 260 267 273 278 282 285 287 3928
153 169 184 198 211 223 234 244 253 261 268 274 279 283 286 288 289 4097
969 1121 1287 1465 1653 1849 2051 2257 2465 2673 2879 3081 3277 3465 3643 3809 3961 41905


Ejmplo con el Numero 324

Código [Seleccionar] Expandir



106440 106610 106795 106993 107202 107420 107645 107875 108108 108342 108575 108805 109030 109248 109457 109655 109840 110010 52650
1 2 4 7 11 16 22 29 37 46 56 67 79 92 106 121 137 154 987
3 5 8 12 17 23 30 38 47 57 68 80 93 107 122 138 155 172 1175
6 9 13 18 24 31 39 48 58 69 81 94 108 123 139 156 173 189 1378
10 14 19 25 32 40 49 59 70 82 95 109 124 140 157 174 190 205 1594
15 20 26 33 41 50 60 71 83 96 110 125 141 158 175 191 206 220 1821
21 27 34 42 51 61 72 84 97 111 126 142 159 176 192 207 221 234 2057
28 35 43 52 62 73 85 98 112 127 143 160 177 193 208 222 235 247 2300
36 44 53 63 74 86 99 113 128 144 161 178 194 209 223 236 248 259 2548
45 54 64 75 87 100 114 129 145 162 179 195 210 224 237 249 260 270 2799
55 65 76 88 101 115 130 146 163 180 196 211 225 238 250 261 271 280 3051
66 77 89 102 116 131 147 164 181 197 212 226 239 251 262 272 281 289 3302
78 90 103 117 132 148 165 182 198 213 227 240 252 263 273 282 290 297 3550
91 104 118 133 149 166 183 199 214 228 241 253 264 274 283 291 298 304 3793
105 119 134 150 167 184 200 215 229 242 254 265 275 284 292 299 305 310 4029
120 135 151 168 185 201 216 230 243 255 266 276 285 293 300 306 311 315 4256
136 152 169 186 202 217 231 244 256 267 277 286 294 301 307 312 316 319 4472
153 170 187 203 218 232 245 257 268 278 287 295 302 308 313 317 320 322 4675
171 188 204 219 233 246 258 269 279 288 296 303 309 314 318 321 323 324 4863
1140 1310 1495 1693 1902 2120 2345 2575 2808 3042 3275 3505 3730 3948 4157 4355 4540 4710 52650


Ejmplo con el Numero 361

Código [Seleccionar] Expandir



132012 132201 132406 132625 132856 133097 133346 133601 133860 134121 134382 134641 134896 135145 135386 135617 135836 136041 136230 65341
1 2 4 7 11 16 22 29 37 46 56 67 79 92 106 121 137 154 172 1159
3 5 8 12 17 23 30 38 47 57 68 80 93 107 122 138 155 173 191 1367
6 9 13 18 24 31 39 48 58 69 81 94 108 123 139 156 174 192 209 1591
10 14 19 25 32 40 49 59 70 82 95 109 124 140 157 175 193 210 226 1829
15 20 26 33 41 50 60 71 83 96 110 125 141 158 176 194 211 227 242 2079
21 27 34 42 51 61 72 84 97 111 126 142 159 177 195 212 228 243 257 2339
28 35 43 52 62 73 85 98 112 127 143 160 178 196 213 229 244 258 271 2607
36 44 53 63 74 86 99 113 128 144 161 179 197 214 230 245 259 272 284 2881
45 54 64 75 87 100 114 129 145 162 180 198 215 231 246 260 273 285 296 3159
55 65 76 88 101 115 130 146 163 181 199 216 232 247 261 274 286 297 307 3439
66 77 89 102 116 131 147 164 182 200 217 233 248 262 275 287 298 308 317 3719
78 90 103 117 132 148 165 183 201 218 234 249 263 276 288 299 309 318 326 3997
91 104 118 133 149 166 184 202 219 235 250 264 277 289 300 310 319 327 334 4271
105 119 134 150 167 185 203 220 236 251 265 278 290 301 311 320 328 335 341 4539
120 135 151 168 186 204 221 237 252 266 279 291 302 312 321 329 336 342 347 4799
136 152 169 187 205 222 238 253 267 280 292 303 313 322 330 337 343 348 352 5049
153 170 188 206 223 239 254 268 281 293 304 314 323 331 338 344 349 353 356 5287
171 189 207 224 240 255 269 282 294 305 315 324 332 339 345 350 354 357 359 5511
190 208 225 241 256 270 283 295 306 316 325 333 340 346 351 355 358 360 361 5719
1330 1519 1724 1943 2174 2415 2664 2919 3178 3439 3700 3959 4214 4463 4704 4935 5154 5359 5548 65341


Ejmplo con el Numero 400

Código [Seleccionar] Expandir



161940 162149 162375 162616 162870 163135 163409 163690 163976 164265 164555 164844 165130 165411 165685 165950 166204 166445 166671 166880 80200
1 2 4 7 11 16 22 29 37 46 56 67 79 92 106 121 137 154 172 191 1350
3 5 8 12 17 23 30 38 47 57 68 80 93 107 122 138 155 173 192 211 1579
6 9 13 18 24 31 39 48 58 69 81 94 108 123 139 156 174 193 212 230 1825
10 14 19 25 32 40 49 59 70 82 95 109 124 140 157 175 194 213 231 248 2086
15 20 26 33 41 50 60 71 83 96 110 125 141 158 176 195 214 232 249 265 2360
21 27 34 42 51 61 72 84 97 111 126 142 159 177 196 215 233 250 266 281 2645
28 35 43 52 62 73 85 98 112 127 143 160 178 197 216 234 251 267 282 296 2939
36 44 53 63 74 86 99 113 128 144 161 179 198 217 235 252 268 283 297 310 3240
45 54 64 75 87 100 114 129 145 162 180 199 218 236 253 269 284 298 311 323 3546
55 65 76 88 101 115 130 146 163 181 200 219 237 254 270 285 299 312 324 335 3855
66 77 89 102 116 131 147 164 182 201 220 238 255 271 286 300 313 325 336 346 4165
78 90 103 117 132 148 165 183 202 221 239 256 272 287 301 314 326 337 347 356 4474
91 104 118 133 149 166 184 203 222 240 257 273 288 302 315 327 338 348 357 365 4780
105 119 134 150 167 185 204 223 241 258 274 289 303 316 328 339 349 358 366 373 5081
120 135 151 168 186 205 224 242 259 275 290 304 317 329 340 350 359 367 374 380 5375
136 152 169 187 206 225 243 260 276 291 305 318 330 341 351 360 368 375 381 386 5660
153 170 188 207 226 244 261 277 292 306 319 331 342 352 361 369 376 382 387 391 5934
171 189 208 227 245 262 278 293 307 320 332 343 353 362 370 377 383 388 392 395 6195
190 209 228 246 263 279 294 308 321 333 344 354 363 371 378 384 389 393 396 398 6441
210 229 247 264 280 295 309 322 334 345 355 364 372 379 385 390 394 397 399 400 6670
1540 1749 1975 2216 2470 2735 3009 3290 3576 3865 4155 4444 4730 5011 5285 5550 5804 6045 6271 6480 80200


Temibles Lunas!¡.
.

[2.0 Cls_ImageList]

.

http://infrangelux.hostei.com/index.php?option=com_content&view=article&id=25:20-clsimagelist&catid=15:catmoduloscls&Itemid=24


Este Modulo de Clase es solo una pequeña sustitucion al ImageList, no tiene gran cosa y no se parece en lo absoluto a los de Cobein, ya que este solo esta diseñado para que trabaje con iconos, aun que puede cargar BMP, Cursores e Iconos obviamente.

1.0 Cls_ImageList
1.2 Cls_ImageList
1.3 Cls_ImageList

2.0 Cls_ImageList

Código [Seleccionar] Expandir



'   /////////////////////////////////////////////////////////////
'   //                  ImageList.Cls   2.0                    //
'   // *    ADD Events                                         //
'   // *    ADD Convert Icons To Picture                       //
'   // *    Fix Swap                                           //
'   // *    Fix Duplicate                                      //
'   /////////////////////////////////////////////////////////////



EDITO: --> Subi Nuevamente el Archivo ya que era una version Anterior.

Edito: ---> Agrego solo un ejemplo Basico...

Código (Vb) [Seleccionar] Expandir



Private Sub Form_Load()
AutoRedraw = True
Dim a                   As Cls_ImageList
Const Str_BMP           As String = "Angeles"         '   //  Aqui guardamos imagenes Grandes
Const Str_BMP2          As String = "AngelesMinis"    '   //  Nos servira solo para Redidibujar e mini
Dim lng_Index           As Long

   Set a = New Cls_ImageList
   With a

       If Not .ImageListCreate(Str_BMP, 512, 512) = 0 Then ' // Nos devuelve el Handle de la coleccion de imagenes.
           lng_Index = .ImageList_ADDLoadFromFile(Str_BMP, App.Path & "\img\a1.bmp", IMAGE_BITMAP)
           If .ImageListDuplicate(Str_BMP, Str_BMP2) Then
               .ImageListDraw Str_BMP2, lng_Index, Me.hDC, 20, 50
               If .ImageListSetSize(Str_BMP, 32, 32) Then
                   .ImageListDraw Str_BMP, lng_Index, Me.hDC, 20, 50
               End If
               .ImageListDestroy Str_BMP2 ' // Eliminamos la Coleccion de imagenes
               .ImageListDraw Str_BMP2, lng_Index, Me.hDC, 20, 50 ' // esta linea ya no pictara nada ya que la coleccion ya esta destruida.
           End If
       End If
       
   End With
   Set a = Nothing
   
Refresh
End Sub




Temibles Lunas!¡.
.

[RAPIDA]

.
Andaba buscando la manera de buscar en un Array de la forma mas RAPIDA posible y bueno, recordando el QuickSort arme este algoritmo que busca en un Array ordenado de forma Ascendente o Desendente un valor en el mismo lo hace de forma Extremadamente rapida...

Se lo dejo en Dos versiones... Recursiva y con un Do... Loop

Aqui se los dejo:

Forma Recursiva (Gasta memoria...)

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

Public Function ExitsInArray(ByRef vValue As Long, ByRef vBuff() As Long, ByRef p As Long) As Boolean
Dim lng_lb                      As Long
Dim lng_Ub                      As Long
   lng_lb = LBound(vBuff&())
   lng_Ub = UBound(vBuff&())
   If vBuff&(lng_Ub) > vBuff&(lng_lb) Then
       ExitsInArray = ExitsInArrayR(vValue, vBuff&, lng_lb, lng_Ub, p)
   Else
       ExitsInArray = ExitsInArrayR(vValue, vBuff&, lng_Ub, lng_lb, p)
   End If
End Function

Public Function ExitsInArrayR(ByRef vValue As Long, ByRef vBuff() As Long, ByVal l As Long, ByVal u As Long, ByRef p As Long) As Boolean
   Select Case vValue
       Case vBuff&(l&)
           p& = l&
           ExitsInArrayR = True
       Case vBuff&(u&)
           p& = u&
           ExitsInArrayR = True
       Case Else
           p = (l& + u&) / 2
           If p <> l& And p& <> u& Then
               If vBuff&(p&) < vValue& Then
                   ExitsInArrayR = ExitsInArrayR(vValue, vBuff&(), p, u, p)
               ElseIf vBuff&(p&) > vValue& Then
                   ExitsInArrayR = ExitsInArrayR(vValue, vBuff&(), l, p, p)
               ElseIf vBuff&(p&) = vValue& Then
                   ExitsInArrayR = True
               End If
           End If
   End Select
End Function



Forma con Do ... Loop

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

Public Function ExitsInArrayNR(ByRef vValue As Long, ByRef vBuff() As Long, ByRef p As Long) As Boolean
Dim lng_lb                      As Long
Dim lng_Ub                      As Long
   lng_lb = LBound(vBuff&())
   lng_Ub = UBound(vBuff&())
   If Not vBuff&(lng_Ub) > vBuff&(lng_lb) Then
       Dim t                           As Long
       t = lng_Ub
       lng_Ub = lng_lb
       lng_lb = t
   End If
   Do Until ExitsInArrayNR
       Select Case vValue
           Case vBuff&(lng_lb&)
               p& = lng_lb&
               ExitsInArrayNR = True
           Case vBuff&(lng_Ub&)
               p& = lng_Ub&
               ExitsInArrayNR = True
           Case Else
               p = (lng_lb& + lng_Ub&) / 2
               If p <> lng_lb& And p& <> lng_Ub& Then
                   If vBuff&(p&) < vValue& Then
                       lng_lb = p
                   ElseIf vBuff&(p&) > vValue& Then
                       lng_Ub = p
                   ElseIf vBuff&(p&) = vValue& Then
                       ExitsInArrayNR = True
                   End If
               Else
                   Exit Do
               End If
       End Select
   Loop
End Function




Prueba de Velocidad en comparacion a un Simple For Next...

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 GetTickCount Lib "kernel32" () As Long

Private Sub Form_Load()
Dim vBuff&(0 To 99999)
Dim i&, p&
Dim l&
Dim vStr$
   For i& = LBound(vBuff&()) To UBound(vBuff&())
       vBuff(i&) = (99999 * 3) - (i * 3)
   Next i&
   l& = GetTickCount()
   For i& = LBound(vBuff&()) To 999
       Call ExitsInArrayLento(i&, vBuff&(), p&)
   Next i&
   vStr$ = GetTickCount - l&
   l& = GetTickCount()
   For i& = LBound(vBuff&()) To 999
       ' // ExitsInArrayNR es un poquito mas rapido... que ExitsInArray
       Call ExitsInArray(i&, vBuff&(), p&)
   Next i&
   l& = GetTickCount - l&
   MsgBox "ExitsInArrayLento " & vStr$ & vbCrLf & _
          "ExitsInArray " & l
End Sub


Public Function ExitsInArray(ByRef vValue As Long, ByRef vBuff() As Long, ByRef p As Long) As Boolean
Dim lng_lb                      As Long
Dim lng_Ub                      As Long
   lng_lb = LBound(vBuff&())
   lng_Ub = UBound(vBuff&())
   If vBuff&(lng_Ub) > vBuff&(lng_lb) Then
       ExitsInArray = ExitsInArrayR(vValue, vBuff&, lng_lb, lng_Ub, p)
   Else
       ExitsInArray = ExitsInArrayR(vValue, vBuff&, lng_Ub, lng_lb, p)
   End If
End Function

Public Function ExitsInArrayR(ByRef vValue As Long, ByRef vBuff() As Long, ByVal l As Long, ByVal u As Long, ByRef p As Long) As Boolean
   Select Case vValue
       Case vBuff&(l&)
           p& = l&
           ExitsInArrayR = True
       Case vBuff&(u&)
           p& = u&
           ExitsInArrayR = True
       Case Else
           p = (l& + u&) / 2
           If p <> l& And p& <> u& Then
               If vBuff&(p&) < vValue& Then
                   ExitsInArrayR = ExitsInArrayR(vValue, vBuff&(), p, u, p)
               ElseIf vBuff&(p&) > vValue& Then
                   ExitsInArrayR = ExitsInArrayR(vValue, vBuff&(), l, p, p)
               ElseIf vBuff&(p&) = vValue& Then
                   ExitsInArrayR = True
               End If
           End If
   End Select
End Function



Public Function ExitsInArrayNR(ByRef vValue As Long, ByRef vBuff() As Long, ByRef p As Long) As Boolean
Dim lng_lb                      As Long
Dim lng_Ub                      As Long
   lng_lb = LBound(vBuff&())
   lng_Ub = UBound(vBuff&())
   If Not vBuff&(lng_Ub) > vBuff&(lng_lb) Then
       Dim t                           As Long
       t = lng_Ub
       lng_Ub = lng_lb
       lng_lb = t
   End If
   Do Until ExitsInArrayNR
       Select Case vValue
           Case vBuff&(lng_lb&)
               p& = lng_lb&
               ExitsInArrayNR = True
           Case vBuff&(lng_Ub&)
               p& = lng_Ub&
               ExitsInArrayNR = True
           Case Else
               p = (lng_lb& + lng_Ub&) / 2
               If p <> lng_lb& And p& <> lng_Ub& Then
                   If vBuff&(p&) < vValue& Then
                       lng_lb = p
                   ElseIf vBuff&(p&) > vValue& Then
                       lng_Ub = p
                   ElseIf vBuff&(p&) = vValue& Then
                       ExitsInArrayNR = True
                   End If
               Else
                   Exit Do
               End If
       End Select
   Loop
End Function

Private Function ExitsInArrayLento(ByRef Value As Long, ByRef ArrayCollection() As Long, Optional ByRef OutInIndex As Long) As Boolean
   For OutInIndex = LBound(ArrayCollection) To UBound(ArrayCollection)
       If ArrayCollection(OutInIndex) = Value Then
           ExitsInArrayLento = True
           Exit Function
       End If
   Next
End Function



Temibles Lunas!¡.
.

.
Que pasen una velada agradable 

Temibles Noches!¡.
.

.
Este UC lo vengo haciendo en pocos ratos que tengo, esta realizado con las APIS GDI, aun no esta optimisado, pero ya esta funcional,

Importante: La programacion de los eventos como MouseDown estan bajo los mensajes de windows, ya que si se ponen bajo los eventos del UC salen errores como "Expresion demasiado compleja"

* ListView colorido.
* Seleccion con Click + Control
* ScrollGhost (Funciona al mantener pulsado el mouse sobre alguna de las 4 regiones disponibles)
* QuickSort como motor de Ordenacion.
* tengo weba de escribir las demas Funciones... asi que veanlo...
*- Seleccion con Shift aun no agregado.
*-Aun no tiene soporte para iconos (despues lo agrego).

http://infrangelux.hostei.com/?option=com_content&view=article&id=22:src-uc-listviewex&catid=13:controlesdeusuario&Itemid=21&

algunas imagenes...





Temibles Lunas!¡.

[UC]

.
Bueno ando con un rollo en el vb6 y es que ando creando un UC ( ya tiene mucho que llevo con esto pero no he tenido mucho tiempo para terminarlo ), mi problema es que en el UC resivo los mensajes con GetMessage y los dejo fluir con DispatchMessage pero he aqui el problema en DispatchMessage cundo termino el form donde tengo el UC se queda todo el programa en dicha linea y por esta linea no se puede cerrar el programa o form en cuestion.

En pocas palabras una alternativa a estas apis cual seria?, las he usado por que estas no me traban de forma innesesaria el programa, en cambio PeekMessage tengo que hacer un Bucle pero este a diferencia de las otras dos apis se le escapan mensajes, por ende no me sirve ademas que tengo que ponerle doevents y cosillas dentro del bucle para que no se coma el procesador.

Este es el codigo, lo programe para que dejara de procesar mensajes si le llegan los mensajes WM_CLOSE o WM_DESTROY, pero esto no me gusta mucho que digamos.

Código (Vb) [Seleccionar] Expandir



'   //  //  //  //  //  //  //  //  //  //  //  //  //  //  //  //  //  //  //  //
'   //  El Objetivo de este proceso es que el Control de Usuario sea Maleable,
'   //  de igual forma por que lo pienso pasar a C++ y esto me ayudara despues,
'   //  se que aqui no se tratan los mensajes si no mas bien en el Callback
'   //  WindProc() pero bueno, es solo una obtativa para vb6 de forma cutre
'   //  //  //  //  //  //  //  //  //  //  //  //  //  //  //  //  //  //  //  //
'   //  ----------------------------------------------------------------------  //
'   //  //  //  //  //  //  //  //  //  //  //  //  //  //  //  //  //  //  //  //
'   //  No es la manera mas Ortodoxa pero asi me evito usar TODO el Procesador...
'   //  //  //  //  //  //  //  //  //  //  //  //  //  //  //  //  //  //  //  //

Private Sub ProcessMessages()
Dim vMsg                                As Msg
Dim bool_MsgCancel                      As Boolean
Dim Button                              As Integer
Dim tPoint                              As POINTAPI
Dim Shift                               As Integer
   
   bool_MsgCancel = False
   
   Do While GetMessage(vMsg, 0, 0, 0) And bool_MsgCancel = False
       If vMsg.hwnd = UserControl.hwnd Or _
          vMsg.hwnd = VS.hwnd Or _
          vMsg.hwnd = HS.hwnd Then
           
           Select Case vMsg.message
               
               '   //  Mensajes del Mouse
               Case WM.WM_MOUSEWHEEL, WM.WM_MOUSEMOVE, _
                    WM.WM_LBUTTONDBLCLK, WM.WM_LBUTTONDOWN, WM.WM_LBUTTONUP, _
                    WM.WM_RBUTTONDBLCLK, WM.WM_RBUTTONDOWN, WM.WM_RBUTTONUP, _
                    WM.WM_MBUTTONDBLCLK, WM.WM_MBUTTONDOWN, WM.WM_MBUTTONUP

                   tPoint = GetCursorRegion
                   
                   If vMsg.wParam = MK.MK_CONTROL Then
                       Shift = 2
                   ElseIf vMsg.wParam = MK.MK_SHIFT Then
                       Shift = 1
                   Else
                       Shift = 0
                   End If
                   
                   Select Case vMsg.message
                       Case WM.WM_MOUSEWHEEL
                           Debug.Print "WM_MOUSEWHEEL"
                           If vMsg.wParam < 0 Then
                               If (DatosScrollGhost(1).Visible Or VS.Visible) Then
                                   Scroll_V = Priv_SV + int_hRow
                               End If
                           Else
                               If (DatosScrollGhost(0).Visible Or VS.Visible) Then
                                   Scroll_V = Priv_SV - int_hRow
                               End If
                           End If
                           
                       Case WM.WM_LBUTTONDBLCLK
                           Debug.Print "WM_LBUTTONDBLCLK"
                           Call lvDblClick
                       Case WM.WM_RBUTTONDBLCLK
                           Debug.Print "WM_RBUTTONDBLCLK"
                           Call lvDblClick
                       Case WM.WM_MBUTTONDBLCLK
                           Debug.Print "WM_MBUTTONDBLCLK"
                           Call lvDblClick
                           
                       Case WM.WM_LBUTTONDOWN
                           Debug.Print "WM_LBUTTONDOWN"
                           Button = 1
                           Call lvMouseDown(Button, Shift, tPoint.X, tPoint.Y)
                       Case WM.WM_RBUTTONDOWN
                           Debug.Print "WM_RBUTTONDOWN"
                           Button = 2
                           Call lvMouseDown(Button, Shift, tPoint.X, tPoint.Y)
                       Case WM.WM_MBUTTONDOWN
                           Debug.Print "WM_MBUTTONDOWN"
                           Button = 4
                           Call lvMouseDown(Button, Shift, tPoint.X, tPoint.Y)
                           
                       Case WM.WM_LBUTTONUP, WM.WM_RBUTTONUP, WM.WM_MBUTTONUP
                           Debug.Print "WM_LBUTTONUP"
                           Call lvMouseUp(Button, Shift, tPoint.X, tPoint.Y)
                           Call lvClick
                           Button = 0
                           
                       Case WM.WM_MOUSEMOVE
                           Debug.Print "WM_MOUSEMOVE"
                           Call lvMouseMove(Button, Shift, tPoint.X, tPoint.Y)
                           
                   End Select
               
               '   //  Teclas Pulsadas...
               Case WM.WM_KEYDOWN
                   Debug.Print "WM_KEYDOWN", vMsg.wParam
                   Select Case vMsg.wParam
                       Case VK.VK_UP
                           If DatosScrollGhost(0).Visible Or VS.Visible Then
                               Scroll_V = Priv_SV - int_hRow   'Priv_SV - int_hRow
                           End If
                           
                       Case VK.VK_Down
                           If DatosScrollGhost(1).Visible Or VS.Visible Then
                               Scroll_V = Priv_SV + int_hRow   'Priv_SV + int_hRow
                           End If
                           
                       Case VK.VK_Left
                           If DatosScrollGhost(3).Visible Or HS.Visible Then
                               Scroll_H = Priv_SH - 20   'Priv_SH - 20
                           End If
                           
                       Case VK.VK_RIGHT
                           If DatosScrollGhost(3).Visible Or HS.Visible Then
                               Scroll_H = Priv_SH + 20   'Priv_SH + 20
                           End If
                       
                       Case VK.VK_HOME
                           Scroll_V = 0
                           
                       Case VK.VK_END
                           If RowVisibleCount < CantRows Then
                               Scroll_V = (CantRows * int_hRow) - (RectLista.Bottom - RectLista.Top)
                           End If
                           
                       Case VK.VK_SHIFT
                           cAoDSS = True
                           Shift = 1
                           
                       Case VK.VK_CONTROL
                           cAoDSC = True
                           Shift = 2
                           
                       Case VK.VK_PRIOR
                           Scroll_V = Priv_SV - RowVisibleCount * int_hRow
                           
                       Case VK.VK_NEXT
                           Scroll_V = Priv_SV + RowVisibleCount * int_hRow
                                                     
                   End Select
                   RaiseEvent KeyDown(Int(vMsg.wParam), Shift)
                   
               Case WM.WM_KEYUP
                   Debug.Print "WM_KEYUP", vMsg.wParam
                   Select Case vMsg.wParam
                       Case VK.VK_SHIFT
                           cAoDSS = False
                           Shift = 0
                           
                       Case VK.VK_CONTROL
                           cAoDSC = False
                           Shift = 0
                   End Select
                   RaiseEvent KeyUp(Int(vMsg.wParam), Shift)
                   RaiseEvent KeyPress(Int(vMsg.wParam))
                   
               '   //  Mesajes de la Ventana
               Case WM.WM_ACTIVATE
                   Debug.Print "WM_ACTIVATE"
                   
               Case WM.WM_CLOSE, WM.WM_DESTROY
                   Debug.Print "WM_CLOSE", "WM_DESTROY"
                   bool_MsgCancel = True
                   Exit Sub
                   
               Case WM.WM_PAINT
                   If vMsg.wParam = 0 Then
                       Call Refresh
                   Else
                       Call RefreshCols(vMsg.lparam)
                   End If
                   
               Case WM.WM_ENABLE
                   'wParam
                   '   Indicates whether the window has been enabled or disabled. This parameter is TRUE if the window has been enabled or FALSE if the window has been disabled.
                   'lparam
                   '   This parameter is not used.
                   Debug.Print "WM_ENABLE"
                   
               Case Else
               
           End Select
           
       End If
       Call DispatchMessage(vMsg)
       'Call WaitMessage
   Loop
End Sub



P.D.: Que no sea por subclasificación... aun que si no tengo otra opcion...

Temibles Lunas!¡.

.
Linkear libreria     GDI32

Esto solo es una traduccion de VB6 a C++

Que hace? Solo dibuja miles de lineas aleatoriamente de distintos colores en el monitor ignorando todo ( o casi todo ).

Codigo Original:

(GDI32) Lineas Aleatorias On The Fly

https://foro.elhacker.net/programacion_visual_basic/lineas_al_aire-t281968.0.html;msg1389871#msg1389871

Este codigo trae corregido algunos errores que cometi en vb6... nada graves (el mi blog ya estan corregidos por obvias razones)

Codigo:

Código (cpp) [Seleccionar] Expandir



////////////////////////////////////////////////////////////////
// Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
//                                                            //
// Web: http://InfrAngeluX.Sytes.Net/                         //
//                                                            //
// |-> Pueden Distribuir Este Código siempre y cuando         //
// no se eliminen los créditos originales de este código      //
// No importando que sea modificado/editado o engrandecido    //
// o achicado, si es en base a este código                    //
////////////////////////////////////////////////////////////////

#include<iostream>
#include<windows.h>

using namespace std;

struct tLineas
{
   POINT PuntoIni;
   POINT PuntoEnd;
} *PtLineas;


HDC     HDC_dest;
RECT    RECT_wmonitor;

UINT NumeroAleatorio(UINT *l,UINT *u);
UINT NumeroAleatorio(UINT *l,UINT u);
UINT NumeroAleatorio(UINT l,UINT *u);
UINT NumeroAleatorio(UINT l,UINT u);

void Swap(UINT *l,UINT *u);
void Swap(UINT *l,UINT u);
void Swap(UINT l,UINT *u);
void Swap(UINT l,UINT u);

VOID CALLBACK TimerProc(HWND, UINT, UINT_PTR, DWORD);
VOID ProcessMessages();

int main()
{

   HDC_dest                = GetDC( NULL );
   SetTimer ( NULL , 0 , 10 , (TIMERPROC)TimerProc );
   ProcessMessages();
   ReleaseDC ( NULL , HDC_dest );
   return (1);
}

void Swap(UINT *l,UINT *u)
{
   UINT Ptmp = *l;
   *l = *u;
   *u = Ptmp;
}

UINT NumeroAleatorio(UINT l,UINT u)
{
   if ( l > u)
       Swap( &l , &u );
   return ( rand()%(u-l+1)+l );
}

VOID CALLBACK TimerProc(HWND hwnd,UINT uMsg,UINT_PTR idEvent,DWORD dwTime)
{
   tLineas     Linea;
   HPEN        hPen;

   RECT_wmonitor.bottom    = GetSystemMetrics( 1 );
   RECT_wmonitor.left      = 1;
   RECT_wmonitor.right     = GetSystemMetrics( 0 );
   RECT_wmonitor.top       = 1;

   Linea.PuntoIni.x = NumeroAleatorio((UINT)RECT_wmonitor.left,(UINT)RECT_wmonitor.right);
   Linea.PuntoIni.y = NumeroAleatorio((UINT)RECT_wmonitor.top,(UINT)RECT_wmonitor.bottom);
   Linea.PuntoEnd.x = NumeroAleatorio((UINT)RECT_wmonitor.left,(UINT)RECT_wmonitor.right);
   Linea.PuntoEnd.y = NumeroAleatorio((UINT)RECT_wmonitor.top,(UINT)RECT_wmonitor.bottom);

   hPen = CreatePen(0, 1, (COLORREF)NumeroAleatorio((UINT)0,(UINT)3000000));
   DeleteObject(SelectObject(HDC_dest, hPen));
   Ellipse (HDC_dest, Linea.PuntoIni.x - 2, Linea.PuntoIni.y - 2, Linea.PuntoIni.x + 2, Linea.PuntoIni.y + 2);
   Ellipse (HDC_dest, Linea.PuntoEnd.x - 2, Linea.PuntoEnd.y - 2, Linea.PuntoEnd.x + 2, Linea.PuntoEnd.y + 2);
   DeleteObject(hPen);
   hPen = CreatePen(0, 1, (COLORREF)NumeroAleatorio((UINT)0,(UINT)3000000));
   DeleteObject(SelectObject(HDC_dest, hPen));
   MoveToEx (HDC_dest, Linea.PuntoIni.x, Linea.PuntoIni.y, NULL);
   LineTo (HDC_dest, Linea.PuntoEnd.x, Linea.PuntoEnd.y);
   DeleteObject (hPen);
}

VOID ProcessMessages()
{
   MSG msg;
   while (GetMessage(&msg, NULL, NULL, NULL) != -1)
       DispatchMessage(&msg);
}



Temibles Lunas!¡.

[mingw]

.
Bueno le he estado buscando como salvaje desde hace tiempo a como linkeo en en IDE QT de NOKIA ( mingw ), no le encuentro las opciones para linkear librerias externas... y con el #PRAGMA ... me lo bota me dice que lo ha ignorado y a causa de esto me bota errores... caso omiso en VC++ o en CodeBlocks-10.05( que trae el mismo mingw y aquí no me da errores... pero quiero que funcione en el IDE de QT, ya que me parece muy bueno  por su Debugger que trae. ).

Dulces Lunas!¡.

.
El siguiente codigo me carga el maximo indice que es 1 cuando yo se que es 2000... cual es mi error?

Código (cpp) [Seleccionar] Expandir



int *arreglo = new int[];
int i = 2000;
arreglo = (int*) malloc (i * sizeof(int));
::cout << ubound(arreglo) << ::endl;
free(arreglo);
getchar();



Codigo de Ubound()

Código (cpp) [Seleccionar] Expandir



unsigned long __stdcall ubound (int *arr) {
return(sizeof(arr) / sizeof(arr[0]));
}



Dulce Lunas!¡.

Lh: No hagas doble post. Utiliza el botón modificar.

.
Despues de mucho probar y probar di con la solucion...

Código (cpp) [Seleccionar] Expandir



#define ubound(arr) ((sizeof(arr))/(sizeof(*arr)))



Dulce Infierno Lunar!¡.

.
Lo subi porque si lo ponia aqui como publicación sencillamente se pasa de los 100000 caracteres permitidos... ademas de que es muuuuuuy largo...

Descargar APIDirectX 8
http://infrangelux.sytes.net/FileX/index.php?dir=/BlackZeroX/Programacion/vb6/DirectX/8

Dulce Infierno Lunar!¡.

[Novecientos noventa y nueve Octillónes novecientos noventa y nueve Sextillónes novecientos noventa y nueve Quintillónes novecientos noventa y nueve Cuatrillónes novecientos noventa y nueve Trillones novecientos noventa y nueve Billones novecientos noventa y nueve Mil novecientos noventa y nueve Millones novecientos noventa y nueve Mil novecientos noventa y nueve]

.
El siguiente codigo me costo un Ojo de la cara... es para convertir cualquier Numero a Texto Plano. lo hice por Hobby mas que por nesesidad, espero le saquen provecho!¡.

Como maximo mumero que puede leer son es: 999999999999999999999999999999

Novecientos noventa y nueve Octillónes novecientos noventa y nueve Sextillónes novecientos noventa y nueve Quintillónes novecientos noventa y nueve Cuatrillónes novecientos noventa y nueve Trillones novecientos noventa y nueve Billones novecientos noventa y nueve Mil novecientos noventa y nueve Millones novecientos noventa y nueve Mil novecientos noventa y nueve

Billon          10^12       &lt;--( 5 ).
Trillon         10^18       &lt;--( 4 ).
Cuatrillón      10^24       &lt;--( 3 ).
Quintillón      10^30       &lt;--( 2 ).
Sextillón       10^36       &lt;--( 1 ).
Octillón        10^42       &lt;--( 0 ).
&lt;--Obviamente Los siguientes numeros no los tomaremos en cuenta--&gt;
Gúgol           10^100      &lt;--(-1 ).
Googolplex      10^10^Gúgol &lt;--(-2 ).


http://infrangelux.sytes.net/Blog/index.php?option=com_content&view=article&id=8:arrtnum2string&catid=2:catprocmanager&Itemid=8

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 engrandecido //
'   // o achicado, si es en base a este codigo                 //
'   /////////////////////////////////////////////////////////////

Public Function Number2String(ByVal VInNumber As String) As String
'   //  Meximo  --> 999999999999999999999999999999 ' sección Octillón...
'   //  Billon          10^12       <--( 5 ).
'   //  Trillon         10^18       <--( 4 ).
'   //  Cuatrillón      10^24       <--( 3 ).
'   //  Quintillón      10^30       <--( 2 ).
'   //  Sextillón       10^36       <--( 1 ).
'   //  Octillón        10^42       <--( 0 ).
'   //  <--Obviamente Los siguientes numeros no los tomaremos en cuenta-->
'   //  Gúgol           10^100      <--(-1 ).
'   //  Googolplex      10^10^Gúgol <--(-2 ).
Dim Str_Temp                            As String
Dim Byt_Index                           As Byte
Dim Byt_Digito                          As Byte
Dim Byt_Centena                         As Byte
Dim Byt_Decena                          As Byte
Dim Byt_Unidad                          As Byte
Dim Str_Leyenda                         As String
Dim lng_LenStr                          As Long
Const clng_MaxLen = &H1E

    lng_LenStr = Len(VInNumber)
    If lng_LenStr > clng_MaxLen Or lng_LenStr = 0 Then Exit Function
    Str_Temp = String$(clng_MaxLen, "0")
    Mid(Str_Temp, clng_MaxLen - lng_LenStr + 1) = Mid$(VInNumber, 1, lng_LenStr)

    For Byt_Index = 1 To clng_MaxLen / 3

        Byt_Centena = CByte(Mid$(Str_Temp, Byt_Index * 3 - 2, 1))
        Byt_Decena = CByte(Mid$(Str_Temp, Byt_Index * 3 - 1, 1))
        Byt_Unidad = CByte(Mid$(Str_Temp, Byt_Index * 3, 1))

        Select Case Byt_Index
            Case 1
                If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
                    Str_Leyenda = "Octillón "
                ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
                    Str_Leyenda = "Octillónes "
                End If
            Case 2
                If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
                    Str_Leyenda = "Sextillón "
                ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
                    Str_Leyenda = "Sextillónes "
                End If
            Case 3
                If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
                    Str_Leyenda = "Quintillón "
                ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
                    Str_Leyenda = "Quintillónes "
                End If
            Case 4
                If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
                    Str_Leyenda = "Cuatrillón "
                ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
                    Str_Leyenda = "Cuatrillónes "
                End If
            Case 5
                If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
                    Str_Leyenda = "Trillon "
                ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
                    Str_Leyenda = "Trillones "
                End If
            Case 6
                If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
                    Str_Leyenda = "Billón "
                ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
                    Str_Leyenda = "Billones "
                End If
            Case 7
                If Byt_Centena + Byt_Decena + Byt_Unidad >= 1 And Val(Mid$(Str_Temp, 21, 3)) = 0 Then
                    Str_Leyenda = "Mil Millones "
                ElseIf Byt_Centena + Byt_Decena + Byt_Unidad >= 1 Then
                    Str_Leyenda = "Mil "
                End If
            Case 8
                If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
                    Str_Leyenda = "Millón "
                ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
                    Str_Leyenda = "Millones "
                End If
            Case 9
                If Byt_Centena + Byt_Decena + Byt_Unidad >= 1 Then Str_Leyenda = "Mil "
            Case 10
                If Byt_Centena + Byt_Decena + Byt_Unidad >= 1 Then Str_Leyenda = ""
        End Select
        Number2String = Number2String + Centena(Byt_Unidad, Byt_Decena, Byt_Centena) + Decena(Byt_Unidad, Byt_Decena) + Unidad(Byt_Unidad, Byt_Decena) + Str_Leyenda
        Str_Leyenda = ""
    Next

End Function

Private Function Centena(ByVal Byt_Uni As Byte, ByVal Byt_Decimal As Byte, ByVal Byt_Centena As Byte) As String
    Select Case Byt_Centena
        Case 1: If Byt_Decimal + Byt_Uni = 0 Then Centena = "cien " Else Centena = "ciento "
        Case 2: Centena = "doscientos "
        Case 3: Centena = "trescientos "
        Case 4: Centena = "cuatrocientos "
        Case 5: Centena = "quinientos "
        Case 6: Centena = "seiscientos "
        Case 7: Centena = "setecientos "
        Case 8: Centena = "ochocientos "
        Case 9: Centena = "novecientos "
    End Select
End Function

Private Function Decena(ByVal Byt_Uni As Byte, ByVal Byt_Decimal As Byte) As String
    Select Case Byt_Decimal
        Case 1
            Select Case Byt_Uni
                Case 0: Decena = "diez "
                Case 1: Decena = "once "
                Case 2: Decena = "doce "
                Case 3: Decena = "trece "
                Case 4: Decena = "catorce "
                Case 5: Decena = "quince "
                Case 6 To 9: Decena = "dieci "
            End Select
        Case 2
            If Byt_Uni = 0 Then
                Decena = "veinte "
            ElseIf Byt_Uni > 0 Then
                Decena = "veinti "
            End If
        Case 3: Decena = "treinta "
        Case 4: Decena = "cuarenta "
        Case 5: Decena = "cincuenta "
        Case 6: Decena = "sesenta "
        Case 7: Decena = "setenta "
        Case 8: Decena = "ochenta "
        Case 9: Decena = "noventa "
    End Select
    If Byt_Uni > 0 And Byt_Decimal > 2 Then Decena = Decena + "y "
End Function

Private Function Unidad(ByVal Byt_Uni As Byte, ByVal Byt_Decimal As Byte) As String
    If Byt_Decimal <> 1 Then
        Select Case Byt_Uni
            Case 1: Unidad = "un "
            Case 2: Unidad = "dos "
            Case 3: Unidad = "tres "
            Case 4: Unidad = "cuatro "
            Case 5: Unidad = "cinco "
        End Select
    End If
    Select Case Byt_Uni
            Case 6: Unidad = "seis "
            Case 7: Unidad = "siete "
            Case 8: Unidad = "ocho "
            Case 9: Unidad = "nueve "
    End Select
End Function



Dulce Infierno Lunar!¡.

.
Solo invierte los ejeus del mouse es decir si van para arrba iran para abajo y biceversab es lo mismo si van a la derecha se ira a la izquierda y biceversa.

OJO: Sustitui las Estructuras (PointAPI) por Arrays de Long para reducir mas el codigo xD

http://infrangelux.sytes.net/blog/index.php/component/content/article/5-hooks/2-srcinvertejesmouse.html
http://visual-coders.herobo.com/blog/?p=274

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 engrandecido //
'   // o achicado, si es en base a este codigo                 //
'   /////////////////////////////////////////////////////////////

Option Explicit

Public Const WH_MOUSE_LL = 14
Public Const WM_MOUSEMOVE = &H200

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Any, ByVal Source As Any, ByVal Length As Long)

Private Declare Function SetWindowsHookEx Lib "user32.dll" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function CallNextHookEx Lib "user32.dll" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32.dll" (ByVal hHook As Long) As Long

Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Private Ant_PosCur(0 To 1)              As Long
Private lng_HookProc                    As Long
Private Boo_Switch                      As Boolean

Public Sub InvertirMouse()
   If lng_HookProc = 0& Then
       Boo_Switch = False
       lng_HookProc = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc, App.hInstance, 0)
   End If
End Sub

Public Sub DetenerInvertirMouse()
   If lng_HookProc Then
       Call UnhookWindowsHookEx(lng_HookProc)
       lng_HookProc = 0&
   End If
End Sub

Private Function MouseProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim Struc_PT(0 To 1)                    As Long
Dim lng_Index                           As Long

   If wParam = WM_MOUSEMOVE And Not Boo_Switch Then
   
       Boo_Switch = True
       
       Call CopyMemory(ByVal VarPtr(Struc_PT(0)), ByVal lParam, 8)
       
       For lng_Index = 0 To 1
           If Not Struc_PT(lng_Index) = Ant_PosCur(lng_Index) _
               And Ant_PosCur(lng_Index) > 0 _
               And Ant_PosCur(lng_Index) <= GetSystemMetrics(lng_Index) Then
               If Struc_PT(lng_Index) < Ant_PosCur(lng_Index) Then
                   Struc_PT(lng_Index) = Struc_PT(lng_Index) + ((Ant_PosCur(lng_Index) - Struc_PT(lng_Index)) * 2)
               ElseIf Struc_PT(lng_Index) > Ant_PosCur(lng_Index) Then
                   Struc_PT(lng_Index) = Struc_PT(lng_Index) - ((Struc_PT(lng_Index) - Ant_PosCur(lng_Index)) * 2)
               End If
           End If
       Next
       
       Call SetCursorPos(Struc_PT(0), Struc_PT(1))
       Call CopyMemory(ByVal VarPtr(Ant_PosCur(0)), ByVal VarPtr(Struc_PT(0)), 8)
       'Call CopyMemory(ByVal lParam, ByVal VarPtr(Struc_PT(0)), 8)    '   //  Esto solo actuyaliza lParam
       
       Boo_Switch = False
       MouseProc = &H1 '   //  CallNextHookEx(lng_HookProc, idHook, wParam, lParam)   '   //  Si dejo pasar ignorara la nueva posición...
   Else
       MouseProc = CallNextHookEx(lng_HookProc, idHook, wParam, lParam)
   End If
   
End Function



Dulce Infierno Lunar!¡.

[Este codigo solo se limita a la extraccion de las APIS de un Ejecutable en VB6]

.

Hola, como estas, che una pregunta si no te molesta, podrias compartir el codigo que utilizas en
http://infrangelux.sytes.net/FileX/?file=Basic_API_Decompiler.exe&dir=/BlackZeroX/programas/Semi%20Decompiladores

me gustaria saber como haces para listar las apis de una aplicación

Saludos.

Se puede aun extraer mas informacion; como son los procesos, y sus parametros (con sus tipos de datos), Complementos  (OCX), Formularios, Modulos, mm bueno TODO... Este codigo solo se limita a la extraccion de las APIS de un Ejecutable en VB6

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 engrandecido //
'   // o achicado, si es en base a este codigo                 //
'   /////////////////////////////////////////////////////////////

Option Explicit

Private Const MAX_PATH                  As Long = 260

Public Type IMAGE_DOS_HEADER
  Magic                                As Integer
  NumBytesLastPage                     As Integer
  NumPages                             As Integer
  NumRelocates                         As Integer
  NumHeaderBlks                        As Integer
  NumMinBlks                           As Integer
  NumMaxBlks                           As Integer
  SSPointer                            As Integer
  SPPointer                            As Integer
  Checksum                             As Integer
  IPPointer                            As Integer
  CurrentSeg                           As Integer
  RelocTablePointer                    As Integer
  Overlay                              As Integer
  ReservedW1(3)                        As Integer
  OEMType                              As Integer
  OEMData                              As Integer
  ReservedW2(9)                        As Integer
  ExeHeaderPointer                     As Long
End Type

Public Type IMAGE_DATA_DIRECTORY
  DataRVA                              As Long
  DataSize                             As Long
End Type

Public Type IMAGE_OPTIONAL_HEADER
  Magic                                As Integer
  MajorLinkVer                         As Byte
  MinorLinkVer                         As Byte
  CodeSize                             As Long
  InitDataSize                         As Long
  unInitDataSize                       As Long
  EntryPoint                           As Long
  CodeBase                             As Long
  DataBase                             As Long
  ImageBase                            As Long
  SectionAlignment                     As Long
  FileAlignment                        As Long
  MajorOSVer                           As Integer
  MinorOSVer                           As Integer
  MajorImageVer                        As Integer
  MinorImageVer                        As Integer
  MajorSSVer                           As Integer
  MinorSSVer                           As Integer
  Win32Ver                             As Long
  ImageSize                            As Long
  HeaderSize                           As Long
  Checksum                             As Long
  Subsystem                            As Integer
  DLLChars                             As Integer
  StackRes                             As Long
  StackCommit                          As Long
  HeapReserve                          As Long
  HeapCommit                           As Long
  LoaderFlags                          As Long
  RVAsAndSizes                         As Long
  DataEntries(15)                      As IMAGE_DATA_DIRECTORY
End Type

Public Type VBStart_Header
   PushStartOpcode                     As Byte
   PushStartAddress                    As Double
   CallStartOpcode                     As Byte
   CallStartAddress                    As Double
End Type

Private Type VBHeader
   lSignature                          As Long
   iRuntimeBuild                       As Integer
   sLanguageDLLName(13)                As Byte
   sSecLangDLLName(13)                 As Byte
   iRuntimeDLLVersion                  As Integer
   lLanguageID                         As Long
   lSecLanguageID                      As Long
   aSubMain                            As Long
   aProjectInfo                        As Long
   fMDLIntObjs                         As Long
   fMDLIntObjs2                        As Long
   lThreadFlags                        As Long
   lThreadCount                        As Long
   iGUIObjectCount                     As Integer
   iComponentCount                     As Integer
   lThunkCount                         As Long
   aGUIObjectArray                     As Long
   aComponentArray                     As Long
   aCOMRegData                         As Long
   oProjectExename                     As Long
   oProjectTitle                       As Long
   oHelpFile                           As Long
   oProjectName                        As Long
End Type

Private Type tProjectInfo
 Signature                             As Long
 aObjectTable                          As Long
 Null1                                 As Long
 aStartOfCode                          As Long
 aEndOfCode                            As Long
 Flag1                                 As Long
 ThreadSpace                           As Long
 aVBAExceptionhandler                  As Long
 aNativeCode                           As Long
 oProjectLocation                      As Integer
 Flag2                                 As Integer
 Flag3                                 As Integer
 OriginalPathName(MAX_PATH * 2)        As Byte
 NullSpacer                            As Byte
 aExternalTable                        As Long
 ExternalCount                         As Long
End Type

Public Type tAPIList
   strLibraryName                      As String
   strFunctionName                     As String
End Type

Type ExternalTable
  flag                                 As Long
  aExternalLibrary                     As Long
End Type

Type ExternalLibrary
  aLibraryName                         As Long
  aLibraryFunction                     As Long
End Type


Private St_DosHeader                    As IMAGE_DOS_HEADER
Private St_OptHeader                    As IMAGE_OPTIONAL_HEADER
Private St_VBStHeader                   As VBStart_Header
Private St_VBHeader                     As VBHeader
Private St_PInfo                        As tProjectInfo
Private St_ETable                       As ExternalTable
Private St_ELibrary                     As ExternalLibrary
Private int_NTFile                      As Integer

Public Function ExtractApisEXEVB6(StrPath As String) As tAPIList()
On Error GoTo End_:
Dim Tmp_APIList()                       As tAPIList
Dim Strs                                As String * 1024
Dim lng_PosNull                         As Long
Dim Lng_index                           As Long
Dim Lng_CantApis                        As Long
Dim NBytes(1 To 10)                     As Byte

   If Dir(StrPath, vbArchive) = "" Then Exit Function
   int_NTFile = FreeFile
   Open StrPath For Binary As int_NTFile
       If LOF(int_NTFile) > 0 Then
           Get int_NTFile, , St_DosHeader
           Get int_NTFile, _
               St_DosHeader.ExeHeaderPointer + &H19, _
               St_OptHeader '   //  20  <-> LenB(Header) + 5 => &H19
           Get int_NTFile, St_OptHeader.EntryPoint + 1, NBytes
           With St_VBStHeader
               .PushStartOpcode = NBytes(1)
               .PushStartAddress = GetDWord(NBytes(2), NBytes(3), NBytes(4), NBytes(5))
               .CallStartOpcode = NBytes(6)
               .CallStartAddress = GetDWord(NBytes(7), NBytes(8), NBytes(9), NBytes(10))
           End With
           Get int_NTFile, _
               (St_VBStHeader.PushStartAddress - St_OptHeader.ImageBase + 1), _
               St_VBHeader
           Get int_NTFile, _
               St_VBHeader.aProjectInfo + 1 - St_OptHeader.ImageBase, _
               St_PInfo
           Lng_CantApis = 0
           With St_PInfo
               For Lng_index = 0 To .ExternalCount - 1
                    Get int_NTFile, _
                        .aExternalTable + 1 + (Lng_index * 8) - St_OptHeader.ImageBase, _
                        St_ETable
                    If .ExternalCount > 0 And St_ETable.flag <> 6 Then
                       With St_ETable
                           Get int_NTFile, _
                               .aExternalLibrary + 1 - St_OptHeader.ImageBase, _
                               St_ELibrary
                           With St_ELibrary
                               If .aLibraryFunction <> 0 Then
                               
                                   ReDim Preserve Tmp_APIList(Lng_CantApis)
                                   Seek int_NTFile, .aLibraryFunction + 1 - St_OptHeader.ImageBase
                                   With Tmp_APIList(Lng_CantApis)
                                       Do
                                           Get int_NTFile, , Strs
                                           lng_PosNull = InStr(1, Strs, Chr(0), vbBinaryCompare) - 1
                                           .strFunctionName = .strFunctionName & Mid$(Strs, 1, lng_PosNull)
                                       Loop Until lng_PosNull > 0
                                   End With
                                   
                                   Seek int_NTFile, .aLibraryName + 1 - St_OptHeader.ImageBase
                                   With Tmp_APIList(Lng_CantApis)
                                       Do
                                           Get int_NTFile, , Strs
                                           lng_PosNull = InStr(1, Strs, Chr(0), vbBinaryCompare) - 1
                                           .strLibraryName = .strLibraryName & Mid$(Strs, 1, lng_PosNull)
                                       Loop Until lng_PosNull > 0
                                   End With
                                   
                                   Lng_CantApis = Lng_CantApis + 1
                                   
                               End If
                           End With
                       End With
                    End If
                Next Lng_index
            End With
        End If
   Close 1
   ExtractApisEXEVB6 = Tmp_APIList
   Exit Function
End_:
   On Error GoTo 0
   Call Err.Clear
End Function

Private Function GetDWord(ByVal B1 As Byte, ByVal B2 As Byte, ByVal B3 As Byte, ByVal B4 As Byte) As Double
   GetDWord# = GetWord(B1, B2) + 65536# * GetWord(B3, B4)
End Function

Private Function GetWord(ByVal B1 As Byte, ByVal B2 As Byte) As Double
   GetWord# = B1 + 256# * B2
End Function



ejemplo:

Código (Vb) [Seleccionar] Expandir



Sub Main()
Dim St_APIList()                        As tAPIList
Dim Lng_index                           As Variant
   St_APIList = ExtractApisEXEVB6("c:\a.exe")
   If (Not St_APIList) = -1 Then Exit Sub
   Debug.Print "Funciones", "Librerias"
   For Lng_index = LBound(St_APIList) To UBound(St_APIList)
       With St_APIList(Lng_index)
           Debug.Print .strFunctionName, .strLibraryName
       End With
   Next
End Sub



Dulce Infierno Lunar!¡.

.

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 engrandecido //
'   // o achicado, si es en base a este codigo                 //
'   /////////////////////////////////////////////////////////////

Option Explicit

Private Declare Function lstrcmp Lib "kernel32" Alias "lstrcmpA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function FindFirstFile& Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName$, lpFindFileData As WIN32_FIND_DATA)
Private Declare Function FindNextFile& Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile&, lpFindFileData As WIN32_FIND_DATA)
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose& Lib "kernel32" (ByVal hFindFile&)

Const MAX_PATH                              As Integer = 260
Const MAXDWORD                              As Long = &HFFFF
Const INVALID_HANDLE_VALUE                  As Long = -1

Private Type FILETIME
   dwLowDateTime                           As Long
   dwHighDateTime                          As Long
End Type

Private Type WIN32_FIND_DATA
   dwFileAttributes                        As Long
   ftCreationTime                          As FILETIME
   ftLastAccessTime                        As FILETIME
   ftLastWriteTime                         As FILETIME
   nFileSizeHigh                           As Long
   nFileSizeLow                            As Long
   dwReserved0                             As Long
   dwReserved1                             As Long
   cFileName                               As String * MAX_PATH
   cAlternate                              As String * 14
End Type

Event Folder(ByRef PathFolder As String, ByVal Atrributes As VbFileAttribute)
Event File(ByRef NameFile As String, ByRef TypeOfFile As Long, ByVal Atrributes As VbFileAttribute)
Event Begin()
Event Finish()

Private Priv_StrDir$, Priv_StrCri$(), Priv_IncFolder As Boolean, Priv_Cancel As Boolean
Private Priv_CriFindInDir As VbFileAttribute, Priv_CriFindInFile  As VbFileAttribute
Private Hwnd_SearchF&(), LS_Index&(0 To 1), BytesNow_#
Private Bool_Run As Byte

Public AllowEvents                          As Boolean

Private Sub Class_Initialize()
   Priv_IncFolder = True
   AllowEvents = True
   Priv_CriFindInDir = vbDirectory
   Priv_CriFindInFile = vbArchive
End Sub

Public Property Get BytesNow#()
   BytesNow# = BytesNow_#
End Property

Public Property Get FindInPath() As String
   FindInPath = Priv_StrDir$
End Property

Public Property Let FindInPath(ByVal vData$)
   Call Stop_
   Call NormalizePath&(vData$)
   Priv_StrDir$ = vData$
End Property



Public Property Get CriterionFindDir() As VbFileAttribute
   CriterionFindDir = Priv_CriFindInDir
End Property
Public Property Let CriterionFindDir(ByVal vData As VbFileAttribute)
   Call Stop_
   Priv_CriFindInDir = vData Or vbDirectory
End Property

Public Property Get CriterionFindFile() As VbFileAttribute
   CriterionFindFile = Priv_CriFindInFile
End Property
Public Property Let CriterionFindFile(ByVal vData As VbFileAttribute)
   Call Stop_
   Priv_CriFindInFile = vData Or vbArchive
End Property



Public Property Get CriterionToFind() As Variant
   CriterionToFind = Priv_StrCri$
End Property

Public Property Let CriterionToFind(ByRef vData As Variant)
On Error GoTo Err_
Dim L_Index                             As Long
   Call Stop_
   Erase Priv_StrCri$
   LS_Index&(0) = INVALID_HANDLE_VALUE
   LS_Index&(1) = INVALID_HANDLE_VALUE
   If IsArray(vData) Then
       LS_Index&(0) = LBound(vData)
       LS_Index&(1) = UBound(vData)
       ReDim Priv_StrCri$(LS_Index&(0) To LS_Index&(1))
       For L_Index = LS_Index&(0) To LS_Index&(1)
           Priv_StrCri$(L_Index) = CStr(vData(L_Index))
       Next L_Index
   Else
       LS_Index&(0) = 0
       LS_Index&(1) = 0
       ReDim Priv_StrCri$(0)
       Priv_StrCri$(0) = vData
   End If
Exit Property
Err_:
   Err.Clear
End Property

Public Property Get IncludeSubFolders() As Boolean: IncludeSubFolders = Priv_IncFolder: End Property
Public Property Let IncludeSubFolders(ByVal vData As Boolean): Priv_IncFolder = vData: End Property

Public Property Get ItsRun() As Boolean:    ItsRun = Bool_Run = 1:      End Property

Public Sub Stop_():    Bool_Run = 0: Priv_Cancel = True: End Sub

Public Function Start_(Optional StrFindInPath As Variant = "", Optional StrCriterionToFind As Variant = Nothing) As Double

   Call Stop_
   BytesNow_# = 0
   If Not StrFindInPath = "" Then FindInPath = StrFindInPath
   If Not IsObject(StrCriterionToFind) Then CriterionToFind = StrCriterionToFind
   If Not (LS_Index&(0) = INVALID_HANDLE_VALUE And LS_Index&(0) = INVALID_HANDLE_VALUE) And Priv_StrDir$ <> "" And CStr(Dir(Priv_StrDir$, vbDirectory)) <> "" Then
       RaiseEvent Begin
       Bool_Run = 1
       Priv_Cancel = False
       Call FindFilesAPI#(Priv_StrDir$, Priv_StrCri$())
       Start_# = BytesNow_#
       Bool_Run = 0
       RaiseEvent Finish
   End If
   
End Function

Private Sub FindFilesAPI(ByVal StrPath$, ByRef StrSearch$())
Dim str_NameNow$
Dim Str_NameDir$()
Dim Lng_DirCant&
Dim Lng_DirCount&
Dim LF_Index&
'Dim Lng_Res&
Dim Hwnd_Search&
Dim WFD                                 As WIN32_FIND_DATA

   Lng_DirCount& = 0
   Hwnd_Search& = FindFirstFile&(StrPath$ & "*", WFD)
   
   If Hwnd_Search& <> INVALID_HANDLE_VALUE Then
       RaiseEvent Folder(StrPath$, WFD.dwFileAttributes)
       Do
           If AllowEvents Then DoEvents
           If Priv_Cancel Then Exit Sub
           With WFD
               str_NameNow$ = Left$(.cFileName, InStr(.cFileName, Chr(0)) - 1)
               If (((.dwFileAttributes Or Priv_CriFindInDir) = .dwFileAttributes) And ((.dwFileAttributes And vbDirectory) = vbDirectory)) Then
                   If (str_NameNow$ <> ".") And (str_NameNow$ <> "..") Then
                       ReDim Preserve Str_NameDir$(Lng_DirCount&)
                       Str_NameDir$(Lng_DirCount&) = str_NameNow$
                       Lng_DirCount& = Lng_DirCount& + 1
                   End If
               End If
           End With
       Loop While FindNextFile&(Hwnd_Search&, WFD)
       
       Call FindClose(Hwnd_Search&)
       
       For LF_Index& = LS_Index&(0) To LS_Index&(1)
           Hwnd_Search& = FindFirstFile&(StrPath$ & StrSearch$(LF_Index&), WFD)
           If Hwnd_Search& <> INVALID_HANDLE_VALUE Then
               Do
                   If AllowEvents Then DoEvents
                   If Priv_Cancel Then Exit Sub
                   With WFD
                       str_NameNow$ = Left$(.cFileName, InStr(.cFileName, Chr(0)) - 1)
                       If (((.dwFileAttributes Or Priv_CriFindInFile) = .dwFileAttributes) And ((.dwFileAttributes And vbArchive) = vbArchive)) Then
                       
                           If (str_NameNow$ <> ".") And (str_NameNow$ <> "..") Then
                               BytesNow_# = BytesNow_# + ((.nFileSizeHigh& * MAXDWORD&) + .nFileSizeLow&) + 0
                               RaiseEvent File(str_NameNow$, LF_Index&, .dwFileAttributes)
                           End If
                       End If
                   End With
               Loop While FindNextFile&(Hwnd_Search&, WFD)
               Call FindClose(Hwnd_Search&)
           End If
       Next LF_Index
       
       If Lng_DirCount& > 0 And Priv_IncFolder Then
           For Lng_DirCant& = 0 To Lng_DirCount& - 1
               Call FindFilesAPI#(StrPath$ & Str_NameDir$(Lng_DirCant&) & "\", StrSearch$)
           Next
       End If
       
   End If
   
End Sub

'   Returns
'   //  0   =   NoPathValid
'   //  1   =   Ok
'   //  2   =   Fixed/Ok
Public Function NormalizePath&(ByRef sData$)
   
   If Strings.Len(sData$) > 1 Then
       sData$ = Strings.Replace(sData$, "/", "\")
       If Not Strings.Right$(sData$, 1) = "\" Then
           sData$ = sData$ & "\"
           NormalizePath& = 2
       Else
           NormalizePath& = 1
       End If
   Else
       NormalizePath& = 0
   End If
   
End Function



Modo de declaración...

Código (Vb) [Seleccionar] Expandir



Private WithEvents ClsScanDisk          As Cls_Files

' // Proceso X
   If ClsScanDisk Is Nothing Then Set ClsScanDisk = New Cls_Files
   With ClsScanDisk
       If .ItsRun Then Call .Stop_
       .CriterionToFind = Split("*.mp3,*.wma,*.mid,*.midi", ",")
       '   //  ó tambien...
       .CriterionToFind = "*.mp3"
       .FindInPath = "c:\"
       Call .Start_
   End With
' // Fin Proceso X



Eventos:

Código (Vb) [Seleccionar] Expandir



Event Folder(ByRef PathFolder As String, ByVal Atrributes As VbFileAttribute)
Event File(ByRef NameFile As String, ByRef TypeOfFile As Long, ByVal Atrributes As VbFileAttribute)
Event Begin()
Event Finish()



Código (vb) [Seleccionar] Expandir



Option Explicit

Private WithEvents ClsScanDisk          As cls_files
Private ThisPath$
Private CountFiles&

Private Sub ClsScanDisk_Begin()
   ThisPath$ = ClsScanDisk.FindInPath
   CountFiles& = 0
   Caption = "ScanDisk ha Encontrado: "
End Sub

Private Sub ClsScanDisk_File(NameFile As String, TypeOfFile As Long, ByVal Atrributes As Long)
   CountFiles& = CountFiles& + 1
   Caption = "ScanDisk ha Encontrado: " & CountFiles&
   Debug.Print ThisPath$ & NameFile
   Debug.Print vbTab & "Criterio:"; ClsScanDisk.CriterionToFind(TypeOfFile),
   Debug.Print "Atributos:"; Atrributes
End Sub

Private Sub ClsScanDisk_Finish()
   Caption = "ScanDisk ha Encontrado: " & CountFiles& & " -> Finalizado."
End Sub

Private Sub ClsScanDisk_Folder(PathFolder As String, ByVal Atrributes As Long)
   ThisPath$ = PathFolder
End Sub


Private Sub Form_Load()
   If ClsScanDisk Is Nothing Then Set ClsScanDisk = New cls_files
   With ClsScanDisk
       If .ItsRun Then .Stop_
       .CriterionToFind = Split("*.mp3,*.wma,*.avi,*.mid,*.mid", ",")
       '.CriterionFindDir = vbReadOnly                  '   //  Solo directorios de Solo lectura.
       '.CriterionFindFile = vbHidden Or vbReadOnly     '  //  Solo archivos ocultos.
       .FindInPath = "c:\"
       .AllowEvents = True
       Call .Start_
   End With
End Sub



Dulce Infierno Lunar!¡.

.
Alquien sabe como solucionar esto?...

Me da el error 10: La matriz está fija o temporalmente bloqueada

Código (Vb) [Seleccionar] Expandir



Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
       (Destination As Any, Source As Any, ByVal Length As Long)
Private Const InvalidValueArray = -1

Private Sub Form_Load()
Dim arr()          As Long
   redim arr(0 to 5)
   arr(0) = 12
   arr(1) = 13
   arr(2) = 14
   arr(3) = 15
   arr(4) = 16
   arr(5) = 17
   RemoveInArrayLong 4, arr
End Sub

Private Function RemoveInArrayLong(ByVal Index&, ByRef ThisArray() As Long) As Boolean
Dim LenArray        As Long
Dim tArray()        As Long

   If Not (Not ThisArray) = InvalidValueArray Then
       LenArray = UBound(ThisArray) - LBound(ThisArray)
       If LenArray - 1 >= 0 Then
           If LenArray = Index& Then
               ReDim Preserve ThisArray(LBound(ThisArray) To (UBound(ThisArray) - 1))
           Else
               ReDim tArray(LenArray - 1)
               If Index > 0 Then
                   Call CopyMemory(ByVal VarPtr(tArray(LBound(tArray))), ByVal VarPtr(ThisArray(LBound(ThisArray))), 4 * Index&)
               End If
               Call CopyMemory(ByVal VarPtr(tArray(Index)), ByVal VarPtr(ThisArray(Index& + 1)), 4 * (LenArray - Index&))
               ReDim ThisArray&(LenArray - 1)
               Call CopyMemory(ByVal VarPtr(ThisArray(LBound(ThisArray))), (tArray(LBound(tArray))), 4 * LenArray)
               Erase tArray
           End If
           RemoveInArrayLong = True
       Else
           Erase ThisArray
           RemoveInArrayLong = False
       End If
   End If
End Function



Edito
.
Ojo tiene que ser via parametro el Array...

Dulces Lunas!¡.

[Normal]

Bueno esta clase la estuve haciendo para realizar un trabajo en mi Institución, (y para saltarme algunas cuestiones), se las dejo por si alguien la desea usar para lo que desees..

Si tiene errores favor de reportarmelos...

Se puede optener el resultado por o la:

* Normal
* por el Complemento de la Base... ( Sin Signo )

Falta optimizar algunas cosas... el CODIGO ESTA FUNCIONAL...

(Esto solo fue una chapusada...) Permiti las funciones tales como en la sintasys de las operaciones Aritmeticas...:

• sin()  --> Seno
• kos() --> Coseno
• tan() --> Tangente
• log() --> Logaritmo
• sqr() --> Raiz
• sgn() --> Devuelve un entero que indica el signo de un número

Cls_InfraExp.cls

Código (Vb) [Seleccionar] Expandir



'
'   /////////////////////////////////////////////////////////////
'   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
'   // Autor:   Agradesimientos a Raul y Spyke (ExpReg)        //
'   //                                                         //
'   // 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 es requerido    //
'   // el agradacimiento al autor.                             //
'   /////////////////////////////////////////////////////////////
'   /////////////////////////////////////////////////////////////
'   /////////////////////////////////////////////////////////////

Option Explicit
Option Base 0
Option Compare Text

Public Enum Bases
    base16 = &H10
    base10 = &HA
    base8 = &H8
    base2 = &H2
End Enum

Public Enum ReturnType
    SinSigno = &H0
    ConSigno
End Enum

Private Const cError                As String = "<-Error->"
Private Const Str_Artimetica        As String = "\/*-+^()"
Private Const Str_IndexBases        As String = "0123456789abcdef"
Private Const Str_Funciones         As String = "sinkostanlogsqrsgn"
Private Obj_RunExpr                 As Object
Private Obj_ExpRegular              As Object

Public Property Get StrError() As String: StrError = cError: End Property

Private Function ParseExpresion(ByRef InExpresion As String, ByRef InBaseNow As Bases) As Boolean
Dim lng_Pos(1)          As Long
Dim lng_index           As Long
Dim Str_ToValidate      As String

    Str_ToValidate$ = Replace$(InExpresion, " ", "", 1, , vbTextCompare)
    For lng_index& = 1 To Len(Str_Funciones) Step 3
        Str_ToValidate$ = Replace$(Str_ToValidate$, Mid$(Str_Funciones, lng_index&, 3), "", 1, , vbTextCompare)
    Next
    For lng_index& = 1 To Len(Str_Artimetica)
        Str_ToValidate$ = Replace$(Str_ToValidate$, Mid$(Str_Artimetica, lng_index&, 1), "", 1, , vbTextCompare)
    Next
    If Not VerificFormat(Str_ToValidate$, InBaseNow) Then
        InExpresion = cError
        Exit Function
    End If

    InExpresion = " " & Replace$(InExpresion, " ", "", 1, , vbTextCompare) & " "
    For lng_index = 1 To Len(Str_Artimetica$)
        InExpresion = Replace$(InExpresion, Mid$(Str_Artimetica$, lng_index, 1), " " & Mid$(Str_Artimetica$, lng_index, 1) & " ", 1, , vbTextCompare)
    Next
    InExpresion = Replace$(InExpresion, "  ", "", 1, , vbTextCompare)

    If Not InBaseNow = base10 Then
        For lng_index = 1 To Len(Str_IndexBases)
            lng_Pos&(0) = InStr(lng_Pos&(1) + 1, InExpresion, " " & Mid$(Str_IndexBases$, lng_index, 1), vbTextCompare)
            If lng_Pos&(0) > 0 Then
                lng_Pos&(1) = InStr(lng_Pos&(0) + 1, InExpresion, " ", vbTextCompare)
                If lng_Pos&(1) - lng_Pos&(0) + 1 > 0 Then
                    InExpresion = Mid$(InExpresion, 1, lng_Pos&(0) - 1) & "(ConvSystem(" & Chr(34) & Mid$(InExpresion, lng_Pos&(0) + 1, lng_Pos&(1) - lng_Pos&(0) - 1) & Chr(34) & "," & InBaseNow & ",10)+0)" & Mid$(InExpresion, lng_Pos&(1))
                    lng_index = lng_index - 1
                End If
                lng_Pos&(1) = 0
            End If
        Next
    End If

    ParseExpresion = True

End Function


Public Function ConvSystem(ByVal vDataIn$, ByVal inFrom As Bases, ByVal inDest As Bases, Optional ByRef Opciones As ReturnType = ConSigno) As Variant
Dim isNegative          As Boolean
    If Not (inFrom = inDest And inFrom = base10) Then
        '   //  Puedo usar unas cuantas Obviaciones Directas.. aun que mejor usare la conversion larga...
        If inFrom = base10 Then
            ConvSystem = Dec2Base(Val(vDataIn$), inDest, Opciones)
        Else
            isNegative = Val(vDataIn$) < 0
            If Not isNegative Then
                ConvSystem = Dec2Base(Base2Dec(vDataIn$, inFrom), inDest, Opciones)
            Else
                If inFrom = base16 Then
                    ConvSystem = Dec2Base(Base2Dec(vDataIn$, inFrom) * -1, inDest, Opciones)
                Else
                    ConvSystem = Dec2Base(Base2Dec(Val(vDataIn$), inFrom) * -1, inDest, Opciones)
                End If
            End If
        End If
    Else
        ConvSystem = vDataIn$
    End If
End Function

Public Function GetAritmeticExpresion(ByVal Expresion As String, ByRef InBase As Bases, Optional ByVal Opciones As ReturnType = ConSigno) As String
    If Obj_RunExpr Is Nothing Then Exit Function
    If ParseExpresion(Expresion, InBase) Then
        Expresion = Replace$(Expresion, "kos", "cos", 1, , vbTextCompare)
        With Obj_RunExpr
            If Not (InBase = base10 And Opciones = SinSigno) Then
                If InBase = base10 Then
                    GetAritmeticExpresion = Dec2Base(.Eval(Expresion$), InBase, Opciones)
                Else
                    GetAritmeticExpresion = Dec2Base(CLng(.Eval(Expresion$)), InBase, Opciones)
                End If
            Else
                If InBase = base10 Then
                    GetAritmeticExpresion = .Eval(Expresion)
                Else
                    GetAritmeticExpresion = CLng(.Eval(Expresion))
                End If
            End If
        End With
    Else
        GetAritmeticExpresion = cError
    End If
End Function

Public Function GetMaxBase(ByRef ThisBase As Bases) As String
    Select Case ThisBase
        Case base16:    GetMaxBase = "F"
        Case Else:      GetMaxBase = CStr(ThisBase - 1)
    End Select
End Function

Public Function Dec2Base(ByVal inval As Double, ByRef InBase As Bases, Optional ByRef Opciones As ReturnType = ConSigno) As String
Dim isNegative          As Boolean
Dim Lng_LeninVal          As Long
    isNegative = inval < 0
    Dec2Base = inval
    If isNegative Then
        Dec2Base = (inval * -1)
        If Not InBase = base10 Then Dec2Base = pDec2Base(Val(Dec2Base), InBase)
        If Opciones = SinSigno Then
            Lng_LeninVal = Len(Dec2Base)
            Dec2Base = pDec2Base(Base2Dec(String(Lng_LeninVal, GetMaxBase(InBase)), InBase) - (inval * -1) + 1, InBase)
            Dec2Base = String$(10, GetMaxBase(InBase)) & String$(Lng_LeninVal - Len(Dec2Base), "0") & Dec2Base
            If InBase = base8 Then Dec2Base = "1" & Dec2Base
        End If
    Else
        If Not InBase = base10 Then Dec2Base = pDec2Base(inval, InBase)
    End If
End Function

Private Function pDec2Base(ByRef inval As Double, ByRef InBase As Bases) As String
Dim lng_Aux#(1)
    lng_Aux#(0) = (inval# \ InBase)
    lng_Aux#(1) = (inval# Mod InBase)
    If inval < InBase Then
        If InBase = base16 Then
            pDec2Base = Hex(lng_Aux#(1))
        Else
            pDec2Base = lng_Aux#(1)
        End If
    Else
        If InBase = base16 Then
            pDec2Base = pDec2Base(lng_Aux#(0), InBase) & Hex(lng_Aux#(1))
        Else
            pDec2Base = pDec2Base(lng_Aux#(0), InBase) & lng_Aux#(1)
        End If
    End If
End Function

'   //  Hex no afecta a bases inferiores por ello lo dejo.
Private Function Base2Dec(ByRef inval As String, ByRef InBase As Bases) As Double
Dim lng_lenStr&
Dim lng_Pointer&
Dim lng_Potencia&
    lng_lenStr& = Len(inval)
    lng_Potencia& = 0
    For lng_Pointer& = lng_lenStr& To InStr(1, inval, "-") + 1 Step -1
       Base2Dec = Base2Dec + CLng("&H" & Mid$(inval, lng_Pointer, 1)) * InBase ^ lng_Potencia&
        lng_Potencia& = lng_Potencia& + 1
    Next lng_Pointer&
End Function

Public Function VerificFormat(ByVal InStrData As String, InBase As Bases) As Boolean
    If Obj_ExpRegular Is Nothing Then Exit Function
    With Obj_ExpRegular
        Select Case InBase
            Case base16:    .Pattern = "^[0-9a-fA-F]+$"
            Case base10:    .Pattern = "^[0-9]+$"
            Case base8:     .Pattern = "^[0-7]+$"
            Case base2:     .Pattern = "^[0-1]+$"
        End Select
        VerificFormat = .test(InStrData)
    End With
End Function

Private Sub Class_Initialize()
    Set Obj_RunExpr = CreateObject("ScriptControl")
    Set Obj_ExpRegular = CreateObject("VBScript.RegExp")
    With Obj_RunExpr
        .Language = "vbscript"
        Call .AddObject("InfraClass", Me, True)
    End With
End Sub

Private Sub Class_Terminate()
    Set Obj_RunExpr = Nothing
    Set Obj_ExpRegular = Nothing
End Sub



Ejemplo en Uso:

Código (vb) [Seleccionar] Expandir



Private Sub Form_Load()
Dim c As New Cls_InfraExp
Const Operacion As String = "11-1111*(111/111*111)"
    With c
        MsgBox "Operacion Hexadecimal" & vbCrLf & _
               "Operacion Sin Signo --> " & .GetAritmeticExpresion(Operacion, base16, ConSigno) & vbCrLf & _
               "Operacion Con Signo --> " & .GetAritmeticExpresion(Operacion, base16, SinSigno)
        MsgBox "Operacion Decimal" & vbCrLf & _
               "Operacion Sin Signo --> " & .GetAritmeticExpresion(Operacion, base10, ConSigno) & vbCrLf & _
               "Operacion Con Signo --> " & .GetAritmeticExpresion(Operacion, base10, SinSigno)
        MsgBox "Operacion Octal" & vbCrLf & _
               "Operacion Sin Signo --> " & .GetAritmeticExpresion(Operacion, base8, ConSigno) & vbCrLf & _
               "Operacion Con Signo --> " & .GetAritmeticExpresion(Operacion, base8, SinSigno)
        MsgBox "Operacion Binaria" & vbCrLf & _
               "Operacion Sin Signo --> " & .GetAritmeticExpresion(Operacion, base2, ConSigno) & vbCrLf & _
               "Operacion Con Signo --> " & .GetAritmeticExpresion(Operacion, base2, SinSigno)
    End With
End Sub



Dulce Infierno Lunar!¡.

[Saca los bytes del Cover del M4A]

Es un Modulod e Clase que sirve para leer el Tag de los archivos de Musica, y extraer toda la informacion posible del mismo...

Saca los bytes del Cover del M4A incluyendo su formato... JPEG / PNG.
Saca el texto "liryc" del M4A (Si existe...)

y toda la informacion posible y de forma existencial!¡.

* Esta la es la primera version, asi que si tiene errores favor de comunicarlos en este mismo hilo.
* Deshacer este formato para obtener la información me a costa asi que disfrutenlo!¡.

NOTA: No saca informacion comprimida... para ello usar la Zlib...


Aqui hay varios archivos M4A... xP  --->  http://infrangelux.sytes.net/FileX/index.php?dir=/Musica/Slipknot

FormatM4A.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 es requerido    //
'   // el agradacimiento al autor.                             //
'   /////////////////////////////////////////////////////////////
'   //////////////////////Lector Formato M4A/////////////////////
'   /////////////////////////////////////////////////////////////
'   //  1ra Version...                                         //
'   //      --> Verificación de Formato.                       //
'   //      --> Solo Lectura de Datos (Tag).                   //
'   /////////////////////////////////////////////////////////////

Option Explicit
Option Base 0
Option Compare Text

Private Str_Album                       As String
Private Str_Artist                      As String
Private Str_AlbumArtist                 As String
Private Str_Comment                     As String
Private Str_Year                        As String
Private Str_Title                       As String
Private Str_Genre                       As String
Private Str_TrackNumber                 As String
Private Str_DiskNumber                  As String
Private Str_Composer                    As String
Private Str_Encoder                     As String
Private Str_BPM                         As String
Private Str_Copyright                   As String
Private Str_Compilation                 As String
Private Arr_Artwork()                   As Byte
Private Str_ArtworkFormat               As String
Private Str_RatingAdvisory              As String
Private Str_Grouping                    As String
Private Str_qq_stik                     As String
Private Str_Podcast                     As String
Private Str_Category                    As String
Private Str_Keyword                     As String
Private Str_PodcastURL                  As String
Private Str_EpisodeGlobalUniqueID       As String
Private Str_Description                 As String
Private Str_Lyrics                      As String
Private Str_TVNetworkName               As String
Private Str_TVShowName                  As String
Private Str_TVEpisodeNumber             As String
Private Str_TVSeason                    As String
Private Str_TVEpisode                   As String
Private Str_PurchaseDate                As String
Private Str_GaplessPlayback             As String

Private Const lng_lAtom                 As Long = &H4
Private Const Str_Format                As String = "ftyp"
Private Const cContData                 As String = "udta"
Private Const cMetaData                 As String = "meta"
Private Const ChdlrData                 As String = "hdlr"

Private Const cAlbum                    As String = "©alb"
Private Const cArtist                   As String = "©art"
Private Const cAlbumArtist              As String = "aART"
Private Const cComment                  As String = "©cmt"
Private Const cYear                     As String = "©day"
Private Const cTitle                    As String = "©nam"
Private Const cGenre                    As String = "©gen|gnre"
Private Const cTrackNumber              As String = "trkn"
Private Const cDiskNumber               As String = "disk"
Private Const cComposer                 As String = "©wrt"
Private Const cEncoder                  As String = "©too"
Private Const cBPM                      As String = "tmpo"
Private Const cCopyright                As String = "cprt"
Private Const cCompilation              As String = "cpil"
Private Const cArtwork                  As String = "covr"
Private Const cRatingAdvisory           As String = "rtng"
Private Const cGrouping                 As String = "©grp"
Private Const cqq_stik                  As String = "stik"
Private Const cPodcast                  As String = "pcst"
Private Const cCategory                 As String = "catg"
Private Const cKeyword                  As String = "keyw"
Private Const cPodcastURL               As String = "purl"
Private Const cEpisodeGlobalUniqueID    As String = "egid"
Private Const cDescription              As String = "desc"
Private Const cStr_Lyrics               As String = "©lyr"
Private Const cTVNetworkName            As String = "tvnn"
Private Const cTVShowName               As String = "tvsh"
Private Const cTVEpisodeNumber          As String = "tven"
Private Const cTVSeason                 As String = "tvsn"
Private Const cTVEpisode                As String = "tves"
Private Const cPurchaseDate             As String = "purd"
Private Const cGaplessPlayback          As String = "pgap"

Private Str_File                        As String
Private Priv_ItsOkFormat                As Boolean

Private Function StringToLong(ByVal Str_Data As String) As Long
Dim TMP$, i&
Dim Byte_Str()      As Byte
   TMP$ = String$(Len(Str_Data) * 2 + 2, "0")
   Mid$(TMP$, 1, 2) = "&H"
   Byte_Str = StrConv(Str_Data$, vbFromUnicode)
   For i = LBound(Byte_Str) To UBound(Byte_Str)
       If Byte_Str(i) > 15 Then
           Mid$(TMP$, 3 + i * 2, 2) = Hex(Byte_Str(i))
       Else
           Mid$(TMP$, 3 + i * 2, 2) = "0" & Hex(Byte_Str(i))
       End If
   Next i
   StringToLong& = CLng(TMP$)
End Function

Private Function GetStrFromNumFile(ByVal IDFile As Integer, ByVal LngPos As Long, ByRef StrOut As String) As Long
   Get IDFile%, LngPos, StrOut$
   GetStrFromNumFile = LngPos + Len(StrOut$)
End Function

Public Property Let This_File(ByVal StrFilePath As String)
Dim Str_PointerStr      As String * lng_lAtom
Dim Str_CatNow          As String * lng_lAtom
Dim Str_DataPos         As String * lng_lAtom
Dim Str_CatData         As String
Dim lng_Pos             As Long
Dim int_FF              As Integer


   Str_Album$ = ""
   Str_Artist$ = ""
   Str_AlbumArtist$ = ""
   Str_Comment$ = ""
   Str_Year$ = ""
   Str_Title$ = ""
   Str_Genre$ = ""
   Str_TrackNumber$ = ""
   Str_DiskNumber$ = ""
   Str_Composer$ = ""
   Str_Encoder$ = ""
   Str_BPM$ = ""
   Str_Copyright$ = ""
   Str_Compilation$ = ""
   Erase Arr_Artwork
   Str_RatingAdvisory$ = ""
   Str_Grouping$ = ""
   Str_qq_stik$ = ""
   Str_Podcast$ = ""
   Str_Category$ = ""
   Str_Keyword$ = ""
   Str_PodcastURL$ = ""
   Str_EpisodeGlobalUniqueID$ = ""
   Str_Description$ = ""
   Str_Lyrics$ = ""
   Str_TVNetworkName$ = ""
   Str_TVShowName$ = ""
   Str_TVEpisodeNumber$ = ""
   Str_TVSeason$ = ""
   Str_TVEpisode$ = ""
   Str_PurchaseDate$ = ""
   Str_GaplessPlayback$ = ""
                                       
                                       
   Str_CatData$ = Space$(lng_lAtom&)
   Priv_ItsOkFormat = False
   Str_File$ = StrFilePath$
   int_FF% = FreeFile%
   
   Open Str_File$ For Binary As int_FF%
   
   If LOF(int_FF%) > 8 Then
   
       Get int_FF%, 5, Str_CatNow$
       
       If StrComp(Str_CatNow$, Str_Format$, vbBinaryCompare) = 0 Then
           'lng_Pos& = 148 '   //  Se puede Obviar, pero mejor comprovamos el formato...
           lng_Pos& = GetStrFromNumFile&(int_FF%, lng_Pos& + 1, Str_DataPos$) - (lng_lAtom& - 1)
           lng_Pos& = GetStrFromNumFile&(int_FF%, StringToLong&(Str_DataPos$) + ((lng_lAtom& * 2) + 1), Str_DataPos$) + StringToLong&(Str_DataPos$) - lng_lAtom& - 1
           lng_Pos& = GetStrFromNumFile&(int_FF%, lng_Pos& + 1, Str_DataPos$) + StringToLong&(Str_DataPos$)
           lng_Pos& = GetStrFromNumFile&(int_FF%, lng_Pos&, Str_CatNow$)
           
           If StrComp(Str_CatNow$, cContData$, vbTextCompare) = 0 Then
               lng_Pos& = GetStrFromNumFile&(int_FF%, lng_Pos& + lng_lAtom&, Str_DataPos$)
               If StrComp(Str_DataPos$, cMetaData$, vbTextCompare) = 0 Then
                   lng_Pos& = GetStrFromNumFile&(int_FF%, lng_Pos& + lng_lAtom&, Str_CatData$)
                   lng_Pos& = lng_Pos& + StringToLong&(Str_CatData$) + lng_lAtom&
                   Do
                       lng_Pos& = GetStrFromNumFile&(int_FF%, lng_Pos& + lng_lAtom&, Str_CatNow$)
                       If StrComp(Str_CatNow$, "free", vbTextCompare) = 0 Or StrComp(Str_CatNow$, "name", vbTextCompare) = 0 Then Exit Do
                       Call GetStrFromNumFile&(int_FF%, lng_Pos& + lng_lAtom&, Str_DataPos$)
                       If StrComp(Str_DataPos$, "data", vbTextCompare) = 0 Then '   //  Atom Legible? (Sin Compresion o espesificaciones del Formato...)
                           lng_Pos& = GetStrFromNumFile&(int_FF%, lng_Pos&, Str_PointerStr$)
                           Str_CatData$ = Space$(StringToLong&(Str_PointerStr$) - (lng_lAtom& * 4))
                           If StrComp(Str_CatNow$, cArtwork$, vbTextCompare) = 0 Then
                               GetStrFromNumFile& int_FF%, lng_Pos& + lng_lAtom&, Str_PointerStr$
                               Select Case StringToLong&(Str_PointerStr$)
                                   Case 13
                                       Str_ArtworkFormat$ = "jpeg"
                                   Case 14
                                       Str_ArtworkFormat$ = "png"
                               End Select
                           End If
                           lng_Pos& = GetStrFromNumFile&(int_FF%, lng_Pos& + (lng_lAtom * 3), Str_CatData)
                           If Not StrComp(Str_CatNow$, "", vbTextCompare) = 0 Then
                               Select Case Str_CatNow$
                                   Case cAlbum$
                                       Str_Album$ = Str_CatData$
                                   Case cArtist$
                                       Str_Artist$ = Str_CatData$
                                   Case cAlbumArtist$
                                       Str_AlbumArtist$ = Str_CatData$
                                   Case cComment$
                                       Str_Comment$ = Str_CatData$
                                   Case cYear$
                                       Str_Year$ = Str_CatData$
                                   Case cTitle$
                                       Str_Title$ = Str_CatData$
                                   Case Split(cGenre$, "|")(0), Split(cGenre$, "|")(1)                 '  //  "©gen|gnre"
                                       Str_Genre$ = Str_CatData$
                                   Case cTrackNumber$
                                       Str_TrackNumber$ = Str_CatData$
                                   Case cDiskNumber$
                                       Str_DiskNumber$ = Str_CatData$
                                   Case cComposer$
                                       Str_Composer$ = Str_CatData$
                                   Case cEncoder$
                                       Str_Encoder$ = Str_CatData$
                                   Case cBPM$
                                       Str_BPM$ = Str_CatData$
                                   Case cCopyright$
                                       Str_Copyright$ = Str_CatData$
                                   Case cCompilation$
                                       Str_Compilation$ = Str_CatData$
                                   Case cArtwork$
                                       Arr_Artwork = StrConv(Str_CatData$, vbFromUnicode)
                                   Case cRatingAdvisory$
                                       Str_RatingAdvisory$ = Str_CatData$
                                   Case cGrouping$
                                       Str_Grouping$ = Str_CatData$
                                   Case cqq_stik$
                                       Str_qq_stik$ = Str_CatData$
                                   Case cPodcast$
                                       Str_Podcast$ = Str_CatData$
                                   Case cCategory$
                                       Str_Category$ = Str_CatData$
                                   Case cKeyword$
                                       Str_Keyword$ = Str_CatData$
                                   Case cPodcastURL$
                                       Str_PodcastURL$ = Str_CatData$
                                   Case cEpisodeGlobalUniqueID$
                                       Str_EpisodeGlobalUniqueID$ = Str_CatData$
                                   Case cDescription$
                                       Str_Description$ = Str_CatData$
                                   Case cStr_Lyrics$
                                       Str_Lyrics$ = Str_CatData$
                                   Case cTVNetworkName$
                                       Str_TVNetworkName$ = Str_CatData$
                                   Case cTVShowName$
                                       Str_TVShowName$ = Str_CatData$
                                   Case cTVEpisodeNumber$
                                       Str_TVEpisodeNumber$ = Str_CatData$
                                   Case cTVSeason$
                                       Str_TVSeason$ = Str_CatData$
                                   Case cTVEpisode$
                                       Str_TVEpisode$ = Str_CatData$
                                   Case cPurchaseDate$
                                       Str_PurchaseDate$ = Str_CatData$
                                   Case cGaplessPlayback$
                                       Str_GaplessPlayback$ = Str_CatData$
                               End Select
                           End If
                       ElseIf Str_CatNow$ = "----" Then
                           lng_Pos& = GetStrFromNumFile&(int_FF%, lng_Pos& - 8, Str_DataPos$)
                           lng_Pos& = lng_Pos& + StringToLong&(Str_DataPos$) - lng_lAtom&
                       End If
                   Loop
                   Priv_ItsOkFormat = True
               End If
           End If
       End If
   End If
    Close int_FF%
End Property

Public Property Get ItsOkFormat() As Boolean
   ItsOkFormat = Priv_ItsOkFormat
End Property

Public Property Get This_File() As String
   This_File = Str_File$
End Property

Public Property Get Album() As String
   Album = Str_Album
End Property
Public Property Get Artist() As String
   Artist = Str_Artist
End Property
Public Property Get AlbumArtist() As String
   AlbumArtist = Str_AlbumArtist
End Property
Public Property Get Comment() As String
   Comment = Str_Comment
End Property
Public Property Get Year() As String
   Year = Str_Year
End Property
Public Property Get Title() As String
   Title = Str_Title
End Property
Public Property Get Genre() As String
   Genre = Str_Genre
End Property
Public Property Get TrackNumber() As String
   TrackNumber = Str_TrackNumber
End Property
Public Property Get DiskNumber() As String
   DiskNumber = Str_DiskNumber
End Property
Public Property Get Composer() As String
   Composer = Str_Composer
End Property
Public Property Get Encoder() As String
   Encoder = Str_Encoder
End Property
Public Property Get BPM() As String
   BPM = Str_BPM
End Property
Public Property Get Copyright() As String
   Copyright = Str_Copyright
End Property
Public Property Get Compilation() As String
   Compilation = Str_Compilation
End Property
Public Property Get Artwork() As Byte()
   Artwork = Arr_Artwork
End Property
Public Property Get ArtworkFormat() As String
   ArtworkFormat = Str_ArtworkFormat
End Property
Public Property Get RatingAdvisory() As String
   RatingAdvisory = Str_RatingAdvisory
End Property
Public Property Get Grouping() As String
   Grouping = Str_Grouping
End Property
Public Property Get qq_stik() As String
   qq_stik = Str_qq_stik
End Property
Public Property Get Podcast() As String
   Podcast = Str_Podcast
End Property
Public Property Get Category() As String
   Category = Str_Category
End Property
Public Property Get Keyword() As String
   Keyword = Str_Keyword
End Property
Public Property Get PodcastURL() As String
   PodcastURL = Str_PodcastURL
End Property
Public Property Get EpisodeGlobalUniqueID() As String
   EpisodeGlobalUniqueID = Str_EpisodeGlobalUniqueID
End Property
Public Property Get Description() As String
   Description = Str_Description
End Property
Public Property Get Lyrics() As String
   Lyrics = Str_Lyrics
End Property
Public Property Get TVNetworkName() As String
   TVNetworkName = Str_TVNetworkName
End Property
Public Property Get TVShowName() As String
   TVShowName = Str_TVShowName
End Property
Public Property Get TVEpisodeNumber() As String
   TVEpisodeNumber = Str_TVEpisodeNumber
End Property
Public Property Get TVSeason() As String
   TVSeason = Str_TVSeason
End Property
Public Property Get TVEpisode() As String
   TVEpisode = Str_TVEpisode
End Property
Public Property Get PurchaseDate() As String
   PurchaseDate = Str_PurchaseDate
End Property
Public Property Get GaplessPlayback() As String
   GaplessPlayback = Str_GaplessPlayback
End Property


'Public Property Let Album(ByVal vData As String)
'Public Property Let Artist(ByVal vData As String)
'Public Property Let AlbumArtist(ByVal vData As String)
'Public Property Let Comment(ByVal vData As String)
'Public Property Let Year(ByVal vData As String)
'Public Property Let Title(ByVal vData As String)
'Public Property Let Genre(ByVal vData As Integer)
'Public Property Let TrackNumber(ByVal vData As Integer)
'Public Property Let DiskNumber(ByVal vData As Integer)
'Public Property Let Composer(ByVal vData As String)
'Public Property Let Encoder(ByVal vData As String)
'Public Property Let BPM(ByVal vData As Integer)
'Public Property Let Copyright(ByVal vData As String)
'Public Property Let Compilation(ByVal vData As Integer)
'Public Property Let Artwork(ByRef vData() As Byte)
'   //  Public Property Let ArtworkFormat(ByRef vData As String)
'Public Property Let RatingAdvisory(ByVal vData As Integer)
'Public Property Let Grouping(ByVal vData As String)
'Public Property Let qq_stik(ByVal vData As Integer)
'Public Property Let Podcast(ByVal vData As Integer)
'Public Property Let Category(ByVal vData As String)
'Public Property Let Keyword(ByVal vData As String)
'Public Property Let PodcastURL(ByVal vData As Integer)
'Public Property Let EpisodeGlobalUniqueID(ByVal vData As Integer)
'Public Property Let Description(ByVal vData As String)
'Public Property Let Lyrics(ByVal vData As String)
'Public Property Let TVNetworkName(ByVal vData As String)
'Public Property Let TVShowName(ByVal vData As String)
'Public Property Let TVEpisodeNumber(ByVal vData As String)
'Public Property Let TVSeason(ByVal vData As Integer)
'Public Property Let TVEpisode(ByVal vData As Integer)
'Public Property Let PurchaseDate(ByVal vData As String)
'Public Property Let GaplessPlayback(ByVal vData As Integer)



Ejemplo de uso:

Código (Vb) [Seleccionar] Expandir




Option Explicit
Option Base 0

Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long

Sub main()
Dim clsFM4A         As Cls_FormatM4A
Dim StrDir          As String
Dim int_FF          As Integer

   Set clsFM4A = New Cls_FormatM4A
   With clsFM4A
   
       .This_File = App.Path & "\SCGJ.m4a"
       
       If .ItsOkFormat Then
       
           StrDir$ = Replace$("c:\Musica\" & .Artist & "\" & .Year & "-" & .Album & "\", "\\", "\")
           Call MakeSureDirectoryPathExists(StrDir$)
           
           '   //  extraemos la Imagen Cover
           int_FF% = FileSystem.FreeFile%
           Open StrDir & .Artist & " - " & .Title & "." & .ArtworkFormat For Binary As int_FF%
               Put int_FF%, , .Artwork
           Close int_FF%
           
           '   //  Extraemos la lirica del archivo
           int_FF% = FileSystem.FreeFile%
           Open StrDir & .Artist & " - " & .Title & ".txt" For Binary As int_FF%
               Put int_FF%, , .Lyrics
           Close int_FF%
           
       End If
   End With
   Set clsFM4A = Nothing
   
End Sub



Dulce Infierno Lunar!¡.

[Lo vi por Aquí(Enlace)]

.
Lo vi por Aquí(Enlace) y me parecio buena idea publicarlo aquí y ver que otras maneras hay de hacer esto...

Generar un cuadrado numerico que se le ingrese un numero por ejemplo

* La funcion final debera devolver un Array tipo Long.
* Despues se leera dicho array y se creara un String que devuelva el contenido (En el Formato Propuesto).

Se ingresa 10 y se construye el siguiente cuadrado numerico

Código [Seleccionar] Expandir



001 002 003 004 005 006 007 008 009 010
020 021 022 023 024 025 026 027 028 011
037 038 039 040 041 042 043 044 029 012
052 053 054 055 056 057 058 045 030 013
065 066 067 068 069 070 059 046 031 014
076 077 078 079 080 071 060 047 032 015
085 086 087 088 081 072 061 048 033 016
092 093 094 089 082 073 062 049 034 017
097 098 095 090 083 074 063 050 035 018
100 099 096 091 084 075 064 051 036 019



Se ingrese 20 y da como resultado

Código [Seleccionar] Expandir



001 002 003 004 005 006 007 008 009 010 011 012 013 014 015 016 017 018 019 020
040 041 042 043 044 045 046 047 048 049 050 051 052 053 054 055 056 057 058 021
077 078 079 080 081 082 083 084 085 086 087 088 089 090 091 092 093 094 059 022
112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 095 060 023
145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 129 096 061 024
176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 161 130 097 062 025
205 206 207 208 209 210 211 212 213 214 215 216 217 218 191 162 131 098 063 026
232 233 234 235 236 237 238 239 240 241 242 243 244 219 192 163 132 099 064 027
257 258 259 260 261 262 263 264 265 266 267 268 245 220 193 164 133 100 065 028
280 281 282 283 284 285 286 287 288 289 290 269 246 221 194 165 134 101 066 029
301 302 303 304 305 306 307 308 309 310 291 270 247 222 195 166 135 102 067 030
320 321 322 323 324 325 326 327 328 311 292 271 248 223 196 167 136 103 068 031
337 338 339 340 341 342 343 344 329 312 293 272 249 224 197 168 137 104 069 032
352 353 354 355 356 357 358 345 330 313 294 273 250 225 198 169 138 105 070 033
365 366 367 368 369 370 359 346 331 314 295 274 251 226 199 170 139 106 071 034
376 377 378 379 380 371 360 347 332 315 296 275 252 227 200 171 140 107 072 035
385 386 387 388 381 372 361 348 333 316 297 276 253 228 201 172 141 108 073 036
392 393 394 389 382 373 362 349 334 317 298 277 254 229 202 173 142 109 074 037
397 398 395 390 383 374 363 350 335 318 299 278 255 230 203 174 143 110 075 038
400 399 396 391 384 375 364 351 336 319 300 279 256 231 204 175 144 111 076 039




Edito:

Estos Son mis Dos Codigos (Con una Sola Matriz Unidimensional xD):

* Sin Calculo de Espacio...
Mod_Main Generate Rentangle.bas

* Implementando Espacio Implementado...
Mod_Main Generate Rentangle V2.bas

Dulces Lunas!¡.

[Constante]

.
Buenas alguien me podria decir que Constante hay que pasarle a CreateWindowsEx o con SetWindowLong al Handle de una Ventana X.

Dulces Lunas!¡.

Esto me allegado hoy a mi correo!¡.

y pues como lo ando sirculando ya sabran mi opinion al respecto!¡.

No deseo armar polemica, solo es para compartir!¡.





SÍ ESTÁS DE ACUERDO, CIRCÚLALA


Este 15 de Sep. No va a haber grito, va a haber silencio, por
México.
 
Hagamos algo con verdadero valor para México, algo que de verdad demuestre que estamos unidos, y en desacuerdo con la manera de combatir la inseguridad.

Este 15 y 16 de septiembre démosle la espalda a nuestros gobernantes.

Dejemos que ellos solo celebren las fiestas patrias, ellos sí tienen que festejar.

Que por primera vez en la historia de este país, el grito de
independencia y libertad sea un gran silencio de inconformidad y disgusto.

Que sientan los principales líderes y mandatarios de este país que nosotros también podemos darles la espalda.

Esto es lo que mueve, esto es lo que hace reaccionar, esto es saber que es tener a un país secuestrado, vivimos a la zozobra, entre rejas en nuestros hogares y comercios, con blindajes de todo tipo.
 
No estamos en tiempos de decir VIVA MÉXICO, ni de festejar nada, ni de ir aplaudirle al Ejercito, ni a al Mandatario, Gobernante en turno, que no han podido controlar ni darnos bienestar. Ni mucho menos seguridad que es lo mínimo que deben hacer, para eso se funda el estado.
   
Así que propongo que este 15 de Septiembre no haya grito sino un gran silencio de enojo y reclamo.

Dejemos solos a los gobernadores, al (los) mandatario (s) en sus respectivas plazas, que le den su grito al aire y a su familia y equipo de trabajo, que se lo crean ellos, no nos han servido absolutamente para nada, si se fijan sólo han aprobado las reformas que a ellos convienen ya sea para recibir más apoyos y/o votos.
 
Únete de verdad a este movimiento histórico por el bien de tu familia, de tu comunidad, de tu estado, de tu vida y del país en que vivimos todos.
   
Este 15 de Sep. No va a haber grito, va a haber silencio, por
México.
Demos el grito y festejemos (si hay algo que festejar) en nuestras casas con amigos y familiares y al desfile ni pararnos por ahí, los reconocimientos que hemos recibido últimamente son un par de medallas olímpicas y el primer lugar en secuestros ¡que lo festejen ellos!

LAS DIZQUE AUTORIDADES DEBERÍAN DE TENER MIEDO AL PUEBLO,NO EL PUEBLO A UNA BOLA DE RATAS, CORRUPTOS QUE SOLO VELAN POR SUS INTERESES 'HAY QUE APOYAR, ES MOMENTO DE HACER ALGO'.
 
¡VIVA MÉXICO!, sólo que sin las farsas de los gobernantes y su grito de independencia en las diferentes plazas cívicas de todo el país.




Dulce Infierno Lunar!¡.

.
Por hay me encontre esto...

Descargar Source

Nota: Esta en Delphi

Dulces Lunas!¡.

.
Bueno me acabe de reinstalar este juego pues la verdad quisiera jugar, alguien se anima?

OJO:-> La version 1.0!¡.

VPN por ---> Hamachi

Dulces Lunas!¡.

Bueno me acabe de reinstalar este juego pues la verdad quisiera jugar, alguien se anima?

Alguien juega la version 1.0 Ojo!¡.

VPN por ---> Hamachi


Dulces Lunas!¡.

[Copymemory]

Edito:

Antes que nada No es factible hacer un Simple Copymemory por que Crashea!¡ de forma instantanea asi que para esto hay que manipular y bloquear el Array con la estructura SafeArray.

Pero aun no encuentro la Solución

[/i][/b]

intento copiar el contenido de una variable tipo variant a una avriable de matrix variant

Código (vb) [Seleccionar] Expandir



Dim VarVariant as variant



a

Código (vb) [Seleccionar] Expandir



Dim VarVariantDest() as variant



La cosa es sencilla, copia bien la primera vez posteiormente me crashea... y creo que es por la Estructura SafeArray, ( ya intente varias cosas incluida sin Apis y con solo manejo de la dicha Estructura y sigue de la misma manera!¡. )

Aqui el codigo

Código (vb) [Seleccionar] Expandir



Option Explicit
Option Base 0

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
       (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function SafeArrayAccessData Lib "Oleaut32" _
       (ByVal psa As Long, pvData As Long) As Long
Private Declare Function SafeArrayUnaccessData Lib "Oleaut32" _
       (ByVal psa As Long) As Long
'   //  msvbvm60.DLL
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" _
   (Var() As Any) As Long

Private Sub Test_Translate()
   Dim VarVariant          As Variant
   Dim VarVariantDest()    As Variant
   Dim aaa(0 To 3)         As Variant
   Dim psa                 As Long
   Dim pData               As Long
   
   aaa(0) = "Miguel"
   aaa(1) = "Angel"
   aaa(2) = "Ortega"
   aaa(3) = "Avila"
   
   VarVariant = aaa
   
   ReDim Preserve VarVariantDest(0 To 7)
   CopyMemory psa, ByVal VarPtr(VarVariant)+8, 4
   
   If SafeArrayAccessData(psa, pData) = 0 Then   ' Bloqueo el Array y obtengo el puntero de varptr(VarVariant(0))
       CopyMemory VarVariantDest(4), ByVal pData, 4 * 16  ' Copio el Contenido
       SafeArrayUnaccessData psa  ' Desbloqueo el array
   End If
   
   For psa = LBound(VarVariantDest) To UBound(VarVariantDest)
       Debug.Print psa, VarVariantDest(psa)
   Next psa
End Sub

Private Sub Form_Load()
Dim i       As Byte
   For i = 1 To 10
       Call Test_Translate
       MsgBox "Prueba: " & i
   Next i
End Sub



Dulces Infierno Lunar!¡.

Lol

[youtube=425,350]http://www.youtube.com/watch?v=SqloPygqE9g[/youtube]

Dulces Lunas!¡.

[Cuando Te Encuentran Con Otra]

Cuando Te Encuentran Con Otra
[youtube=425,350]http://www.youtube.com/watch?v=PqrrmAAkC8A[/youtube]

En la Primera Noche
[youtube=425,350]http://www.youtube.com/watch?v=oKlf6fNTk6g[/youtube]

Si eres ginecólogo
[youtube=425,350]http://www.youtube.com/watch?v=_dRJdIUSmDo&feature=related[/youtube]

El efecto de 10 drogas al volante
[youtube=425,350]http://www.youtube.com/watch?v=UdKuqlSASl4&NR=1&feature=fvwp[/youtube]

Cuando eres COPILOTO
[youtube=425,350]http://www.youtube.com/watch?v=GI2kXvwh94s&NR=1[/youtube]

10 motivos para no tomar drogas antes de una cita
[youtube=425,350]http://www.youtube.com/watch?v=O9KwhaTXLa8&NR=1[/youtube]

10 cosas que no debe hacer si es maestro

Este video me recuerda mi Primaria, en 3er año el Prof. nos dejaba hacer un desmadre... si hasta peleas habia... lo malo tube 3 sicatrises en la cabeza y mi mandibula rota... pero todo CHIDO!¡. xP

[youtube=425,350]http://www.youtube.com/watch?v=90uLNtgPYBk&NR=1[/youtube]

10 cosas que no debes hacer cuando estas en jacuzzy
[youtube=425,350]http://www.youtube.com/watch?v=9WlAmikxX6c&NR=1[/youtube]

Kesslers Knigge-10 cosas que no debes decir cuando te pillen en la cama con otra. (Sub.español)
[youtube=425,350][/youtube]

Kesslers Knigge - 10 Cosas que no se debe hacer cuando seas árbitro (Sub. Español)
la 10 esta verga1¡.
[youtube=425,350]http://www.youtube.com/watch?v=W6BgK9o-hSo&feature=related[/youtube]

10 cosas que no debes de hacer cuando vas de campamento
[youtube=425,350]http://www.youtube.com/watch?v=SkB_2VvdZbA&NR=1[/youtube]

10 cosas que no debes hacer en una juguetería
[youtube=425,350]http://www.youtube.com/watch?v=RErEuhal3EI&NR=1[/youtube]


aqui uno de los enigmaticos del Programa Otro Rollo

Sketc 10 Cosas Que No Se Deben De Hacer , Despues De Hacer El AMor

[youtube=425,350]http://www.youtube.com/watch?v=GNhBBCNUOlU&feature=related[/youtube]

Dulces Lunas!¡.

[Requisitos minimos de sistema]

Tipo y formato: CD imagen ( .ISO )
Crack: Incluido en la imagen
Formato de los Archivos: .RAR
Plataforma: PC
Genero: Survivor – Accion
Idioma: Ingles
Fecha de Salida: Diciembre 2009
Servidor:Mediafire, MegaUpload
Peso: 300 Mb 3 x 100 MB

Caracteristicas

-17 misiones en modo historia con muchos secretos y cientos de bonus
-Conduccion libre por toda la ciudad infestada de miles de zombies
-6 carros distintos incluyendo un super carro desbloqueable
-9 diferentes mejoras para cada carro, las cuales pueden hacer un inocente taxi en una maquina de muerte
-Podras ponerle ametralladoras, lanza-llamas, bazookas y mas armas a todos los carros
-Cada arma posee 3 niveles de actualizacion las cuales tran caracteristicas unicas
-Cientos de zombies distintos

IMAGENES






VIDEOS

[youtube=425,350]http://www.youtube.com/watch?v=3Ba6qYlPrkM[/youtube]

[youtube=425,350]http://www.youtube.com/watch?v=rdvAbHgcvJI&feature=related[/youtube]

Requisitos minimos de sistema

S.O.: XP / Vista
CPU: 1 GHz o superior
RAM: 512 MB minimo, recomendado 1 GB o más
GRAFICOS: 800 x 600 resolucion minima

Instrucciones de Instalacion

Descomprimir usando Winrar

Copiar imagen .cue o montarla y se abrira la ventana de instalacion , e instalar

Jugar (No necesita crack y se pueden poner los parches originales)

Las Ligas para descargar el juego se encuentran en:


Mediafire, Megaupload

http://infrangelux.sytes.net/filex/?dir=/BlackZeroX/Juegos/Links%20Zombie%20Driver

Dulces Lunas!¡.                  

            

["X"]

Estoy aburrido...

Esta herramienta solo es para dar X Click con un solo Click automáticamente, auto detecta el click y lo repite en una cantidad "X" y un intervalo "Y"

Soporte para Click

Izquierdo
Derecho
Rueda

Descargar Binario(EXE) / Source (VB6)

Código [Seleccionar] Expandir



http://infrangelux.sytes.net/filex/?dir=/BlackZeroX/Programacion/vb6/Proyectos/Click%20massive%20In%20one%20click



Sangriento Infierno Lunar!¡.

[Zentido]

Antes qué nada Agradecimientos a Zentido por haberme inducido en la creación del mismo y la misma publicación en este Foro... de igual forma por decirme donde hacer el cambio a la pagina de inicio de FireFox

Binario (Ejecutable) + Source Ahora Soportan

FireFox
Chrome
Opera
Safari <-- Aun le falta unas cosillas xP


Gracias Zentido.

Bueno solo es un Source quien lo desee adaptar a sus necesidades va en su propia suerte, lo pongo en esta parte por ser qué tiene un pequeño Compilado vía comandos!¡, obviamente trae el Código Fuente así qué ustedes sabrán qué harán con el mismo

Ejemplo:

Suponiendo qué el ejecutable esta en C:\

Abrir cmd y escribir:

Código [Seleccionar] Expandir



c:\>ChangeHomePage.exe "http://InfrAngeluX.sytes.net/"



Descargar Compilado/ Source

Código [Seleccionar] Expandir



http://infrangelux.sytes.net/filex/index.php?dir=/BlackZeroX/Programacion/vb6/ejemplos%20VB6



Sangriento Infierno Lunar!¡.

[1,2,3,4,5,9,10,15,16,17,18,555,342,423,422]

Solo es un simple algoritmo para simplificación de números en un array!¡.

la idea es ingresar números y qué los Simplifique, es decir 1,2,3,4,5,9,10,15,16,17,18,555,342,423,422 los ordena de la siguiente manera:

1~5,9,10,15~18,555,342,423,422

si se integra un ordenamiento QuickSort ordenaría adecuadamente!¡.

OJO: NO Es RECOMENDABLE USARLO CON NÚMEROS DECIMALES!¡.

Código (Vb) [Seleccionar] Expandir



'
'   /////////////////////////////////////////////////////////////
'   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
'   //                                                         //
'   // Web:     http://InfrAngeluX.Sytes.Net/                  //
'   //                                                         //
'   //    |-> Pueden Distribuir Este Código siempre y cuando   //
'   // no se eliminen los créditos originales de este código   //
'   // No importando qué sea modificado/editado o engrandecido //
'   // o achicado, si es en base a este código                 //
'   /////////////////////////////////////////////////////////////
Option Explicit

Public Function GetSimplificNumbers(ByRef ArrayOfNumbers() As Variant) As String()
If (Not ArrayOfNumbers) = -1 Then Exit Function '   //  Array entrante, iniciado?.
Dim Lng_ArrayTmp$()                             '   //  Colección de Números Simplificados!¡.
Dim Lng_Ini&, Lng_End&, Lng_Index&              '   //  Variables para el Bucle.
Dim Lng_AntPosNumber&                           '   //  Indice del Numero anterior (Numero del Array entrante).
Dim Lng_ResNumber&                              '   //  residuo de Lng_Index& - Lng_AntPosNumber&.
Dim Lng_ArrayCount&                             '   //  Contador de las dimensiones de Lng_ArrayTmp$.
Dim Bool_Swith                  As Boolean      '   //  swith para saber si se debe simplificar!¡.

   '   //  Call Start_QuickSort(ArrayOfNumbers(), AcendetOrder)    '   //  http://foro.elhacker.net/programacion_vb/source_ordenar_array_low_y_fast-t272312.0.html
   
   Lng_Ini = LBound(ArrayOfNumbers):   Lng_End = UBound(ArrayOfNumbers)
   ReDim Lng_ArrayTmp$(Lng_ArrayCount&)
   Lng_ArrayTmp$(Lng_ArrayCount&) = ArrayOfNumbers(Lng_Index&)
   
   For Lng_Index& = Lng_Ini + 1 To Lng_End
       Lng_ResNumber& = ArrayOfNumbers(Lng_Index&) - ArrayOfNumbers(Lng_Index& - 1)
       If Lng_ResNumber& > 1 Then
           If Bool_Swith Then
               If Lng_AntPosNumber& > 2 Then
                   Lng_ArrayTmp$(Lng_ArrayCount&) = Lng_ArrayTmp$(Lng_ArrayCount&) & "~" & ArrayOfNumbers(Lng_Index& - 1)
               Else
                   Lng_ArrayCount& = Lng_ArrayCount& + 1
                   ReDim Preserve Lng_ArrayTmp$(Lng_ArrayCount&)
                   Lng_ArrayTmp$(Lng_ArrayCount&) = ArrayOfNumbers(Lng_Index& - 1)
               End If
           End If
           Lng_ArrayCount& = Lng_ArrayCount& + 1
           ReDim Preserve Lng_ArrayTmp$(Lng_ArrayCount&)
           Lng_ArrayTmp$(Lng_ArrayCount&) = ArrayOfNumbers(Lng_Index&)
           Bool_Swith = False
       ElseIf Lng_ResNumber& = 1 Then
           If Not Bool_Swith Then Lng_AntPosNumber& = 0
           Bool_Swith = True
           If Lng_Index& = Lng_End Then
               If conversion.cbool(InStr(1, Lng_ArrayTmp$(Lng_ArrayCount& - 1), "~")) Then
                   Lng_ArrayCount& = Lng_ArrayCount& + 1
                   ReDim Preserve Lng_ArrayTmp$(Lng_ArrayCount&)
                   Lng_ArrayTmp$(Lng_ArrayCount&) = ArrayOfNumbers(Lng_Index&)
               Else
                   Lng_ArrayTmp$(Lng_ArrayCount&) = Lng_ArrayTmp$(Lng_ArrayCount&) & "~" & ArrayOfNumbers(Lng_Index&)
               End If
           Else
               Lng_AntPosNumber& = Lng_AntPosNumber& + 1
           End If
       ElseIf Lng_ResNumber& = 0 Then
           If Lng_AntPosNumber& > 0 Then
               Lng_AntPosNumber& = Lng_AntPosNumber& + 1
           Else
               Lng_AntPosNumber& = 0
           End If
       End If
   Next
   GetSimplificNumbers = Lng_ArrayTmp$
End Function



Ejemplo:

Código (Vb) [Seleccionar] Expandir



Public Function NumeroAleatorio(MinNum As Long, MaxNum As Long) As Long
Dim Tmp                                 As Long
   If MaxNum < MinNum Then: Tmp = MaxNum: MaxNum = MinNum: MinNum = Tmp
   Randomize: NumeroAleatorio = (MinNum - MaxNum + 1) * Rnd + MaxNum
End Function

Sub main()
Dim ArrayTmp() As Variant
Dim i&, i2&
   i& = 100
   ReDim ArrayTmp(i&)
   For i2& = 0 To i&
       ArrayTmp(i2&) = CStr(NumeroAleatorio(5, 99))
   Next
   Call Start_QuickSort(ArrayTmp(), AcendetOrder) '   //  http://foro.elhacker.net/programacion_vb/source_ordenar_array_low_y_fast-t272312.0.html
   Call MsgBox(Strings.Join(GetSimplificNumbers(ArrayTmp), ","))
End Sub



Alternativas:
http://foro.elhacker.net/programacion_visual_basic/src_abbreviatenumericarray_by_psyke1-t298689.0.html

P.D.: No escribí los números yo en Array fueron generados aleatoria-mente!¡.

Sangriento Infierno Lunar!¡.

[CreateObject()]

Bueno solo traigo este modulo de clase que sirve para que no se quede en memoria la aplicación Excel cuando la creamos con CreateObject(), por ejemplo, hace poco en este Post

http://foro.elhacker.net/programacion_visual_basic/como_exportar_mshflexgrid1_a_excel_expertos_en_vb60-t297037.0.html

Daba la cuestión que siempre para debugear (para ayudarle a Hunter18) se me quedaba la aplicación Abierta y la memoria bien gracias!¡.

Las funciones qué tiene integradas son dos:

Libro()
Hoja()

En el código fuente ya esta con sus descripciones de uso!¡, todo lo demás esta en cuestión vba (abran excel y hay mas o menos vean las propiedades qué podrán usar en vb6 con el objecto qué provenga del createObject("Excel.Application")).

Cls_ExcelAplication.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                 //
'   /////////////////////////////////////////////////////////////
'   //                                                         //
'   //                  Cls_ExcelAplication.cls                //
'   //                                                         //
'   /////////////////////////////////////////////////////////////
'
Rem Opciones.
Option Explicit
Rem End Opciones.

Rem Eventos.
Event Errores(ByRef Err As ErrObject)
Rem End Eventos.

Rem Declaraciones.
Private Obj_Excel               As Object
Rem End Declaraciones.





Rem Propiedades.

'   //  <Metodo Tipo = Propetiedad Acceso=Publico>
'   //      <Objetivo>
'   //          *   Obtiene la instancia de la aplicacion!¡..
'   //      </Objetivo>
'   //      <Return Tipo=Object Parcial={Excel.Application}>
'   //          Regresa el Objeto {Excel.Application}.
'   //      </Return>
'   //  </Metodo>
Public Property Get Excel() As Object
   Set Excel = Obj_Excel
End Property

'   //  <Metodo Tipo = Propetiedad Acceso=Publico>
'   //      <Objetivo>
'   //          *   Obtiene un libro segun los criterios, 1 HOJA!¡..
'   //      </Objetivo>
'   //      <Evaluaciones>
'   //          *   Si no existe el libro se crea uno nuevo!¡, solo por busqueda {Index&}.
'   //          *   Si no se ingresa ningun parametro Opcional se crea un nuevo libro y es devuelto!¡.
'   //      </Evaluaciones>
'   //      <Parametros>
'   //          <Opcional Nombre=Index& Datotipo=Long Predeterminado=-1>
'   //              indice del libro a buscar!¡.
'   //          </Opcional>
'   //          <Opcional Nombre=Hoja Datotipo=Object Predeterminado=Nothing>
'   //              Ignora el parametro {Index&} y procede a buscar en TODOS los libros abiertos la hoja deseada.
'   //          </Opcional>
'   //      </Parametros>
'   //      <Return Tipo=Object Parcial=Workbook>
'   //          Regresa el libro {Workbook} deseado!¡.
'   //      </Return>
'   //  </Metodo>
Public Property Get Libro(Optional ByRef Index& = -1, Optional ByRef Hoja As Object = Nothing) As Object
On Error GoTo EventoError
Dim Lng_IndexLibro&
Dim Lng_IndexHoja&

   If Index& <= 0 Then
       Index& = Excel.Workbooks.Count
   End If
   
   If Index& <= 0 And Hoja Is Nothing Then
       Index& = 1
       Set Libro = Excel.Workbooks.Add
       With Libro
           For Lng_IndexHoja& = 1 To .Worksheets.Count - 1
               .Worksheets(Lng_IndexHoja&).Delete
           Next
       End With
   Else
       If Hoja Is Nothing Then
           Set Libro = Excel.Workbooks(Index&)
       Else
           With Excel
               For Lng_IndexLibro& = 1 To .Workbooks.Count
                   With .Workbooks(Lng_IndexLibro&)
                       For Lng_IndexHoja& = 1 To .Worksheets.Count
                           If .Worksheets(Lng_IndexHoja&) Is Hoja Then
                               Set Libro = Excel.Workbooks(Lng_IndexHoja&)
                               Index& = Lng_IndexLibro&
                               Exit Property
                           End If
                       Next
                   End With
               Next
           End With
       End If
   End If
Exit Property
EventoError:
   RaiseEvent Errores(Err)
   Err.Clear
End Property


'   //  <Metodo Tipo = Propetiedad Acceso=Publico>
'   //      <Objetivo>
'   //          *   Obtiene una Hoja de libro segun los criterios.
'   //      </Objetivo>
'   //      <Evaluaciones>
'   //          *   Si no existen Libros se crea uno nuevo.
'   //          *   Si no existen Hojas se crea una nueva en el libro.
'   //          *   Si no se ingresa ningun parametro Opcional se crea un nuevo Libro, y Hoja son devueltos.
'   //      </Evaluaciones>
'   //      <Parametros>
'   //          <Opcional Nombre=Index& Datotipo=Long Predeterminado=-1>
'   //              indice de la Hoja a buscar!¡.
'   //              Si el parametro es superior a la cantidad de hojas en el libro o si es negativo
'   //              Creara una nueva Hoja.
'   //          </Opcional>
'   //          <Opcional Nombre=Book Datotipo=Object Predeterminado=Nothing>
'   //              Indica el libro donde se buscada, si se deja {Nothing} creara uno nuevo
'   //              y en el parametro {index&} devolvera la posicion de la hoja.
'   //          </Opcional>
'   //      </Parametros>
'   //      <Return Tipo=Object Parcial=Workbook>
'   //          Regresa la Hoja {Worksheets} Indicada.
'   //          Parametro {Book}    Regresa el libro en dado caso que no se aya indicado alguno.
'   //          PArametro {Index&}  Regresa el index de la hoja en el libro indicado en el parametro {Book}, igual si fuese Creado.
'   //          Regresa el
'   //      </Return>
'   //  </Metodo>
Public Property Get Hoja(Optional ByRef Index& = -1, Optional ByRef Book As Object = Nothing) As Object
On Error GoTo EventoError
Dim Lng_IndexLibro&
Dim Lng_IndexHoja&

   If Book Is Nothing Then
       Set Book = Libro(Index&)
   End If
   If Index& <= 0 Then
       Set Hoja = Book.Worksheets.Add
       Index& = Book.Worksheets.Count
   Else
       With Book
           If .Worksheets.Count < Index& Then
               Index& = .Worksheets.Count
           End If
           Set Hoja = .Worksheets(Index&)
       End With
   End If
   
Exit Property
EventoError:
   RaiseEvent Errores(Err)
   Err.Clear
End Property
Rem End Propiedades.





Rem Eventos de Modulo de Clase.

'   //  <Metodo Tipo=Proceso Acceso=Local>
'   //      <Objetivo>
'   //          *   Crea la instancia de la aplicacion!¡..
'   //      </Objetivo>
'   //  </Metodo>
Private Sub Class_Initialize()
On Error GoTo EventoError
   Set Obj_Excel = CreateObject("Excel.Application")
Exit Sub
EventoError:
   RaiseEvent Errores(Err)
   Err.Clear
End Sub

'   //  <Metodo Tipo=Proceso Acceso=Local>
'   //      <Objetivo>
'   //          *   Liberacion de Memoria.
'   //      </Objetivo>
'   //      <Evaluaciones>
'   //          *   Si hay libros abiertos o cargado los descarga.
'   //          *   Si existe la instancia de la aplicacion la clierra
'   //      </Evaluaciones>
'   //  </Metodo>
Private Sub Class_Terminate()
On Error Resume Next
Dim Lng_IndexLibro&

   With Excel
       For Lng_IndexLibro& = 1 To .Worksheets.Count
           .Worksheets(Lng_IndexLibro&).Close
           Set .Libro = Nothing
       Next
   End With
   
   If Not Obj_Excel Is Nothing Then
       Call Obj_Excel.Quit
       Set Obj_Excel = Nothing
   End If
   Err.Clear
End Sub
Rem End Eventos de Modulo de Clase.



Ejemplo!¡.

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                 //
'   /////////////////////////////////////////////////////////////
'   //                                                         //
'   //            Ejemplo: Cls_ExcelAplication.cls             //
'   //                                                         //
'   /////////////////////////////////////////////////////////////
'
Option Explicit

Private WithEvents InstanciaExcel   As Cls_ExcelAplication      '   //  Solo para controlar Errores xP!¡.

Private Sub Form_Load()
'Dim InstanciaExcel                  As Cls_ExcelAplication     '   //  Declaracion Recomendada!¡.
Dim Obj_Hoja                        As Object
Const SaveOn$ = "c:\BlackZeroX.xls"
   Set InstanciaExcel = New Cls_ExcelAplication
   With InstanciaExcel
       Set Obj_Hoja = .Hoja                                    '   //  Creamos una libro y hoja
       Obj_Hoja.cells(1, 1) = "BlackZeroX"
       Obj_Hoja.cells(2, 1) = "Http://InfrAngeluX.sytes.net"
       Obj_Hoja.cells(3, 1) = "Dulce Infierno Lunar!¡."
       .Libro(, Obj_Hoja).Close True, SaveOn$                  '   //  Guardamos.
       Set Obj_Hoja = Nothing                                  '   //  Terminamos la instancia!¡.
   End With
   Set InstanciaExcel = Nothing
   Call vbShell(SaveOn$, False)
End Sub
Public Function vbShell(StrPath As String, Optional ByVal hHiden As Boolean = False) As Boolean
Dim ret                     As Object
   Set ret = CreateObject("Shell.Application", "")
   vbShell = Not ret Is Nothing
   If Not ret Is Nothing And CBool(Dir(StrPath) <> "") Then
       Call ret.ShellExecute(StrPath, "", "", "open", Abs(Not hHiden))
       Set ret = Nothing
   End If
End Function


Private Sub InstanciaExcel_Errores(ByRef Err As ErrObject)
   Call DebugerVB(Err)
End Sub
Private Sub DebugerVB(ByRef Err As ErrObject)
   With Err
       Debug.Print ""
       Debug.Print String$(30, "-")
       Debug.Print "Source:"; .Source
       Debug.Print "Number:"; .Number
       Debug.Print "Description:"; .Description
       Debug.Print String$(30, "-")
       Debug.Print ""
   End With
End Sub



Dulce Infierno Lunar!¡.

buena sbueno me llamo la atencion aumentar la velocidad de mi procesador tengo un:

Procesador
AMD Athlon 64 LE-1600
MainBoard
Gigabyte modelo M61PME-S2

Esta algo feo realmente pero bueno!¡.

La cosa que use el EasyTune 6 para realizarle un OC pero la pestaña Tuner ( OC/CverClocking ) me aparece desabilitada. y se diran porque rayos usas un soft para eso, bueno la cosa es que en la Bios de mi MainBoard no viene la opcion para el ( OC/OverClocking ), y pues como en el manual de la MainBoard venia lo del EasyTuner pues... opte por este como unico canal!¡.

La verdad no tengo experiencia alguna con este!¡.

Alguien sabe como rallos le hago el OC al procesador ya mensionado? con la MainBoard que tengo.

P.D.: Acabe de actualizar mi Bios de la MainBoard y aun no aparece la opcion del OverClocking, Tengo Windows 7

Dulce Infierno Luanr!¡.