Mensajes

No sera que la imagen ya esta a 640x480?
Yo en las pruebas cargaba una imagen de 217x173 y despues de procesarla la guardaba con:
SavePicture Picture1, "Resultado.bmp"
y me guardaba un bmp a 640x480.
Sobre el color y demas no se, pero la resolucion si la cambiaba.

Saludos

El millon seran las incognitas que tiene sobre basic

Aqui os dejo una solucion (o eso creo) en VB6. No sera la mas rápida pero parece que cumple su cometido.
Hace 6 años estuve experimentando con esto (por gusto) y consegui hacer una busqueda de combinaciones ordenadas (sin repeticiones).

En principio solo podias pedir grupos de N numeros, usando los numeros del 1 al X. Siempre desde el 1 en adelante.
Con un pequeño cambio que se me ha ocurrido mientras lo revisaba, ahora puedes pedir grupos de N numeros, usando los numeros de una lista, vayan seguidos o no, y esten ordenados o no lo esten.
Vamos, que ahora admite cualquier cosa.
De hecho puedes usar palabras en lugar de numeros, y se crearan todas las combinaciones posibles (siempre sin repeticiones).
El resultado lo devuelve en una matriz de cadena.

En fin, solo necesita un form con un listbox y un commandbutton.
Echad un ojo al command1 para ver como se usa y yasta.
Dejo los comentarios que puse en su dia por si os sirven de algo (a mi me dejan loco )

Código [Seleccionar] Expandir


Option Explicit

Dim Parar As Integer

Private Sub Form_Load()
 Parar = 1
End Sub

Private Sub Command1_Click()
 On Local Error Resume Next
 If Parar = 0 Then Parar = 1: Exit Sub

 ' valores a insertar
 Static TamGrupos As Integer ' Tamaño de los grupos
 Static ListaDeNumeros As String ' lista de numeros separados por comas
 If ListaDeNumeros = "" Then ListaDeNumeros = "1,18,23,24,28,35,47"
 If TamGrupos = 0 Then TamGrupos = 3
 ' podemos pedirselos al usuario:
 Dim Respuesta As String
 Respuesta = InputBox("¿Que tamaño deben tener los grupos?", "Tamaño Grupos", TamGrupos)
 If Val(Respuesta) > 0 Then TamGrupos = Respuesta
 Respuesta = InputBox("¿Que números quieres usar? (uno o varios números separados por comas)", "Lista de números", ListaDeNumeros)
 If InStr(1, Respuesta, ",") Or Val(Respuesta) > 0 Then ListaDeNumeros = Respuesta
 
 Dim Matriz() As String ' matriz donde recibiremos la lista
 CreaGrupos TamGrupos, ListaDeNumeros, Matriz
 
 'Aqui manipulas la matriz como quieras
 ' por ejemplo pasandola a un listbox
 List1.Clear
 List1.Visible = False
 Dim F As Long
 For F = 0 To UBound(Matriz)
   List1.AddItem Matriz(F)
   DoEvents
 Next F
 List1.Visible = True

End Sub


Private Function CalculaTotal(ByVal TamGrupos As Integer, ByVal MaximoValor As Integer)' As Long
 Dim C1 As Double
 Dim C2 As Double
 Dim F As Double
 On Local Error Resume Next
 C1 = 1
 C2 = 1
 For F = 1 To TamGrupos
    C1 = C1 * F
 Next F

 For F = MaximoValor To (MaximoValor - (TamGrupos - 1)) Step -1
    C2 = C2 * F
 Next F
 CalculaTotal = C2 / C1

End Function


Private Sub CreaGrupos(ByVal TamGrupos As Integer, ByVal TopeOListaDeNumerosSeparadosPorComas As String, ByRef ListaDevuelta() As String)
' Busqueda de combinaciones.
' Dados los numeros de TopeOListaDeNumerosSeparadosPorComas,
' saca todos los grupos no repetidos de "TamGrupos" numeros
' y los devuelve en la matriz Lista()
' Por repetido se entiende que "1,2,3" es igual que "1,3,2", igual que "2,1,3", etc...
' Ejm: 1,2,3,4 de 2 en 2 = 6 combinaciones
' 1,2 - 1,3 - 1,4 - 2,3 - 2,4 - 3,4
' Opcionalmente, en lugar de una lista de números puedes poner un solo número.
' En ese caso la listadenumeros seran los números desde el 1 hasta el que pongas.

 Dim F As Double
 Dim Linea As String
 Dim Num As Double
 Dim Total As Double
 Dim Ap() As Double
 Dim MaximoValor As Long

 Dim MatrizDeNumeros() As String
 On Local Error Resume Next
 MatrizDeNumeros = Split(TopeOListaDeNumerosSeparadosPorComas, ",")
 MaximoValor = UBound(MatrizDeNumeros) + 1

 If TamGrupos < 1 Then
   MsgBox "Los grupos deben tener al menos un elemento."
   GoTo Fin
 End If
 
 If MaximoValor = 1 And Val(MatrizDeNumeros(0)) > 0 Then
   MaximoValor = Val(MatrizDeNumeros(0))
   ReDim MatrizDeNumeros(MaximoValor - 1)
   For F = 1 To MaximoValor
     MatrizDeNumeros(F - 1) = F
   Next F
 End If
 
 If MaximoValor < 1 Or TamGrupos > MaximoValor Then
   MsgBox "Tiene que haber al menos " & TamGrupos & " valores en TopeOListaDeNumerosSeparadosPorComas"
   GoTo Fin
 End If
 
 Total = CalculaTotal(TamGrupos, MaximoValor)
 
 ReDim Ap(TamGrupos)
 
 ReDim ListaDevuelta(Total - 1) As String
 Dim Contador As Long
 Contador = -1
 
 Parar = 0

' Cogemos las primeras
 For F = 1 To TamGrupos
   Ap(F) = F
 Next F
 
OtraVez:
 'Preparo la linea con la combinacion
 Linea = ""
 For F = 1 To TamGrupos - 1
   Linea = Linea & MatrizDeNumeros(Ap(F) - 1) & " , "
 Next F
 Linea = Linea & MatrizDeNumeros(Ap(TamGrupos) - 1)
 
 ' Guardo la combiancion
 Contador = Contador + 1
 ListaDevuelta(Contador) = Linea
 
 'Label4.Caption = Contador + 1 ' Muestro el progreso
 
 DoEvents
 If Parar = 1 Then GoTo Fin

 Num = TamGrupos + 1

Repetir1:
 Num = Num - 1  ' Cogemos la apuesta(num) (en principio la ultima)
 
'La aumentamos...
 Ap(Num) = Ap(Num) + 1
 
 ' si es mayor de la cuenta...
 If Ap(Num) > (MaximoValor - (TamGrupos - Num)) Then
   
   ' si es la ap(1) se acaba
   If Num = 1 Then GoTo Fin
   
   ' ...aumentamos la anterior
   GoTo Repetir1
 End If

' Si no llega a su limite se mira si alguna ha llegado
' a su maximo
' Si NUM no apunta a la ultima AP() es que
' alguna ap() ha llegado a su maximo
 ' entonces reiniciamos todas las siguientes...
 If Num <> TamGrupos Then
   For F = Num + 1 To TamGrupos
     '....dandoles el valor de la anterior + 1...
     Ap(F) = Ap(F - 1) + 1
   Next F
 End If
   
 ' ... Y se da por valida
 GoTo OtraVez

Fin:
 Parar = 1
 
End Sub



Saludos

No tengo mucha idea sobre imagenes, y no se ni como funciona esto, pero si no tienes otra opcion puedes probarlo:

Código (vb) [Seleccionar] Expandir


Option Explicit

Private Sub Command1_Click()
 Picture1.Width = 644 * Screen.TwipsPerPixelX
 Picture1.Height = 484 * Screen.TwipsPerPixelY
 ResizePicture1
 Picture1.Picture = Picture1.Image
End Sub

Private Sub Form_Load()
 Picture1.ScaleMode = vbPixels
 Picture2.Visible = False
 Picture1.Picture = LoadPicture("Imagen.bmp")
End Sub

Sub ResizePicture1()
 Picture2.ScaleMode = vbTwips
 Picture2.AutoSize = True
 Picture2.Picture = Picture1.Picture
 Picture1.AutoRedraw = True
 Picture1.PaintPicture Picture2.Picture, 0, 0, Picture1.ScaleWidth * Screen.TwipsPerPixelX, Picture1.ScaleHeight * Screen.TwipsPerPixelY, _
 0, 0, Picture2.ScaleWidth, Picture2.ScaleHeight
End Sub


Dos pictures y un boton.
El boton pasa el picture1 a 640 x 480 (al menos en mi pc  )

Saludos

Es una buena idea, pero podriais corregir los fallos gordos, que aqui dejan editar

Una sub? mas bien no

Código [Seleccionar] Expandir


Private Sub lIsNegative(ByRef lVal As Long)

   '   //  Para cualquier valor que lVal pueda tomar.

   '   //  Comprueba si lval es negativo.

   lIsNegative = (lVal And &H80000000)

End Sub


Una Sub con End Function?

Código [Seleccionar] Expandir


Private sub ColorLongToRGB(ByVal LngColor As Long, ByRef OutRed As Byte, ByRef OutGreen As Byte, ByRef OutBlue As Byte)

  OutBlue = (LngColor And &HFF0000) \ &H10000

  OutGreen = (LngColor And &HFF00&) \ &H100

  OutRed = (LngColor And &HFF)

End Function


Saludos

EDIT:

Para que veais que no solo me gusta criticar, aprovecho para dejaros mi version super cutre de los operadores And, Or, Xor y Not.
Es muy rustica pero no contiene ni un And, Or, Xor, Not y parece funcionar con positivos, negativos y mezclas y ya de paso incluye las conversiones Bin2Hex, Hex2Bin, etc...

Código (vb) [Seleccionar] Expandir


Private Function OrAlt(ByVal Valor1 As Long, ByVal Valor2 As Long) As Long
 Dim V1 As String
 Dim V2 As String
 V1 = Dec2Bin(Valor1)
 V2 = Dec2Bin(Valor2)
 
 Dim UnBit As String
 Dim Res As String
 Dim F As Integer
 For F = 1 To Len(V1)
   UnBit = "0"
   If Mid(V1, F, 1) = 1 Then UnBit = "1"
   If Mid(V2, F, 1) = 1 Then UnBit = "1"
   Res = Res & UnBit
 Next F
 
 OrAlt = Bin2Dec(Res)

End Function

Private Function AndAlt(ByVal Valor1 As Long, ByVal Valor2 As Long) As Long
 Dim V1 As String
 Dim V2 As String
 V1 = Dec2Bin(Valor1)
 V2 = Dec2Bin(Valor2)
 
 Dim UnBit As String
 Dim CuentaOK As Integer
 Dim Res As String
 Dim F As Integer
 For F = 1 To Len(V1)
   CuentaOK = 0
   UnBit = "0"
   If Mid(V1, F, 1) = 1 Then CuentaOK = CuentaOK + 1
   If Mid(V2, F, 1) = 1 Then CuentaOK = CuentaOK + 1
   If CuentaOK = 2 Then UnBit = "1"
   Res = Res & UnBit
 Next F
 
 AndAlt = Bin2Dec(Res)

End Function

Private Function XorAlt(ByVal Valor1 As Long, ByVal Valor2 As Long) As Long
 Dim V1 As String
 Dim V2 As String
 V1 = Dec2Bin(Valor1)
 V2 = Dec2Bin(Valor2)
 
 Dim UnBit As String
 Dim CuentaOK As Integer
 Dim Res As String
 Dim F As Integer
 For F = 1 To Len(V1)
   CuentaOK = 0
   UnBit = "0"
   If Mid(V1, F, 1) = 1 Then CuentaOK = CuentaOK + 1
   If Mid(V2, F, 1) = 1 Then CuentaOK = CuentaOK + 1
   If CuentaOK = 1 Then UnBit = "1"
   Res = Res & UnBit
 Next F
 
 XorAlt = Bin2Dec(Res)

End Function

Private Function NotAlt(ByVal Valor1 As Long) As Long
 Dim V1 As String
 Dim V2 As String
 V1 = Dec2Bin(Valor1)
 
 Dim UnBit As String
 Dim Res As String
 Dim F As Integer
 For F = 1 To Len(V1)
   If Mid(V1, F, 1) = "1" Then
     UnBit = "0"
   Else
     UnBit = "1"
   End If
   Res = Res & UnBit
 Next F
 
 NotAlt = Bin2Dec(Res)

End Function

Function Bin2Dec(ByVal sBinario As String) As Long
 'Bin2Dec = CDec("&H" & Bin2Hex(sBinario)) 'no hace falta el cdec :O
 Bin2Dec = "&H" & Bin2Hex(sBinario)
End Function

Public Function Dec2Bin(ByVal Valor As Long, Optional MinBits As Integer = 32) As String
 Dec2Bin = Hex2Bin(Hex$(Valor))
 Do Until Len(Dec2Bin) >= MinBits
   Dec2Bin = "0" & Dec2Bin
 Loop
End Function

Function Bin2Hex(ByVal StrBin As String) As String
 Dim F As Long

 Do Until Len(StrBin) / 4 = Len(StrBin) \ 4
   StrBin = "0" & StrBin
 Loop
 For F = Len(StrBin) - 3 To 1 Step -4
   
   Select Case Mid$(StrBin, F, 4)
     Case "0000"
       Bin2Hex = "0" & Bin2Hex
     Case "0001"
       Bin2Hex = "1" & Bin2Hex
     Case "0010"
       Bin2Hex = "2" & Bin2Hex
     Case "0011"
       Bin2Hex = "3" & Bin2Hex
     Case "0100"
       Bin2Hex = "4" & Bin2Hex
     Case "0101"
       Bin2Hex = "5" & Bin2Hex
     Case "0110"
       Bin2Hex = "6" & Bin2Hex
     Case "0111"
       Bin2Hex = "7" & Bin2Hex
     Case "1000"
       Bin2Hex = "8" & Bin2Hex
     Case "1001"
       Bin2Hex = "9" & Bin2Hex
     Case "1010"
       Bin2Hex = "A" & Bin2Hex
     Case "1011"
       Bin2Hex = "B" & Bin2Hex
     Case "1100"
       Bin2Hex = "C" & Bin2Hex
     Case "1101"
       Bin2Hex = "D" & Bin2Hex
     Case "1110"
       Bin2Hex = "E" & Bin2Hex
     Case "1111"
       Bin2Hex = "F" & Bin2Hex
 
   End Select
 Next F
 
End Function

Function Hex2Bin(ByVal CadenaHexadecimal As String) As String
 Dim F As Long
 
 CadenaHexadecimal = UCase(CadenaHexadecimal)
 
 If Len(CadenaHexadecimal) > 0 Then
   For F = Len(CadenaHexadecimal) To 1 Step -1
     Select Case Mid$(CadenaHexadecimal, F, 1)
       Case "0":
         Hex2Bin = "0000" & Hex2Bin
       Case "1":
         Hex2Bin = "0001" & Hex2Bin
       Case "2":
         Hex2Bin = "0010" & Hex2Bin
       Case "3":
         Hex2Bin = "0011" & Hex2Bin
       Case "4":
         Hex2Bin = "0100" & Hex2Bin
       Case "5":
         Hex2Bin = "0101" & Hex2Bin
       Case "6":
         Hex2Bin = "0110" & Hex2Bin
       Case "7":
         Hex2Bin = "0111" & Hex2Bin
       Case "8":
         Hex2Bin = "1000" & Hex2Bin
       Case "9":
         Hex2Bin = "1001" & Hex2Bin
       Case "A":
         Hex2Bin = "1010" & Hex2Bin
       Case "B":
         Hex2Bin = "1011" & Hex2Bin
       Case "C":
         Hex2Bin = "1100" & Hex2Bin
       Case "D":
         Hex2Bin = "1101" & Hex2Bin
       Case "E":
         Hex2Bin = "1110" & Hex2Bin
       Case "F":
         Hex2Bin = "1111" & Hex2Bin
     End Select
   
   Next F
 End If
 On Local Error GoTo 0
End Function


Saludos.

Alguien tiene este tutorial en pdf¿

Si te refieres a este mismo, no se si habra descarga, pero como no tenia nada que hacer y por si te corre prisa te he pasado a pdf la primera pagina de este tema con el curso completo.

http://ge.tt/91cmdcF2/v/0

Saludos

Hola Mad Antrax. Gracias por contestar.
La verdad es que de momento he aparcado un poco lo del CE.
Despues de sacar unos trainers de Flash con busquedas aob, (por cierto, vi tu script, pero tengo desactivados los scripts vb y preferia algo mas comodo, y creo que me quedo bastante bien), y viendo que es facil que no funcionen por haber algun valor que no has filtrado, empece con los cambios de codigo.
Al no ser capaz de descifrar todo el ASM lo deje y empece a experimentar buscando las variables Flash con SWF Decompiler y modificandolas con el reproductor que hice en VB, añadiendo a este listas de variables que puedes fijar o leer continuamente (inspirado por CE).
Despues vi que muchas veces no encuentro variables o las que encuentro no devuelven valores ni afecta que las cambies, (algunos juegos si ).
Entonces empece con el curso de Olly de Ricardo Narvaja, y despues de 4 o 5 capitulos pense mejorar mi lector de textos para que admitiera textos con imagenes, y asi segun lo escuchas, ves lo que esta leyendo y la imagen a que se esta refiriendo el tema.
Asi que me he tirado una semanita entre que deducia como son los rtf por dentro y como capturarlos, pegarlos, juntar las lineas para que no haga pausas raras y guardarlos (desde varias paginas separadas) a un fichero .rtf. Algo bastante complicado, por cierto, ya que un solo capitulo del curso, en formato rtf, ocupa de 40MB en adelante, y cada vez que manipulas el textbox se congela el programa hasta que procesa los 40MB.
Anoche buscando una cosa por curiosidad encontre por fin un manual de rtf, je, espero no necesitarlo ya, porque esta en ingles y mi lector no traduce  (de momento).
Por fin creo que ha quedado mas o menos bien, asi que ahora solo tengo que ir pasando a rtf los doc del tuto y ¡a aprender! (aunque creo que me falta memoria).
En fin, como ves, intento no aburrirme.
Cuando vuelva al CE (si no me lio con otra burrada) ya me pasare con las dudas, aunque ya ves que no se me da mal experimentar Lo peor que llevo es que olvido enseguida casi todo lo que aprendo y tengo que aprenderlo de nuevo cada vez Sera por eso que he aprendido a buscarme la vidilla

Un saludo a todos y que lo lleveis "bonito" (como decia uno que conoci).

EDIT;
Nuevo record. 1,30 horas y ya traduce al español con auto-deteccion de idioma de origen.
Te lo juro, no me beso porque no me llego.
Ves el texto en ingles y lo escuchas en español. Se sale.
Igual hasta le pongo que elijas el idioma de destino, pero de momento solo lo uso yo, asi que se qieda en spanish

Hola. Enhorabuena por los tutoriales.
Estoy disfrutando bastante con esto de los trainers.
Como todos aqui tengo mis preguntas, pero intentare limitarme a preguntas tecnicas.

Para empezar solo quiero preguntar un par de cosas que me estan martirizando.

¿Hay algun modo en el visor de pasar de la ventana de ensamblador a la misma direccion de la ventana de HEX y al contrario sin escribirlo a mano?
A veces tampoco aparece la direccion de memoria en el ensamblador, sino programa.exe+D0F23... y tienes que andar buscando.
Hay un copy que copia de todo menos la direccion real

Igualmente, cuando tengo en la lista del CE una direccion, solo puedo ver quien escribe o el HEX, no puedo ver el ensamblador de esa direccion, que a veces es codigo y que tambien a veces es resultado de una busqueda y no aparece la direccion para copiarla y te toca escribir.
Eso se arreglaria si pudieras ir del HEX a la misma direccion en el visor de ASM (pregunta anterior).

Saludos

EDIT:
Jo, no hay como preguntar algo para dar con ello de golpe.

Ya se al menos copiar la direccion del HEX para llevarla al visor de ensamblador.
Pinchas el byte de inicio y eliges goto address para copiar de ahi la direccion.

A ver si alguien sabe como hacerlo en el visor de ASM cuando ni siquiera es una direccion completa.

EDIT2:

Voy a tener que dejar de preguntar
O quizas a alguien le vengan bien mis deliberaciones.

Para copiar la direccion real desde el visor ASM para llevarla al de HEX es igual que lo otro
Pinchas la instruccion, eliges goto address y te muestra esa misma direccion y en modo real.
La copias y la pegas en el visor de HEX.

Siento las molestias si las hubiere.

Saludos

EDIT3:

Ya puestos a informar sobre encontrar codigo, para los novatos como yo, algo que acabo de notar:
Cuando encuentras un codigo y sabes que es el bueno, o quieres guardar la direccion por si acaso, lo mas comodo es pinchar con el boton derecho y en "replace whit code that does nothing". Eso cambia el codigo por "no operacion".
Luego lo restauras con "restore with original code".
Automaticamente te guarda la direccion de modo que puedes ir cuando quieras cada vez que cargues el proyecto, con solo pinchar abajo del todo en "Advanced Options" y elegir ahi la direccion que encontraste, que puedes hasta renombrar para reconocerla.
Claro, solo funciona con direcciones fijas (Programa.exe+XXXXXX)

Son detalles que a veces cuesta notar y que suavizan la experiencia... que me lo digan a mi

Mas saludos

La versión 6.2 (que es la que tengo) ya tenía el Easter Egg... 

Tambien la probe, la 6.2, la 6.3 y la 6.4 y todas igual, quizas deberia haber supuesto algo como una broma, pero nunca me habia pasado algo asi.

Por cierto, ¿por que las fuentes no se dejan descomprimir? no es que vaya a instalar delphi ni que recuerde ya nada de pascal, pero soy muy curioso.

Pues esta probado. Si uso cualquier otra fecha futura o pasada arranca normalmente

Mira que son bromistas.  

EDIT: Aun me estoy riendo
Menos mal que no he dicho nada en la pagina oficial, debe estar atascada.

Gracias por sacarme del error engel lex