Alguien sabe como conseguir esto

[Fran1946]

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 [Seleccionar] Expandir

Call EnableWindow(hPhotos_PhotoCanvas, vbFalse)

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

[Fran1946]

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.

[FJDA]

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 (vb) [Seleccionar] Expandir


Dim StartX As Single, StartY As Single

Private Sub Form_Activate()
   MousePointer = 11
   Picture2.PaintPicture Form1.Picture, 0, 0
   Picture1.PaintPicture Picture2.Image, -20, -20, Picture1.Width + 100, Picture1.Height + 100, _
   Picture1.Left, Picture1.Top, Picture1.Width, Picture1.Height
   Picture1.Line (0, 0)-(Picture1.Width - 1, Picture1.Height - 1), 0, B
   MousePointer = 0
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   StartX = X
   StartY = Y
   Picture1.AutoRedraw = False
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Button = 1 Then
       Picture1.Left = IIf(X < StartX, Picture1.Left - (StartX - X), Picture1.Left + (X - StartX))
       Picture1.Top = IIf(Y < StartY, Picture1.Top - (StartY - Y), Picture1.Top + (Y - StartY))
       
       Picture1.PaintPicture Picture2.Image, -20, -20, Picture1.Width + 100, Picture1.Height + 100, _
       Picture1.Left, Picture1.Top, Picture1.Width, Picture1.Height
       Picture1.Line (0, 0)-(Picture1.Width - 1, Picture1.Height - 1), 0, B
   End If
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
   Picture1.AutoRedraw = True
End Sub



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

[Serapis]

...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...

[Fran1946]

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.

[Fran1946]

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

[Serapis]

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...

[FJDA]

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  

[Serapis]

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 (vb) [Seleccionar] Expandir


' previamente hay que añadir la referencia al proyecto de: FileSystemObject
Private fso                             As New FileSystemObject
Private fold                            As Folder
Private f                               As File

' 'primer' y 'segundo' tipo, es solo una connotación para la solución y el tiempo que lleva cada caso.
Private Function ResuelveRuta(ByVal Ruta As String, Optional ByRef SegundoIntento As Boolean) As String
    Dim k As Integer, j As Integer, fichero As String
   
    If Existe(Ruta) Then
        k = InStrRev(Ruta, "\")
        If (Left$(WFD.cAlternate, 1) <> Chr(0)) Then
            ' Aqui CAZA: caracteres Unicode (del primer tipo) en el nombre del fichero.
            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.
            If (j > 0) Then
                ResuelveRuta = Left$(Ruta, k) & Left$(WFD.cAlternate, j - 1)
            Else
                ResuelveRuta = Left$(Ruta, k) & WFD.cAlternate
            End If
        Else
            ResuelveRuta = Ruta ' Left$(Ruta, k) & WFD.cFileName
        End If
    Else
        If (SegundoIntento = False) Then
            SegundoIntento = True
            k = InStrRev(Ruta, "\")
            j = Len(Ruta)
            If (k < j) Then
                ' Aqui CAZA: caracteres Unicode (del segundo tipo) en el nombre del fichero.
                fichero = Right$(Ruta, j - k)
                Set fold = fso.GetFolder(Left$(Ruta, k))
                For Each f In fold.Files
                    If (StrCompUnicode(f.Name, (fichero)) = True) Then
                        ResuelveRuta = ResuelveRuta(Left$(Ruta, k) & f.ShortName)
                        ' usar f.ShortPath  si además de los ficheros, las carpetas también tuvieran 'caracteres raros'...
                        SegundoIntento = False
                        Exit Function
                    End If
                Next
                ResuelveRuta = ""
            Else
                ResuelveRuta = ""
            End If
            SegundoIntento = False
        Else
            ResuelveRuta = ""
        End If
    End If
End Function

Private Function Existe(ByVal Ruta As String) As Boolean
    Existe = (FindFirstFile(Ruta, WFD) <> INVALID_HANDLE_VALUE)
End Function

' Hace una comparación binaria de los bytes pares
' 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...
'      ejemplos que fallan:
'         StrCompUnicode = (Str1 = Str2) Then
'         StrCompUnicode = Strcom(str1, str2, vbTextCompare) ó vbBinaryCompare
'         If (Mid$(Str1, k, 1)) <> (Mid$(Str2, k, 1))) Then Exit Function
Private Function StrCompUnicode(ByRef Str1 As String, ByRef Str2 As String) As Boolean
    Dim k As Long, j As Long
   
    k = Len(Str1): j = Len(Str2)
    If (k = j) Then
        For k = 1 To j
            'Debug.Print CStr(Asc(Mid$(Str1, k, 1))),
            'Debug.Print CStr(Asc(Mid$(Str2, k, 1)))
            If (Asc(Mid$(Str1, k, 1)) <> Asc(Mid$(Str2, k, 1))) Then Exit Function
        Next
   
        StrCompUnicode = True
    End If
End Function




...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'...

[FJDA]

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.