Visual Basic Foro
Programación => Visual Basic 6 => Mensaje iniciado por: coco en Febrero 15, 2010, 03:16:40 am
-
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:
' 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)
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:
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
-
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.
-
...
Un luxe leandro, pero ya que estamos no quiero desmerecer a cobein que me habia pasado su funcion (que yo anteriormente la usaba)
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!
-
Jajaj no te preocupes, no me voy a poner a llorar! aunque no estoy seguro de que siquiera fuera lo que buscabas. xD
-
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