Icono pixelado en el Escritorio y la Barra de titulo

[E N T E R]

Hay alguna manera para arreglar esto en VB6. Para que al crear un acceso directo en el Escritorio  en la barra de titulo para que los iconos no queden pixelado.

Ejemplos:

[LeandroA]

Hola para que se vea un icono con una alta resolución tenes que poner dentro de un archivo de recursos un Icono de 32 bits con un nombre que lo muestre como primario por ejemplo "A" o "AMain" con números no recuerdo si "1" es valido o "0" no recuerdo cual es el que utiliza VB6 pero bien "AMain" no te va a fallar

para la barra de titulo del formulario podes usar esta función (solo lo vas a ver cuando este compilada.) leerá desde el archivo de recurso el icono "AMain" y lo pondra en el form

Código: [Seleccionar]


Option Explicit
Private Declare Function LoadImage Lib "User32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal dwImageType As Long, ByVal dwDesiredWidth As Long, ByVal dwDesiredHeight As Long, ByVal dwFlags As Long) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Const IMAGE_ICON        As Long = 1
Private Const ICON_BIG          As Long = 1
Private Const ICON_SMALL        As Long = 0
Private Const WM_SETICON        As Long = &H80
Private Const LR_LOADFROMFILE   As Long = &H10
Private Const LR_SHARED         As Long = &H8000&

Private Sub Form_Load()
    SetWindowIcon Me.hWnd, "AMain", True
End Sub
Private Sub SetWindowIcon(hWnd As Long, Address As String, FromRes As Boolean)
    Dim hIcon As Long
    hIcon = LoadImage(App.hInstance, Address, IMAGE_ICON, 32, 32, IIf(FromRes, LR_SHARED, LR_LOADFROMFILE))
    If hIcon Then Call SendMessage(hWnd, WM_SETICON, ICON_BIG, ByVal hIcon)
   
    hIcon = LoadImage(App.hInstance, Address, IMAGE_ICON, 16, 16, IIf(FromRes, LR_SHARED, LR_LOADFROMFILE))
    If hIcon Then Call SendMessage(hWnd, WM_SETICON, ICON_SMALL, ByVal hIcon)
End Sub

Saludos.

[E N T E R]

De maravilla funciona Leandro. Le agregue 48,48 y 64,64 pero no me lee eso siempre queda en 32

Código: [Seleccionar]

Private Sub SetWindowIcon(hWnd As Long, Address As String, FromRes As Boolean)
    Dim hIcon As Long

    hIcon = LoadImage(App.hInstance, Address, IMAGE_ICON, 64, 64, IIf(FromRes, LR_SHARED, LR_LOADFROMFILE))
    If hIcon Then Call SendMessage(hWnd, WM_SETICON, ICON_BIG, ByVal hIcon)

    hIcon = LoadImage(App.hInstance, Address, IMAGE_ICON, 48, 48, IIf(FromRes, LR_SHARED, LR_LOADFROMFILE))
    If hIcon Then Call SendMessage(hWnd, WM_SETICON, ICON_BIG, ByVal hIcon)

    hIcon = LoadImage(App.hInstance, Address, IMAGE_ICON, 32, 32, IIf(FromRes, LR_SHARED, LR_LOADFROMFILE))
    If hIcon Then Call SendMessage(hWnd, WM_SETICON, ICON_BIG, ByVal hIcon)
   
    hIcon = LoadImage(App.hInstance, Address, IMAGE_ICON, 16, 16, IIf(FromRes, LR_SHARED, LR_LOADFROMFILE))
    If hIcon Then Call SendMessage(hWnd, WM_SETICON, ICON_SMALL, ByVal hIcon)
End Sub
Pero de igual forma muchas gracias quedaron muy bien los iconos.

[raul338]

Estas seguro que ese icono tiene imagenes en distintas resoluciones? Mira que el windows, si no tiene, lo redimensiona

[E N T E R]

Estas seguro que ese icono tiene imagenes en distintas resoluciones? Mira que el windows, si no tiene, lo redimensiona

Si si seguro acá te dejo para que veas.

[LeandroA]

es que 32 el mas grande (ese se utiliza por lo general para mostrar en la barra de traeas, Alt Tab,  y no se si en otros mas)  para visualizar en una carpeta o escritorio si se utilizan las otras dimenciones mas grande pero de eso se encarga windows, asi que no le pongas dentro de la funcion el resto de las dimenciones.

Saludos.

[E N T E R]

OK OK!!, con el de 32 ya queda luego mas que perfecto, solo estaba probando.


Saludos y gracias !!! 

[k_arlytos]

NO ME FUNCIONA , QUE TIPO DE ACHIVO ACEPTA? ESTOY PROBANDO CON *.ICO Y PNG estoy usando w10