elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Tutorial básico de Quickjs


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  Alguien sabe como conseguir esto
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: 1 2 [3] 4 Ir Abajo Respuesta Imprimir
Autor Tema: Alguien sabe como conseguir esto  (Leído 4,815 veces)
Fran1946

Desconectado Desconectado

Mensajes: 56


Ver Perfil
Re: Alguien sabe como conseguir esto
« Respuesta #20 en: 6 Febrero 2020, 10:42 am »

Citar
Te pongo un código de ejemplo que soluciona el caso, mediante una simple API...
Y luego una imagen... nota que la imagen es una captura de tu mensaje, pero el nombre de la imagen es el mismo que tu tienes ahí arriba y nota como la imagen se carga perfectamente con este modo...

Otros problemas que tengas con los picturebox, se pueden ir viendo, si describes el problema en cuestión.

Hola NEBIRE:

Gracias por tu ayuda.
Efectivamente este código soluciona el problema.
Y esto me sugiere que podría volver a utilizar un PictureBox como visor...
Pero necesito un código para poder hacer zoom con la rueda del ratón, y poder mover la imagen con zoom pulsando el botón Iqdo del ratón y mover.

Tengo código para mover imagen pero con scroll H-V, y esto no me gusta nada, es muy limitado e incómodo.
Y tengo código de Lupa pero en una ventana externa, no ampliando imagen en el Picture.

Puedes ayudarme en esto, sería perfecto.

Por que con esta solución solucionaría el problema de que el usuario pueda pulsar botón dcho y acceder a los menues que permiten hacer lo mismo que yo inhabilito.

Por que la solución que me dio FJDA  de inhabilitar la ventana de la imagen
Código:
Call EnableWindow(hPhotos_PhotoCanvas, vbFalse)

Funciona, pero inutiliza poder hacer zoom y mover la imagen, es lógico, pero esto no me sirve.


« Última modificación: 6 Febrero 2020, 10:44 am por Fran1946 » En línea

Fran1946

Desconectado Desconectado

Mensajes: 56


Ver Perfil
Re: Alguien sabe como conseguir esto
« Respuesta #21 en: 6 Febrero 2020, 10:44 am »

a ver, esto lo que hace es inhabilitar la ventana Photos_PhotoCanvas que contiene la imagen. De este modo no se puede usar el ratón (solo en Photos_PhotoCanvas)

Pues lo siento pero inutiliza poder hacer zoom y mover la imagen, es lógico, pero esto no me sirve.

Gracias.


En línea

FJDA

Desconectado Desconectado

Mensajes: 242


Ver Perfil
Re: Alguien sabe como conseguir esto
« Respuesta #22 en: 6 Febrero 2020, 11:07 am »

Escribe "mouse wheel picturebox vb6" en google.

Acostúmbrate a buscar info en inglés porque la mayoría de las cosas están en inglés


https://www.recursosvisualbasic.com.ar/htm/listado-api/215-usar-rueda-del-mouse-en-flexgrid-datagrid.htm

Mírate la sección: "Ejemplo 4 - Ejemplo para usar la rueda del mouse en controles Scrollbar"

puedes descargar el código en la página



Nota: No te va a hacer zoom pero cambiando los parámentros puedes hacer que te haga zoom.

En cualquier buscador puedes encontrar un buen montón de ejemplos, es una de las cosas más demandadas, por principiantes; hacer zoom, redimiensonar, mover el scrolll, voltear, usar el wheel  etc.




Aquí tienes para el zoom
https://www.recursosvisualbasic.com.ar/htm/listado-api/71-zoom-imagen-stretchbit.htm




mas cosas aquí como hacer una lupa

Código
  1. Dim StartX As Single, StartY As Single
  2.  
  3. Private Sub Form_Activate()
  4.    MousePointer = 11
  5.    Picture2.PaintPicture Form1.Picture, 0, 0
  6.    Picture1.PaintPicture Picture2.Image, -20, -20, Picture1.Width + 100, Picture1.Height + 100, _
  7.    Picture1.Left, Picture1.Top, Picture1.Width, Picture1.Height
  8.    Picture1.Line (0, 0)-(Picture1.Width - 1, Picture1.Height - 1), 0, B
  9.    MousePointer = 0
  10. End Sub
  11. Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  12.    StartX = X
  13.    StartY = Y
  14.    Picture1.AutoRedraw = False
  15. End Sub
  16.  
  17. Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  18.    If Button = 1 Then
  19.        Picture1.Left = IIf(X < StartX, Picture1.Left - (StartX - X), Picture1.Left + (X - StartX))
  20.        Picture1.Top = IIf(Y < StartY, Picture1.Top - (StartY - Y), Picture1.Top + (Y - StartY))
  21.  
  22.        Picture1.PaintPicture Picture2.Image, -20, -20, Picture1.Width + 100, Picture1.Height + 100, _
  23.        Picture1.Left, Picture1.Top, Picture1.Width, Picture1.Height
  24.        Picture1.Line (0, 0)-(Picture1.Width - 1, Picture1.Height - 1), 0, B
  25.    End If
  26. End Sub
  27.  
  28. Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  29.    Picture1.AutoRedraw = True
  30. End Sub
  31.  
  32.  

https://mega.nz/#!6N0lAQDJ!dkAZKkUnQxmX9xS7ZF6Kz-fnQdb1O1-TES9kaB3w9so




62 - Redimensionar imágenes en un PictureBox al estilo Vista previa de imagen





En este enlace un buen montón de códigos para tratamiento de imágenes.


https://onedrive.live.com/?authkey=%21AGLMrn20g0JGtX0&id=C9DBA2BC5A16373B%21115&cid=C9DBA2BC5A16373B

« Última modificación: 6 Febrero 2020, 12:02 pm por FJDA » En línea

Serapis
Colaborador
***
Desconectado Desconectado

Mensajes: 2.693


Ver Perfil
Re: Alguien sabe como conseguir esto
« Respuesta #23 en: 6 Febrero 2020, 16:30 pm »

...Efectivamente este código soluciona el problema.
Y esto me sugiere que podría volver a utilizar un PictureBox como visor...
Pero necesito un código para poder hacer zoom con la rueda del ratón, y poder mover la imagen con zoom pulsando el botón Iqdo del ratón y mover.

Y tengo código de Lupa pero en una ventana externa, no ampliando imagen en el Picture.

Puedes ayudarme en esto, sería perfecto.

Vayamos por partes...

Para el zoom, basta una lupa...

He desempolvado un viejo control de usuario, le he retirado cosas que lo harían complicado (otros controles que no vienen al caso), hasta dejarlo en su más simple expresión... y puesto en un proyecto de prueba, para que trastees las propiedades y veas que tal va y si te satisface así.
(nota que el proyecto a falta de conocer donde tienes imágenes las toma de %windir% \web\wallpaper\*.jpg tu podrías suplirlo con una ruta alternativa si te place o no tienes localizada dicha ruta)
Las propiedades básicamente son:
- Aumento: 0'04 hasta 4'00 (admite dos decimales).
- AnchoExplora: Píxeles  de ancho captura
- AltoExplora: Píxeles de alto que captura
(las medidas de la lupa resultan de la multiplicación de estos valores por el zoom).
- ModoRastreo: Normal/Invertido (invertido es en negativo).
El resto de funcionalidad ya la ves sobre el propio proyecto.... Basta una lupa para múltiples ventanas, si fuera el caso. Se incluye un segundo form, sin controles que 'toma prestado la lupa' del primario, para examinar el asunto.

Descarga del control y el proyecto de prueba: https://workupload.com/file/8jaeBw22
Y una simple captura de pantalla (dado que la lupa si no se mueve en una imagen estática puede pasar desapercibida, he activado el modo inverso, antes de hace rla captura):


Si no termina de gustarte, hay muchas lupas por la red que puedas probar y usar... seguramente en foros como:
-www.planet-source-code.com
-www.vbforums.com
-www.freevbcode.com
-forums.codeguru.com
-www.recursosvisualbasic.com.ar
-www.vb-helper.com
-etc, etc...

Solventa lo de la lupa, y luego expones el siguiente problema que tengas...
En línea

Fran1946

Desconectado Desconectado

Mensajes: 56


Ver Perfil
Re: Alguien sabe como conseguir esto
« Respuesta #24 en: 6 Febrero 2020, 19:43 pm »




Hola NEBIRE:

Pues yo da daba por supuesto que el código que me pasaste, solucionaba el asunto de los nombres raros, pero como yo parece que tengo archivos jpg con nombres que nadie tiene, pues las pruebas hasta ahora me reconocía todos, pues recorriendo las carpetas escaneadas por el programa, me encuentro una que no tiene archivos jpg, pero si los tiene, solo que el programa al encontrarlos (son 3) no los añade a la lista dcha azul, por que los nombres no son válidos, tu código devuelve "" vacío.
Pero estos 3 jpg se visualizan perfectamente en el visor de Win clicados en su carpeta.

Mira las imágenes del programa y de la ruta de los 3 archivos.
Estos nombre son estos:
Výstřižek1.JPG
Výstřižek3.JPG
Výstřižek4l.JPG

Y nombres chinos si los acepta, no lo entiendo.
Posiblemente me encuentre otros, es muy dificil chequearlso todos, tengo mas de 65000 imágenes jpg a procesar.
En línea

Fran1946

Desconectado Desconectado

Mensajes: 56


Ver Perfil
Re: Alguien sabe como conseguir esto
« Respuesta #25 en: 6 Febrero 2020, 19:46 pm »

Gracias tengo un código de lupa que usaba con el Picture, pero este me gusta, creo que es el mismo que me ha pasado FJDA

En línea

Serapis
Colaborador
***
Desconectado Desconectado

Mensajes: 2.693


Ver Perfil
Re: Alguien sabe como conseguir esto
« Respuesta #26 en: 7 Febrero 2020, 01:14 am »

OK... les hecho un vistazo a esos nombres parecen caracteres cirílicos...
He notado también que hay ficheros que pueden tener uno o más null al final del mismo, y si aparece al final, no los retira, ya que VB considera los BString que acaban en null, no considera el último en tanto sea 1 byte por carácter (ANSI)... así que aprovecho de darle un repaso ambos casos.

La lupa que he subido es totalmente hecho por mí, y salvo a mi sobrino que fue quien me lo pidió hace 10 o 12 años, no recuerdo haberlo compartido antes, luego debe tratarse de otra lupa distinta. De todos modos son códigos muy sencillos, pués básicamente son APIs BitBlt, copiando y pegando constantemente... pero que requiere sus líneas de código y no es plan copiar y pegar en cada proyecto...
Los controles de usuario resultan cómodos, porque una vez los compilas, los registras y usas y reutilizas donde haga falta con pocas líneas...
En línea

FJDA

Desconectado Desconectado

Mensajes: 242


Ver Perfil
Re: Alguien sabe como conseguir esto
« Respuesta #27 en: 7 Febrero 2020, 09:54 am »

La lupa que he subido es totalmente hecho por mí, y salvo a mi sobrino que fue quien me lo pidió hace 10 o 12 años, no recuerdo haberlo compartido antes, luego debe tratarse de otra lupa distinta.
aaah amigo tienes razón no son la misma lupa, la mía le da mil vueltas a la tuya  :xD
En línea

Serapis
Colaborador
***
Desconectado Desconectado

Mensajes: 2.693


Ver Perfil
Re: Alguien sabe como conseguir esto
« Respuesta #28 en: 7 Febrero 2020, 18:03 pm »

Mira las imágenes del programa y de la ruta de los 3 archivos.
Estos nombre son estos:
Výstřižek1.JPG
Výstřižek3.JPG
Výstřižek4l.JPG

Y nombres chinos si los acepta, no lo entiendo.
Esa r, definitivamente es un carácter checo...
Tienen solución, básicamente es la misma presentada... solicitar el 'shortname' del fichero, esto es, los antiguos nombres MS-DOS: "8.3"

Piensa que el modo de solventar problemas con caracteres es dejarlos aparte en lo posible y hacer referencia ello con algo ajeno a los caracteres explícitos, por ejemplo: un handle (una dirección de memoria), un índice en un array... así el contenido de dicho string, puede ser lo que sea, mientras no se 'toque' no hay conversión (errónea por truncamiento), que luego falle su referencia en una búsqueda posterior. Aún así he crerado una función que analiza los caracteres aún siendo disitntos en origen... es complicado explicar por qué funciona sin tener una base profunda del fundamento de los caracteres, codificación, la plataforma y el lenguaje de programación usado... de hecho mucha gente habrá tratado múltiples ideas y modificaciones sin resultados.

...pero como digo tiene solución, el caso previo se puede alojar en el nuevo sin distinción de cual de ellos se da, son pocas líneas más de código, sin embargo como dices que tienes varios miles de imágenes en la carpeta, no es muy eficiente que cada vez que se localice un fichero con un nombre así, deba recorrerse todo un array para tomar su shortname (el 8.3). Esto exige 3 cosas...

La primera repensarlo todo y rehacer una especie de 'fileCommonDialog' que al leer el contenido de una carpeta, tome el array de dichos ficheros, así luego puede referenciarse el mismo por su índice en el array...

La segunda cuestión es que dado que esos nombres 'raros', ralentizan innecesariamente su procesado una y otra vez, lo ideal es que cada vez que localice uno, lo renombre ... si lleva caracteres del 'primer tipo', eliminandolos, si lleva caracteres Unicode 'del segundo tipo',  truncarlos, lógicamente antes de ese renombrado se debería comprobar si el nombre a asignar existe ya o no, para decidir otro si ese está ocupado y que no falle el renombrado. Y por supuesto dicho renombrado sería un parámetro opcional. Aunque pueda parecer no necesario, ese renombrado posibilitaría que otros programas que tuvieren problemas con tales ficheros en tu equipo quedara resuelto (hacelro manulamente cuando son muchos es tedioso, claro). Y también habría que considerar que no todos los ficheros deben ser renombrables, los de librerías y aplicaciones podrían inutilizar la aplicación de la que son parte, por lo que debería limitarse a los 'documentos de usuarios' y eso cada uno sabe cuales son conforme a las carpetas que los mantiene en su equipo.

En fin crear un fileCommonDialog, son algo más que 4 líneas, y se sale un poco del tiempo que uno puede dedicar a ayudar a otros (otra cosa es cuando ya tienes uno montado de tiempo atrás)...
Si no te basta con la solución que te aporto a continación, pués con dicho código y el resto demis comentarios, tú mismo podrías montarte un FileCommonDialog para la ocasión... la clave para lograr todo esto es recurrir a al objeto FileSystemObject... que hay que añadirlo al proyecto como una referencia:

Y ahora el código:
(nota que excepto la función del mismo nombre el resto es añadido (a lo que ya te dí), la función 'ResuelveRuta' remplaza a la existente)...
Código
  1. ' previamente hay que añadir la referencia al proyecto de: FileSystemObject
  2. Private fso                             As New FileSystemObject
  3. Private fold                            As Folder
  4. Private f                               As File
  5.  
  6. ' 'primer' y 'segundo' tipo, es solo una connotación para la solución y el tiempo que lleva cada caso.
  7. Private Function ResuelveRuta(ByVal Ruta As String, Optional ByRef SegundoIntento As Boolean) As String
  8.    Dim k As Integer, j As Integer, fichero As String
  9.  
  10.    If Existe(Ruta) Then
  11.        k = InStrRev(Ruta, "\")
  12.        If (Left$(WFD.cAlternate, 1) <> Chr(0)) Then
  13.            ' Aqui CAZA: caracteres Unicode (del primer tipo) en el nombre del fichero.
  14.            j = InStr(WFD.cAlternate, Chr(0)) ' este campo tiene 14 caracteres, en nombres muy cortos, tipo 3.jpg, todavía podría haber caracteres null al final del mismo.
  15.            If (j > 0) Then
  16.                ResuelveRuta = Left$(Ruta, k) & Left$(WFD.cAlternate, j - 1)
  17.            Else
  18.                ResuelveRuta = Left$(Ruta, k) & WFD.cAlternate
  19.            End If
  20.        Else
  21.            ResuelveRuta = Ruta ' Left$(Ruta, k) & WFD.cFileName
  22.        End If
  23.    Else
  24.        If (SegundoIntento = False) Then
  25.            SegundoIntento = True
  26.            k = InStrRev(Ruta, "\")
  27.            j = Len(Ruta)
  28.            If (k < j) Then
  29.                ' Aqui CAZA: caracteres Unicode (del segundo tipo) en el nombre del fichero.
  30.                fichero = Right$(Ruta, j - k)
  31.                Set fold = fso.GetFolder(Left$(Ruta, k))
  32.                For Each f In fold.Files
  33.                    If (StrCompUnicode(f.Name, (fichero)) = True) Then
  34.                        ResuelveRuta = ResuelveRuta(Left$(Ruta, k) & f.ShortName)
  35.                        ' usar f.ShortPath  si además de los ficheros, las carpetas también tuvieran 'caracteres raros'...
  36.                        SegundoIntento = False
  37.                        Exit Function
  38.                    End If
  39.                Next
  40.                ResuelveRuta = ""
  41.            Else
  42.                ResuelveRuta = ""
  43.            End If
  44.            SegundoIntento = False
  45.        Else
  46.            ResuelveRuta = ""
  47.        End If
  48.    End If
  49. End Function
  50.  
  51. Private Function Existe(ByVal Ruta As String) As Boolean
  52.    Existe = (FindFirstFile(Ruta, WFD) <> INVALID_HANDLE_VALUE)
  53. End Function
  54.  
  55. ' Hace una comparación binaria de los bytes pares
  56. ' OJO: No modificar un ápice esta función, basta retirar los 'ASC()' para que falle, lo mismo  si se hace una conversión a arrays...
  57. '      ejemplos que fallan:
  58. '         StrCompUnicode = (Str1 = Str2) Then
  59. '         StrCompUnicode = Strcom(str1, str2, vbTextCompare) ó vbBinaryCompare
  60. '         If (Mid$(Str1, k, 1)) <> (Mid$(Str2, k, 1))) Then Exit Function
  61. Private Function StrCompUnicode(ByRef Str1 As String, ByRef Str2 As String) As Boolean
  62.    Dim k As Long, j As Long
  63.  
  64.    k = Len(Str1): j = Len(Str2)
  65.    If (k = j) Then
  66.        For k = 1 To j
  67.            'Debug.Print CStr(Asc(Mid$(Str1, k, 1))),
  68.            'Debug.Print CStr(Asc(Mid$(Str2, k, 1)))
  69.            If (Asc(Mid$(Str1, k, 1)) <> Asc(Mid$(Str2, k, 1))) Then Exit Function
  70.        Next
  71.  
  72.        StrCompUnicode = True
  73.    End If
  74. End Function
  75.  
  76.  


...puedes tirar con esto, o basarte en esto y mis comentarios previos para montarte tú mismo un FileCommonDialog, que use precisamente el FilesystemObject como el eje de la solución... de todos modos aún con miles de ficheros en una carpeta, con la potencia d elos equipos de hoy, no debería notarse lentitud apreciable en el tratamiento, aunque claramente ese bucle es preferible que se hicera una única vez (cuando se accede a la carpeta y no con cada fichero que tenga caracteres Unicode del 'segundo tipo'...
En línea

FJDA

Desconectado Desconectado

Mensajes: 242


Ver Perfil
Re: Alguien sabe como conseguir esto
« Respuesta #29 en: 7 Febrero 2020, 18:51 pm »

está bien como investigación y creo que muchísisma gente ya ha intentado algún hack para que VB6 no pase de Unicode a ANSI, como trabajar con bytes para evitar la conversión. Pero ¿no sería mejor que renombraras por lotes los archivos JPG que tienes? Si esas fotos son de porno o algo así, hay programas de terceros como XnView  (gratuito) con el que puedes renombrar por lotes.

En cuanto a lo del ratón que no puedes ampliar y eso, tendrías que hacer Hook a la ventana de la imagen,  a la ventana Photos_PhotoCanvas  y bloquear el mensaje de pulsación del ratón con el botón derecho, o inhabilitar el botón en esa ventana. Pero para eso hay que usar mucha API, y me llevaría un rato, la verdad no tengo ganas.

https://www.recursosvisualbasic.com.ar/htm/listado-api/217-subclasificar-combobox-eventos-de-mouse.htm

http://www.vbforums.com/showthread.php?677868-RESOLVED-VB6-about-Hook-windows-api-procedure



Parece que ya sabes programar así que no te vamos a hacer todo el trabajo, investiga un poco. Otra cosa es que pongas un código y digas, esto no me funciona o me da error aquí y no se por qué.


Saludos


edito:
y añado en mi caso, que no soy programador y me refiero que no me dedico a ello, solo pasaba por aquí vi tu pregunta y te contesté gustosamente.
« Última modificación: 7 Febrero 2020, 19:40 pm por FJDA » En línea

Páginas: 1 2 [3] 4 Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
¿Alguien sabe como descifrar esto?
Criptografía
Tzdah 6 3,840 Último mensaje 7 Febrero 2013, 05:26 am
por Tzdah
Alguien sabe como se llama esto¿?
PHP
Roboto 8 2,140 Último mensaje 25 Marzo 2013, 17:10 pm
por 1mpuls0
Alguien sabe como ocultar esto?
Dudas Generales
Leandro3562 2 1,332 Último mensaje 11 Diciembre 2015, 19:21 pm
por Leandro3562
Saben como puedo conseguir esto? « 1 2 »
Foro Libre
Panic0 11 897 Último mensaje 13 Febrero 2021, 11:59 am
por Machacador
Alguien sabe como hacer esto con for??
Programación C/C++
Julia13 3 602 Último mensaje 14 Mayo 2021, 20:51 pm
por engel lex
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines