Mensajes

Hola a todos:

Ya se que pensareis que es una pregunta muy documentada pero...
Tengo un montón de ejemplos de código para, en teoría, hacer esto, pero ninguno funciona.

Explico lo que se necesita.

Tengo por ejemplo, estos nombres de archivos en un ListBox:
Sonia
SoniA - Co(2)
sOnIa - copia
sonia
Dario_Sonia_1
PepeSoNia_2(a)
OscarMariSoniA
Imagen_1
JorjePepe_2

Y el nombre a buscar en el ListBox es "Sonia"

Y hay 3 posibilidades de coincidencias, dependiendo de el estado de 2 CheckBox

1 - nombre exacto en nº de caracteres y case sensitive en cada una de las letras
solo devolvería"Sonia"

2 - nombre que contiene mismo nº de caracteres y case sensitive en cada una de las letras
devolvería "Sonia"
devolvería "Dario_Sonia_1"

3 - nombre que contiene mismo nº de caracteres y No case sensitive en cada una de las letras
devolvería "Sonia"
devolvería "SoniA - Co(2)"
devolvería "sOnIa - copia"
devolvería "sonia"
devolvería "Dario_Sonia_1"
devolvería "PepeSoNia_2(a)"
devolvería "OscarMariSoniA"

Yo he escrito un código que funciona al 100%, pero lo publico aquí por si alguien me sugiere si hay una forma mas fácil, o más "profesional" de hacerlo.
Y no comprendo como no he sido capaz de encontrar un código que haga esto en ningún sitio, supongo que no seré el único que necesita este tipo de código.

Esto es lo que tengo:

Código (vb) [Seleccionar] Expandir



Private sub Buscar(s1 as string,busca as string)
        If Form1.CheckExacto.Value = 1 Then  'Exacto
            If s1 = busca Then
                'lo ha conseguido
                Exit Sub
            Else
                Exit Sub
            End If
        End If
        If Form1.CheckCase.Value = 0 Then   'No Case sensitive
                Test = Igual(s1, busca, False)
                If Test Then
                    'lo ha conseguido
                Else:
                    Exit Sub
                End If
                Exit Sub
        Else    'Case sensitive
                Test = Igual(s1, busca, True)
                If Test Then
                    'lo ha conseguido
                Else:
                    Exit Sub
                End If
                Exit Sub
        End If

Public Function Igual(st As String, buscar As String, Sen As Boolean) As Boolean
    Dim i As Integer, s As String, L As Integer, s1 As String, c As Byte, letra As Byte
    s = Trim(st)
    L = Len(buscar)
    letra = Asc(Left(buscar, 1))
    Igual = False
    For i = 1 To Len(s)
        c = Asc(Mid(s, i, 1))
        s1 = Mid(s, i, L)
        If Compara(s1, buscar, Sen) Then
            Igual = True
            Exit For
        End If
    Next
End Function

Public Function Compara(dato As String, Busca As String, Sen As Boolean) As Boolean
    Dim i As Integer, c As Byte, n As Integer, b As Byte
    n = 0
    For i = 1 To Len(Busca)
        c = Asc(Mid(dato, i, 1))
        b = Asc(Mid(Busca, i, 1))
        If Sen Then
            If c = b Then
                n = n + 1
            End If
        Else
            If (c Or &H20) = b Or c = b Or (c Xor &H20) = b Then
                n = n + 1
            End If
        End If
    Next
    If n = Len(Busca) Then
        Compara = True
    End If
End Function



Un saludo.

Perfecto...

Se queda así:

Código [Seleccionar] Expandir

Public Function EliminarMenu(ByVal hwndAPP As Long)
    Dim HWNDMenu As Long
    Dim i As Integer, n_Menu As Long
   
    'hwnd del menu del programa
    HWNDMenu = GetMenu(hwndAPP)
    SendMessage hwndAPP, WM_COMMAND, 57642, 0&    'esto ejecuta Crt+E Seleccionar todo
    If HWNDMenu Then
        n_Menu = GetMenuItemCount(HWNDMenu)
        If n_Menu Then
            For i = 1 To n_Menu     'Recorre todos los menú y los elimina
                Call RemoveMenu(HWNDMenu, 0, MF_BYPOSITION)
            Next
            Call DrawMenuBar(hwndAPP)     'Repinta la barra de menú, actualiza la App
        End If
    End If
End Function


Se ejecuta Ctr+E para que el cursor del mouse no tenga el icono del lápiz, que podría pintar y arruinar el proceso.

Una vez mas, muchísimas gracias.

Yo no utilizo DrawMenuBar, quiero que desaparezcan

Si tienen que ser no accesibles, pero operativos para el programa

Muy bueno este código, este es para mi colección seguro que lo utilizaré.

Te he mandado un mensaje.

Lo que necesito hacer es que queden inaccesibles todos los menúes, y lo he conseguido así:

Código [Seleccionar] Expandir

Private Sub Command1_Click()
    'Dim Handle As Long
    Dim hWnd As Long
    Dim hMainMenu As Long
    Dim hMenu As Long
    Dim MenuID As Long
    Dim menuFlag As Long
    Dim szbuf As String * 128
    Dim szBufM As String * 128
    Dim i As Long, Z As Integer, x As Integer, j As Integer
1:
    List1.Clear
    List4.Clear
    Z = 0 'Posición del menú
    For i = 0 To 10
        hWnd = FindWindow("SDPaintApp", vbNullString)   'handle Ventana aplicación
        If hWnd = 0 Then Exit Sub
        hMainMenu = getmenu(hWnd)
        hMenu = GetSubMenu(hMainMenu, Z)
        MenuID = GetMenuItemID(hMenu, i)
        menuFlag = GetMenuState(hMenu, MenuID, MF_BYCOMMAND)
        Handle = Handle
        Call GetMenuString(hMenu, MenuID, szbuf, 128, MF_BYPOSITION & MF_POPUP)
        If MenuID > 0 Then
            List1.AddItem hMainMenu
            List4.AddItem szbuf 'Nombre del menú
            RemoveMenu hMainMenu, i, MF_BYPOSITION Or MF_DISABLED
            'X = SendMessage(hWnd, WM_COMMAND, MenuID, 0&)  esto ejecuta el MenuID
        End If
    Next
    x = List1.ListCount
    If x = 0 Then
        Call SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, 1 Or 2)   'encima
        Exit Sub
    Else
        GoTo 1
    End If
End Sub


Seguramente tu tienes una solución mejor, pero esta funciona perfecto.

Un saludo.
 

He tardado un poco en responder por que he  estado estudiando y probando el código que me habéis suministrado.

Ante todo muchísimas gracias, por vuestra ayuda.

NEBIRE:
El código nuevo (ampliado) tampoco funciona con los malditos nombres raros, pero el anterior si funciona para nombres chinos y alguno mas, así que utilizo este, y en los casos de archivos que no los pueda reconocer, pues simplemente no los añade a la lista, en mi caso solo tengo esos 3 archivos que son checos.

FJDA:
La opción que sugieres de renombrar archivos es inviable, tienen que conservar sus nombres originales, por que algunas imágenes jpg se utilizan en alguna aplicación y si cambian el nombre las consecuencias pueden ser desastrosas.

Ya tengo todo resuelto excepto este código que pongo aquí (Solo hay una línea de código que no consigo que funcione), y es la que tiene este comentario:

'Aquí necesito obtener Hwnd de los MenuID, para añadirlos a List1

El código:

Código [Seleccionar] Expandir

Private Sub Command1_Click()
    Dim Handle As Long
    Dim hWnd As Long
    Dim hMainMenu As Long
    Dim hMenu As Long
    Dim MenuID As Long
    Dim szbuf As String * 128
    Dim szBufM As String * 128
    Dim I, Z, X
    List1.Clear
    List2.Clear
    List3.Clear
    List4.Clear
    Z = 2 'Posición del menú
    I = 0 'Posición del submenú
    For I = 0 To 30
        hWnd = FindWindow("SDPaintApp", vbNullString)   'handle Ventana aplicación
        If hWnd = 0 Then Exit Sub
        hMainMenu = GetMenu(hWnd)
        hMenu = GetSubMenu(hMainMenu, Z)
        MenuID = GetMenuItemID(hMenu, I)
        Call GetMenuString(hMenu, MenuID, szbuf, 128, MF_BYPOSITION & MF_POPUP)
        If MenuID > 0 Then
            List1.AddItem hMainMenu
            List2.AddItem hMenu
            List3.AddItem MenuID
            List4.AddItem szbuf 'Nombre del menú
            'X = SendMessage(hWnd, WM_COMMAND, MenuID, 0&)  esto ejecuta el MenuID
            'Aquí necesito obtener Hwnd de cada MenuID, para añadirlos a un ListBox
        End If
    Next
End Sub


Espero que esto sea muy fácil para vosotros.
Gracias.

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

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.

[Photos_PhotoCanvas]

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.

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.