Hola Enter, para que se muestren hay que hacer un calculo matematico por asi decirlo, la idea es pintar la imagen en un lienzo justificando su ancho o alto a una nueva medida standar para todas las imágenes., ademas utilizar el api SetStretchBltMode + StretchBlt
te paso un ejemplo y te explico abajo.
Option Explicit
'Autor: Leandro Ascierto
'Web: www.leandroascierto.com
Private Declare Function StretchBlt Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (lpPictDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As Any) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function SetStretchBltMode Lib "gdi32.dll" (ByVal hdc As Long, ByVal nStretchMode As Long) As Long
Private Declare Function DrawIconEx Lib "user32.dll" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long
Private Declare Function CreateIconIndirect Lib "user32" (piconinfo As ICONINFO) As Long
Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Private Declare Function FillRect Lib "user32.dll" (ByVal hdc As Long, ByRef lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
Private Declare Function OleTranslateColor Lib "olepro32.dll" (ByVal OLE_COLOR As Long, ByVal hPalette As Long, pccolorref As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Const DI_MASK = &H1
Const DI_IMAGE = &H2
Private Type ICONINFO
fIcon As Long
xHotspot As Long
yHotspot As Long
hbmMask As Long
hbmColor As Long
End Type
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Type PICTDESC
cbSizeofStruct As Long
picType As Long
hImage As Long
xExt As Long
yExt As Long
End Type
Function ResizePicture(ByRef ThePicture As IPicture, ByVal NewWidth As Long, ByVal NewHeight As Long, Optional BackColor As OLE_COLOR = vbWhite) As Boolean
On Error GoTo Fail
Dim Pic As PICTDESC, IID_IDispatch As GUID
Dim hDCMemory As Long, DC As Long
Dim PicDC As Long, OldhBmp As Long, PicW As Long, PicH As Long
Dim hImage As Long, OldhImage As Long
Dim hMask As Long, OldhMask As Long
Dim hIcon As Long, II As ICONINFO
Dim lWidth As Long, lHeight As Long
Dim PLeft As Long, PTop As Long
Dim ReqWidth As Long, ReqHeight As Long
Dim HScale As Double, VScale As Double
Dim MyScale As Double
Dim hBrush As Long
Dim oColor As Long
Dim tRECT As RECT
'Scale in Pixels
PicW = ScaleX(ThePicture.Width, vbHimetric, vbPixels)
PicH = ScaleY(ThePicture.Height, vbHimetric, vbPixels)
'Get Picture DC
PicDC = CreateCompatibleDC(0)
OldhBmp = SelectObject(PicDC, ThePicture.Handle)
'create buffer DC
DC = GetDC(0)
hDCMemory = CreateCompatibleDC(DC)
CLSIDFromString StrPtr("{7BF80981-BF32-101A-8BBB-00AA00300CAB}"), IID_IDispatch
If ThePicture.Type = vbPicTypeIcon Then
hMask = CreateBitmap(NewWidth, NewHeight, 1, 1, ByVal 0&)
OldhMask = SelectObject(hDCMemory, hMask)
DrawIconEx hDCMemory, 0, 0, ThePicture.Handle, NewWidth, NewHeight, 0, 0, DI_MASK
Call SelectObject(hDCMemory, OldhMask)
hImage = CreateCompatibleBitmap(DC, NewWidth, NewHeight)
OldhImage = SelectObject(hDCMemory, hImage)
DrawIconEx hDCMemory, 0, 0, ThePicture.Handle, NewWidth, NewHeight, 0, 0, DI_IMAGE
Call SelectObject(hDCMemory, OldhImage)
II.hbmColor = hImage
II.hbmMask = hMask
hIcon = CreateIconIndirect(II)
If hImage Then DeleteObject hImage
If hMask Then DeleteObject hMask
DeleteDC hDCMemory
ReleaseDC 0&, DC
With Pic
.cbSizeofStruct = Len(Pic)
.picType = ThePicture.Type
.hImage = hIcon
End With
DeleteObject SelectObject(PicDC, OldhBmp)
DeleteDC PicDC
Set ThePicture = Nothing
ResizePicture = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, ThePicture) = 0
Else
hImage = CreateCompatibleBitmap(DC, NewWidth, NewHeight)
OldhImage = SelectObject(hDCMemory, hImage)
HScale = NewWidth / PicW
VScale = NewHeight / PicH
MyScale = IIf(VScale >= HScale, HScale, VScale)
ReqWidth = (PicW * MyScale)
ReqHeight = (PicH * MyScale)
PLeft = ((NewWidth - ReqWidth) / 2)
PTop = ((NewHeight - ReqHeight) / 2)
OleTranslateColor BackColor, 0&, oColor
tRECT.Right = NewWidth
tRECT.Bottom = NewHeight
hBrush = CreateSolidBrush(oColor)
FillRect hDCMemory, tRECT, hBrush
SetStretchBltMode hDCMemory, 4
StretchBlt hDCMemory, PLeft, PTop, ReqWidth, ReqHeight, PicDC, 0, 0, PicW, PicH, vbSrcCopy
Call SelectObject(hDCMemory, OldhImage)
ReleaseDC 0&, DC
DeleteDC hDCMemory
DeleteObject SelectObject(PicDC, OldhBmp)
DeleteDC PicDC
With Pic
.cbSizeofStruct = Len(Pic)
.picType = ThePicture.Type
.hImage = hImage
.xExt = ThePicture.hPal
End With
ResizePicture = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, ThePicture) = 0
End If
Fail:
End Function
Private Sub Form_Load()
Dim PicTemp As StdPicture
Set PicTemp = LoadPicture("D:\Mis documentos\Mis imágenes\Nueva carpeta (2)\DSCN1663.JPG")
'Set PicTemp = LoadPicture("c:\Image.bmp")
If ResizePicture(PicTemp, 150, 150) Then
Me.Picture = PicTemp
End If
End Sub
en este ejemplo solo muestra en un form una imagen, redimencionada, ahora lo que tenes que hacer es llamar a la funcion (ResizePicture) y en ves de usar Me.Picture = PicTemp, pasarle el picTemp al ImageList.
si no se entiende pregunta.
Saludos.
