[help] Como dibujar el icono de la ventana sobre un DC? (SOLUCIONADO)

[coco]

Bueno, antes que nada, quiero decir que ya probe con la funcion de leandro GetWindowIcon; la cual obtiene el icono, pero no hace la copia del mismo:

Código: [Seleccionar]

' Rutina que obtiene el ícono de la ventana (éste debe ser destruido).
Private Function GetWindowIcon(hwnd As Long, Size As Long) As Long

    Dim hIcon As Long

    If Size <= 20 Then
        hIcon = SendMessageA(hwnd, WM_GETICON, ICON_SMALL, ByVal 0)
        If hIcon = 0 Then
            hIcon = SendMessageA(hwnd, WM_GETICON, ICON_BIG, ByVal 0)
        End If
    Else
        hIcon = SendMessageA(hwnd, WM_GETICON, ICON_BIG, ByVal 0)
        If hIcon = 0 Then
            hIcon = SendMessageA(hwnd, WM_GETICON, ICON_SMALL, ByVal 0)
        End If
    End If

    Debug.Print "hIcon: "; hIcon 'Aca devuelve el handle correcto
    If hIcon <> 0 Then
        GetWindowIcon = CopyImage(hIcon, IMAGE_ICON, Size, Size, LR_COPYFROMRESOURCE)
    End If

    Debug.Print "Ret: "; GetWindowIcon 'Aca devuelve 0
End Function
para ser mas especificos, el problema solo aparece cuando el icono del formulario se lo seteo yo con WM_SETICON:
(uso esta funcion tan solo para cargar un icono de 32 bits)

Código: [Seleccionar]

Function SetWndIcon(sIconPath As String, lhWnd As Long, lWidth As Long, lHeight As Long, Optional ByVal FromRes As Boolean) As Boolean
    Dim hIcon As Long
   
    hIcon = LoadImage(App.hInstance, sIconPath, IMAGE_ICON, lWidth, lHeight, IIf(FromRes, LR_SHARED Or LR_LOADMAP3DCOLORS, LR_LOADFROMFILE Or LR_SHARED))
   
    If hIcon Then
        If (lWidth > 16) And (lHeight > 16) Then
            Call SendMessage(lhWnd, WM_SETICON, ICON_BIG, ByVal hIcon)
        Else
            Call SendMessage(lhWnd, WM_SETICON, ICON_SMALL, ByVal hIcon)
        End If
       
        Call DestroyIcon(hIcon)
       
        SetWndIcon = True
    End If
   
End Function
entre todo esto, el handle del icono que seteo, es el mismo que el que devuelve el WM_GETICON; digo esto para estar seguros.

y lo dibujo asi:

Código: [Seleccionar]

                    lngIcon = GetWindowIcon(m_hWndChild(iC), 16)
                    DrawIconEx c_dhDC, tActualR.Left + 6, tActualR.Top + 4, lngIcon, 0, 0, 0, 0, &H1 Or &H2 'DI_MASK Or DI_IMAGE
                    Call DestroyIcon(lngIcon)

son 2 clases distintas, donde el codigo de leandro, esta junto a la funcion de pintar el icono. la otra funcion de setear el icono, esta en otra clase. (no es importante, pero aclaro)

bueno entonces ahi esta el problema. con los iconos de vb no hay drama, pero con los iconos q seteo yo de 32 bits (16x16 eh!) no se pintan.

alguna idea?

saludos

[LeandroA]

Hola Coco el problema esta en la funcion SetWndIcon vos estas eliminando el icono que le pasas y este no deve ser destruido deve permanecer en la memoria, fijate que si moves el formulario te va a mostrar un icono de un Exe comun y de hay el problema que no te dibuje ningun icono, tenes que destruir el viejo icono, el viejo icono es el retorno de SendMessage + WM_SETICON

quedaria asi la funcion

Function SetWndIcon(sIconPath As String, lhWnd As Long, lWidth As Long, lHeight As Long, Optional ByVal FromRes As Boolean) As Boolean
    Dim hIcon As Long
    Dim OldhIcon As Long
   
    hIcon = LoadImage(App.hInstance, sIconPath, IMAGE_ICON, lWidth, lHeight, IIf(FromRes, LR_SHARED Or LR_LOADMAP3DCOLORS, LR_LOADFROMFILE Or LR_SHARED))
   
    If hIcon Then
        If (lWidth > 16) And (lHeight > 16) Then
            OldhIcon = SendMessage(lhWnd, WM_SETICON, ICON_BIG, ByVal hIcon)
        Else
            OldhIcon = SendMessage(lhWnd, WM_SETICON, ICON_SMALL, ByVal hIcon)
        End If
       
        If OldhIcon <> 0 Then DestroyIcon OldhIcon

       
        SetWndIcon = True
    End If
   
End Function

Saludos.

[coco]

...

Un luxe leandro, pero ya que estamos no quiero desmerecer a cobein que me habia pasado su funcion (que yo anteriormente la usaba)

Código: [Seleccionar]

Public Sub SetIcon(ByVal hwnd As Long, ByVal sIconResName As String)
    Dim lhWndTop    As Long
    Dim lhWnd       As Long
    Dim cx          As Long
    Dim cy          As Long
    Dim hIconLarge  As Long
    Dim hIconSmall  As Long
     
    On Local Error GoTo SetIcon_Error

    lhWnd = hwnd
    lhWndTop = lhWnd
    Do While Not (lhWnd = 0)
        lhWnd = GetWindow(lhWnd, GW_OWNER)
        If Not (lhWnd = 0) Then
            lhWndTop = lhWnd
        End If
    Loop
   
    cx = GetSystemMetrics(SM_CXICON)
    cy = GetSystemMetrics(SM_CYICON)
    hIconLarge = LoadImageAsString(App.hInstance, sIconResName, IMAGE_ICON, cx, cy, LR_SHARED)
    SendMessageLong lhWndTop, WM_SETICON, ICON_BIG, hIconLarge
    SendMessageLong hwnd, WM_SETICON, ICON_BIG, hIconLarge
   
    cx = GetSystemMetrics(SM_CXSMICON)
    cy = GetSystemMetrics(SM_CYSMICON)
    hIconSmall = LoadImageAsString(App.hInstance, sIconResName, IMAGE_ICON, cx, cy, LR_SHARED)
    SendMessageLong lhWndTop, WM_SETICON, ICON_SMALL, hIconSmall
    SendMessageLong hwnd, WM_SETICON, ICON_SMALL, hIconSmall

    On Error GoTo 0
    Exit Sub

SetIcon_Error:
End Sub

saludos!

[cobein]

Jajaj no te preocupes, no me voy a poner a llorar! aunque no estoy seguro de que siquiera fuera lo que buscabas. xD

[coco]

Jajaj no te preocupes, no me voy a poner a llorar! aunque no estoy seguro de que siquiera fuera lo que buscabas. xD

si si, era eso, es mas , tu funcion tiene lo del tamaño small y grande, cosa que yo tengo que poner a mano y no se si matchea con el del sistema.

saludos