One of the features of the Vista and newer Explorer views is the icon size slider; you can do more than just pick between a couple sizes- you can set it to any value in the icon range. Previously to do this in VB was quite a lot of work; you'd have to manually resize each image and rebuild each ImageList since you can't scale up without quality loss... so it's not something that could be rapidly changed without any lag. This project, however, takes advantage of a feature of the new IImageList2 COM interface: it has a .Resize command that can scale down the entire ImageList at once with the speed of Windows API. To avoid quality loss, we load the maximum size images into a primary ImageList, then we dynamically generate the API-made duplicate in the smaller size that the user is looking for, always scaling down instead of up.
Right now this project is focused on standard image file thumbnails; really small images that need to be grey-boxed and standard file icons will be addressed in a future version of this demo.
Here's the key function:
Code:
Private Sub ResizeThumbView(cxNew As Long)
ImageList_Destroy himl
himl = ImageList_Duplicate(himlMax)
HIMAGELIST_QueryInterface himl, IID_IImageList2, pIML
If (pIML Is Nothing) = False Then
pIML.Resize cxNew, cxNew
End If
himl = ObjPtr(pIML)
bSetIML = True
ListView_SetImageList hLVS, himl, LVSIL_NORMAL
bSetIML = False
ListView1.Refresh
End SubRequirements
-Windows Vista or newer
-Common Controls 6.0 Manifest - The demo project has a manifest built into its resource file. Your IDE may have to be manifested to run it from there. If you need to manifest your IDE or a new project, see LaVolpe's Manifest Creator
-oleexp.tlb v4.0 or newer - Only needed in the IDE; not needed once compiled.
-oleexp addon mIID.bas - Included in the oleexp download. Must be added to the demo project the first time you open it.
Scrolling
To make it truly like Explorer, where it sizes while you move the mouse, you can move the code in Slider1_Change over to Slider1_Scroll:
Code:
Private Sub Slider1_Change()
'cxThumb = Slider1.Value
'Label1.Caption = cxThumb & "x" & cxThumb
'ResizeThumbView cxThumb
End Sub
Private Sub Slider1_Scroll()
cxThumb = Slider1.Value
Label1.Caption = cxThumb & "x" & cxThumb
ResizeThumbView cxThumb
End Sub