Generating Thumbnails in VB?

How do you make a thumbnail of a jpg file in vb and then save it to disk.  the thumnail would be very small about 10% of original image size.
I need a fast way to do it if one exists.
Who is Participating?
danaseamanConnect With a Mentor Commented:
You can easily create thumbnails in Vb with GDI+ usiung function GdipGetImageThumbnail. If GDIplus.DLL is not installed on your system(XP & 2000SP3 are OK)you can get it free at

You can save the thumbnails in a variety of formats: Bmp/Jpg/Png/Gif.

You can use declares in your code to access GDI+ functions as shown here:

Another option is to use my GdiPlus.TLB here:

Sample code:

Other Links for making/viewing thumbnails:
Mike TomlinsonMiddle School Assistant TeacherCommented:
VB has the ability to read in JPG, GIF and BMP formats...but can only save imges in the BMP format.

If you need to save your thumbnails in JPG format, you will need to use a third party DLL or control.

gerrymcdAuthor Commented:
it doest matter the format bmp is fine but how do i resize the images to be small and be fast while generating the thumnails.
Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function StretchBlt Lib "gdi32" (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

Public Sub ResizePictureContents(pBox As PictureBox, destPBox As PictureBox, width As Long, height As Long)
'destPBox.width = width * Screen.TwipsPerPixelX
'destPBox.height = height * Screen.TwipsPerPixelY
StretchBlt destPBox.hdc, 0, 0, width, height, pBox.hdc, 0, 0, pBox.ScaleWidth, pBox.ScaleHeight, vbSrcCopy
End Sub

Call ResizePictureContents(Form1.Picture1, Form1.Picture2, 128, 128)

this will resize the contents of Picture1 to (128x128) and store the resized result in Picture2.

Good Luck.
gerrymcdAuthor Commented:
i cant get that to work all i see is a tiny image (size of an icon) of the orginal in a picture box?
Mike TomlinsonConnect With a Mentor Middle School Assistant TeacherCommented:
Create a new project and add a CommandButton, Label, two PictureBoxes and a Module.

The thumbnail filenames will be in the same folder preceded by "thmb_".

Just run the app and click the button to select the source image folder.



' -----------------------------------------------------
' Form1
' -----------------------------------------------------
Option Explicit

Private Sub Form_Load()
    Me.ScaleMode = vbPixels
    Picture1.ScaleMode = vbPixels
    Picture2.ScaleMode = vbPixels
    Picture2.AutoSize = True
    Picture1.AutoRedraw = True
    Picture1.BorderStyle = 0 ' None
    Picture2.BorderStyle = 0 ' None
    Picture1.Appearance = 0 ' Flat
    Picture2.Appearance = 0 ' Flat
    Picture2.Visible = False ' original  image does not need to be visible
    Picture1.Width = 50  ' <---------------------------------------------------  Set the Width & Height in Pixels
    Picture1.Height = 50 ' <---------------------------------------------------  of your desired Thumbnail Size
End Sub

Private Sub Command1_Click()
    Dim pathName As String
    pathName = BrowseFolder("Select an Image folder")
    If pathName <> "" Then
        Dim curFile As String
        Dim ext As String
        If Right(pathName, 1) <> "\" Then
            pathName = pathName & "\"
        End If
        curFile = Dir(pathName)
        While curFile <> ""
            If UCase(Left(curFile, 5)) <> "THMB_" Then
                ext = UCase(Right(curFile, 4))
                Select Case ext
                    Case ".JPG", ".BMP", ".GIF"
                        ' Load image
                        Label1.Caption = curFile
                        Picture2.Picture = LoadPicture(pathName & curFile)
                        ' Make thumbnail
                        Picture1.PaintPicture Picture2.Picture, 0, 0, Picture1.Width, Picture1.Height
                        ' Save thumbnail
                        SavePicture Picture1.Image, pathName & "thmb_" & curFile
                End Select
            End If
            curFile = Dir()
        MsgBox "Done"
    End If
End Sub

' -----------------------------------------------------
' Module1
' -----------------------------------------------------
Option Explicit

  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
            "SHGetPathFromIDListA" (ByVal pidl As Long, _
            ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
            "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
            As Long
Private Const BIF_USENEWUI = &H40

Public Function BrowseFolder(szDialogTitle As String) As String
  Dim x As Long, bi As BROWSEINFO, dwIList As Long
  Dim szPath As String, wPos As Integer
    With bi
        .hOwner = 0
        .lpszTitle = szDialogTitle
    End With
    dwIList = SHBrowseForFolder(bi)
    szPath = Space$(512)
    x = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
    If x Then
        wPos = InStr(szPath, Chr(0))
        BrowseFolder = Left$(szPath, wPos - 1)
        BrowseFolder = ""
    End If
End Function
If Thumbnail quality is an issue you will need to use GDI+ or Shell32. Both yield high quality Thumbnails:


   IVBExtractImageLib.tlb required for above demo. Register the TLB via Project/Refrerences:

Complete GDI+ demo. Saves as Png but you can easily change this to Bmp/Gif/Jpg:

Form frmMain
Option Explicit

Dim token As Long ' Needed to close GDI+

Private Sub Form_Load()
   Dim sFile As String
   ' Load the GDI+ Dll
   Dim GpInput As GdiplusStartupInput
   GpInput.GdiplusVersion = 1
   If GdiplusStartup(token, GpInput) <> Ok Then
      MsgBox "Error loading GDI+!", vbCritical
      Unload Me
   End If
   sFile = InputBox("Image File", , "D:\_UnicodeScreenShots\UniGrid3.bmp")
   DrawThumbnail sFile, 128, 128 '(BrowseFolder("Select image file"))
End Sub

Private Sub Form_Unload(Cancel As Integer)
   ' Unload the GDI+ Dll
   Call GdiplusShutdown(token)
End Sub

Private Sub DrawThumbnail(ByVal sFile As String, ByVal lngThumbWidth As Long, ByVal lngThumbHeight As Long)
   Dim graphics As Long
   Dim img As Long
   Dim imgThumb As Long
   Dim encoderCLSID As CLSID

   ' Initializations
   GdipCreateFromHDC Me.hdc, graphics  ' Initialize the graphics class - required for all drawing
   GdipLoadImageFromFile StrConv(sFile, vbUnicode), img     ' Load the image
   ' Create the thumbnail
   GdipGetImageThumbnail img, lngThumbWidth, lngThumbHeight, imgThumb

   ' Draw the thumbnail image unaltered
   GdipDrawImageRectI graphics, imgThumb, 10, 10, lngThumbWidth, lngThumbHeight
   ' Get the CLSID of the PNG encoder
   GetEncoderClsid "image/png", encoderCLSID

   ' Save as a PNG file. There are no encoder parameters for PNG images, so we pass a NULL.
   GdipSaveImageToFile imgThumb, StrConv(App.Path & "\Thumb.png", vbUnicode), encoderCLSID, ByVal 0

   ' Cleanup
   GdipDisposeImage img   ' Delete the image
   GdipDisposeImage imgThumb   ' Delete the thumbnail image
   GdipDeleteGraphics graphics
End Sub

Module modGDIPlusAPI
Option Explicit

Public Declare Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" (ByVal psString As Any) As Long

Public Type GdiplusStartupInput
   GdiplusVersion As Long              ' Must be 1 for GDI+ v1.0, the current version as of this writing.
   DebugEventCallback As Long          ' Ignored on free builds
   SuppressBackgroundThread As Long    ' FALSE unless you're prepared to call
                                       ' the hook/unhook functions properly
   SuppressExternalCodecs As Long      ' FALSE unless you want GDI+ only to use
                                       ' its internal image codecs.
End Type

Public Type CLSID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(0 To 7) As Byte
End Type

Public Type ImageCodecInfo
   ClassID As CLSID
   FormatID As CLSID
   CodecName As Long      ' String Pointer; const WCHAR*
   DllName As Long        ' String Pointer; const WCHAR*
   FormatDescription As Long ' String Pointer; const WCHAR*
   FilenameExtension As Long ' String Pointer; const WCHAR*
   MimeType As Long       ' String Pointer; const WCHAR*
   flags As ImageCodecFlags   ' Should be a Long equivalent
   Version As Long
   SigCount As Long
   SigSize As Long
   SigPattern As Long      ' Byte Array Pointer; BYTE*
   SigMask As Long         ' Byte Array Pointer; BYTE*
End Type

Public Enum GpStatus   ' aka Status
   Ok = 0
   GenericError = 1
   InvalidParameter = 2
   OutOfMemory = 3
   ObjectBusy = 4
   InsufficientBuffer = 5
   NotImplemented = 6
   Win32Error = 7
   WrongState = 8
   Aborted = 9
   FileNotFound = 10
   ValueOverflow = 11
   AccessDenied = 12
   UnknownImageFormat = 13
   FontFamilyNotFound = 14
   FontStyleNotFound = 15
   NotTrueTypeFont = 16
   UnsupportedGdiplusVersion = 17
   GdiplusNotInitialized = 18
   PropertyNotFound = 19
   PropertyNotSupported = 20
End Enum

' Information flags about image codecs
Public Enum ImageCodecFlags
   ImageCodecFlagsEncoder = &H1
   ImageCodecFlagsDecoder = &H2
   ImageCodecFlagsSupportBitmap = &H4
   ImageCodecFlagsSupportVector = &H8
   ImageCodecFlagsSeekableEncode = &H10
   ImageCodecFlagsBlockingDecode = &H20

   ImageCodecFlagsBuiltin = &H10000
   ImageCodecFlagsSystem = &H20000
   ImageCodecFlagsUser = &H40000
End Enum

Public Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As GpStatus
Public Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal token As Long)
Public Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hdc As Long, graphics As Long) As GpStatus
Public Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As GpStatus
Public Declare Function GdipDrawImageRectI Lib "gdiplus" (ByVal graphics As Long, ByVal image As Long, ByVal x As Long, ByVal y As Long, ByVal Width As Long, ByVal Height As Long) As GpStatus
Public Declare Function GdipGetImageEncodersSize Lib "gdiplus" (numEncoders As Long, size As Long) As GpStatus
Public Declare Function GdipGetImageEncoders Lib "gdiplus" (ByVal numEncoders As Long, ByVal size As Long, encoders As Any) As GpStatus
Public Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal filename As String, image As Long) As GpStatus
Public Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As GpStatus
Public Declare Function GdipSaveImageToFile Lib "gdiplus" (ByVal image As Long, ByVal filename As String, clsidEncoder As CLSID, encoderParams As Any) As GpStatus
Public Declare Function GdipGetImageThumbnail Lib "gdiplus" (ByVal image As Long, ByVal thumbWidth As Long, ByVal thumbHeight As Long, thumbImage As Long, Optional ByVal callback As Long = 0, Optional ByVal callbackData As Long = 0) As GpStatus

Public Sub GetEncoderClsid(strMimeType As String, ClassID As CLSID)

   Dim num As Long, size As Long, I As Long
   Dim ICI() As ImageCodecInfo
   Dim buffer() As Byte
   ' Get the encoder array size
   GdipGetImageEncodersSize num, size
   If size = 0 Then Exit Sub      ' Failed!

   ' Allocate room for the arrays dynamically
   ReDim ICI(1 To num) As ImageCodecInfo
   ReDim buffer(1 To size) As Byte

   ' Get the array and string data
   GdipGetImageEncoders num, size, buffer(1)
   ' Copy the class headers
   CopyMemory ICI(1), buffer(1), (Len(ICI(1)) * num)

   ' Loop through all the codecs
   For I = 1 To num
      ' Must convert the pointer into a usable string
      If StrComp(PtrToStrW(ICI(I).MimeType), strMimeType, vbTextCompare) = 0 Then
         ClassID = ICI(I).ClassID   ' Save the class id
         Exit For
      End If
   ' Free the memory
   Erase ICI
   Erase buffer
End Sub

'Dereference Unicode string pointer
Public Function PtrToStrW(ByVal lpsz As Long) As String
    Dim sOut As String
    Dim lLen As Long

    lLen = lstrlenW(lpsz)

    If (lLen > 0) Then
        sOut = StrConv(String$(lLen, vbNullChar), vbUnicode)
        Call CopyMemory(ByVal sOut, ByVal lpsz, lLen * 2)
        PtrToStrW = StrConv(sOut, vbFromUnicode)
    End If
End Function
gerrymcdAuthor Commented:
Thanks everyone for the great help.  Ill probably split the points later as there are some great solutions there.

Just 1 quick question, if i use the GDI API code will my program run on a wiindows 98 PC?
Yes, GDI API will run on Win98 but you have to install it. It is a free download here:
gerrymcdAuthor Commented:
Ah thanks for that.
Mike TomlinsonMiddle School Assistant TeacherCommented:

I just wanted to point out that in my solution, the generated thumbnails keep the existing extension, but are actually in BMP format.

I forgot to strip the extension off the filename before resaving them again.

Sorry about that,

gerrymcdAuthor Commented:
No bother thanks for your help.  Still tweaking my code.  Ill grade the question later.
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.