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

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

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

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

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.

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

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

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