Botones con imagenes + Temas de XP (Source)

[LeandroA]

Buenas esta es un modulo clase para poder agregar Iconos a los botones, y mantener los temas de xp presnete, bien anteriormente habia echo algo parecido pero era una currada, creo que esto es la forma correcta. porlomenos estando presente los temas de xp , por si esto no fuera asi, hay una subrutina no muy precaria para mostrar la imagen y el texto (no esta 100% completa) pero si alguien la nesesita se puede mejorar.



Boton con Imagen.zip - Descarga

me gustaria si alguien tiene win 98 o win Vista y lo puede testear, para saber si da error.

[seba123neo]

esta muy bueno, si me acuerdo la anterior manera,si no me equivoco era de crear un usercontrol transparente y ponerselo arriba al boton.

saludos.

[cobein]

Exelente, es simple, efectivo y el codigo esta muy prolijo y limpio =) me gusta mucho!

[juancho77]

En una virtual de 98 SE me funciono normalmente. 
Muy buen trabajo, saludos!

[~~]

En vista no funciona bien...

[jack06]

Wenas esta lindo; en Windows Vista ami si me funciona correctamente 

Saludos.

[LeandroA]

En vista no funciona bien...

Hola Gracias a todos, es raro pareceria no estar leyedo justo los iconos que estan en las carpetas, pero si lo de los recursos.., no se si tenga algo que ver pero estas con una cuenta de invitado?.

Saludos

[~~]

Perdón, que se me ha pirado la pinza xD Es que tengo el vista en una máquina virtual y para pasar archivo tengo que copiarlos en una carpeta compartida y solo había metido el exe xDD Si funciona: 

[el_c0c0]

.

[LeandroA]

bueno ya que ve que parece funcionar pongo en este mismo hilo una pequeña subrutina  para agregar iconos de 32 bits a los ImageList

Código [Seleccionar] Expandir


Option Explicit
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal iImageType As Long, ByVal cx As Long, ByVal cy As Long, ByVal fFlags As Long) As Long
Private Declare Function ImageList_ReplaceIcon Lib "comctl32.dll" (ByVal himl As Long, ByVal i As Long, ByVal hIcon As Long) As Long
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long

'LoadImage constantes
Private Const LR_LOADFROMFILE               As Long = &H10
Private Const LR_LOADMAP3DCOLORS            As Long = &H1000
Private Const LR_SHARED                     As Long = &H8000&
Private Const IMAGE_ICON                    As Long = 1

Public Sub ImageListAddIcon32(ImageL As ImageList, Address As String, Optional FromRes As Boolean)
    Dim hIcon As Long
    ImageL.ListImages.Add , , ImageL.Parent.Icon
    hIcon = LoadImage(App.hInstance, Address, IMAGE_ICON, ImageL.ImageWidth, ImageL.ImageHeight, IIf(FromRes, LR_SHARED Or LR_LOADMAP3DCOLORS, LR_LOADFROMFILE))
    ImageList_ReplaceIcon ImageL.hImageList, ImageL.ListImages.Count - 1, hIcon
    DestroyIcon hIcon
End Sub


y se aplicaria algo asi

Código [Seleccionar] Expandir


Option Explicit

Private Sub Form_Load()
    ImageListAddIcon32 ImageList1, App.Path & "\Close.ico" 'leer desde archivo
    ImageListAddIcon32 ImageList1, "ICON_0", True 'leer desde recursos
    Toolbar1.ImageList = ImageList1
    Toolbar1.Buttons(1).Image = 1
    Toolbar1.Buttons(2).Image = 2
End Sub

si se utilizan iconos desde recursos y se esta en el IDE de vb se va a ver los iconos del formulario pero cuando se complie se va a ver los iconos reales.
ademas si se ponen los temas de xp (.manifest) , los iconos se ven mejor ya que se elimina la sobra alpha de los iconos 32 bits.

Saludos