Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 398
  • Last Modified:

Is there Free Thumbnail generation software or code example on how to do it.

I'm writing a content management system in vbscript and I'm looking for a way to create thumbnails on the fly for an image gallery. I'd prefer a way to do it without a component but if there's a vb dll out there with source code available that would work also.


  • 2
1 Solution
What file formats do you need to work with as input and output?
I dont know of anything free, but checkout csImageFile from www.chestysoft.com.  The image quality is really good and it has many featrues.  Of course you'll have to use it in conjunction with an upload component or script.
jbrahyAuthor Commented:
I'm ok with only jpeg format, and it's ok if it only creates thumbnails. Most of the ones online are either .net, commercial or don't come with the source.
Hi jbrahy

You can use the GDI+ API to create JPEG thumbnail images in VB6.

About GDI+ from MSDN:

"As its name suggests, GDI+ is the successor to Windows Graphics Device Interface (GDI), the graphics device interface included with earlier versions of Windows. Windows XP or Windows Server 2003 supports GDI for compatibility with existing applications, but programmers of new applications should use GDI+ for all their graphics needs because GDI+ optimizes many of the capabilities of GDI and also provides additional features."

Here is a little function written using the flat GDI+ API which opens an image file and saves a thumbnail version to a JPEG file.  This code requires the GDI+ declares and types from the module named GDIPlus API.bas available from psc.com.  Follow this link and download the sample project.  Make a copy of GDIPlus API.bas and add it to your project.


Then create a new module and paste the following code in it:

'BAS Module code for creating thumbnail images using GDI+

Option Explicit

Enum HowToFit
    FitWidth = 1
    FitHeight = 2
End Enum

Type ThumbRules
    IfLandscape As HowToFit
    IfPortrait As HowToFit
    FitHeightValue As Long
    FitWidthValue As Long
End Type

'Needed for GDI+
Private token As Long

Public Function CreateJPEGThumb(ByVal sInFile As String, ByVal sOutFile As String, Rules As ThumbRules, Optional ByVal Quality As Long = 75) As Long
    Dim stat As GpStatus
    Dim img As Long, thumbImg As Long
    Dim encoderCLSID As CLSID
    Dim encoderParams As EncoderParameters
    Dim lQuality As Long
    Dim w As Single, h As Single, aspect As Single
    ' Get the input image from file
    stat = GdipLoadImageFromFile(StrConv(sInFile, vbUnicode), img)
    'Get the height and width of the image
    If (stat = ok) Then
        stat = GdipGetImageDimension(img, w, h)
        Debug.Print "w = " & w, "h = " & h
    End If
    'Keep checking for errors
    If (h = 0) Or (w = 0) Then
        CreateJPEGThumb = -1
        Exit Function
    End If
    'Next determine if the image is landscape or portrait
    'Then apply the rules for scaling the image
    If (stat = ok) Then
        aspect = w / h 'aspect ratio
        If (h > w) Then ' Portrait
            If Rules.IfPortrait = FitHeight Then
                'Set height according to value supplied
                h = Rules.FitHeightValue
                w = CLng(h * aspect)
                Debug.Print "Portrait: Fit Height", h, w
            ElseIf Rules.IfPortrait = FitWidth Then
                'set width according to value supplied
                w = Rules.FitWidthValue
                h = CLng(w / aspect)
                Debug.Print "Portrait: Fit Width", h, w
                'Programmer did not supply values
                'set height = 100 pixels, scale width to maintain aspect
                h = 100
                w = CLng(h * aspect)
                Debug.Print "Portrait: default", h, w
            End If
        Else 'Landscape
            If Rules.IfLandscape = FitHeight Then
                'Set height according to value supplied
                h = Rules.FitHeightValue
                w = CLng(h * aspect)
                Debug.Print "Landscape: Fit Height", h, w
            ElseIf Rules.IfLandscape = FitWidth Then
                'set width according to supplied value
                w = Rules.FitWidthValue
                h = CLng(w / aspect)
                Debug.Print "Landscape: Fit Width", h, w
                'Programmer did not supply values
                'set width = 100 pixels, scale height to maintain aspect
                w = 100
                h = CLng(w / aspect)
                Debug.Print "Landscape: default", h, w
            End If
        End If
    End If
    'Create a thumbnail image
    If (stat = ok) Then
        stat = GdipGetImageThumbnail(img, w, h, thumbImg)
    End If
    ' Get the CLSID of the JPEG encoder
    Call GetEncoderClsid("image/jpeg", encoderCLSID)
    ' Setup the encoder paramters for JPEG quality
    If (stat = ok) Then
        lQuality = Quality
        encoderParams.count = 1    ' Only one element in this Parameter array
        With encoderParams.Parameter
            .NumberOfValues = 1     ' Should be one
            .type = EncoderParameterValueTypeLong
            ' Set the GUID to EncoderQuality
            .GUID = DEFINE_GUID(EncoderQuality)
            .Value = VarPtr(lQuality)  ' Remember: The value expects only pointers!
        End With
        ' Now save the bitmap as JPEG
        stat = GdipSaveImageToFile(thumbImg, StrConv(sOutFile, vbUnicode), encoderCLSID, encoderParams)
    End If
    CreateJPEGThumb = stat
    ' Cleanup
    Call GdipDisposeImage(img)
    Call GdipDisposeImage(thumbImg)
End Function

Public Function gdipLoad() As Boolean
    ' Load the GDI+ Dll
    'Return True for success, False for failure
    Dim GpInput As GdiplusStartupInput
    gdipLoad = False
    GpInput.GdiplusVersion = 1
    If GdiplusStartup(token, GpInput) = ok Then
        gdipLoad = True
    End If
End Function

Public Sub gdipUnLoad()
    ' Unload the GDI+ Dll
    Call GdiplusShutdown(token)
End Sub

Public Function FormatgpStatus(ByVal stat As GpStatus) As String
    'Returns a error message based on error number
    Dim sMsg As String
    Select Case stat
    Case 0: FormatgpStatus = "No Error"
    Case 1: FormatgpStatus = "Generic Error"
    Case 2: FormatgpStatus = "Invalid Parameter"
    Case 3: FormatgpStatus = "Out Of Memory"
    Case 4: FormatgpStatus = "Object Busy"
    Case 5: FormatgpStatus = "Insufficient Buffer"
    Case 6: FormatgpStatus = "Not Implemented"
    Case 7: FormatgpStatus = "Win32 Error"
    Case 8: FormatgpStatus = "Wrong State"
    Case 9: FormatgpStatus = "Aborted"
    Case 10: FormatgpStatus = "File Not Found"
    Case 11: FormatgpStatus = "Value Overflow"
    Case 12: FormatgpStatus = "Access Denied"
    Case 13: FormatgpStatus = "Unknown Image Format"
    Case 14: FormatgpStatus = "Font Family Not Found"
    Case 15: FormatgpStatus = "FontStyle Not Found"
    Case 16: FormatgpStatus = "Not TrueType Font"
    Case 17: FormatgpStatus = "Unsupported Gdi+ Version"
    Case 18: FormatgpStatus = "Gdi+ Not Initialized"
    Case 19: FormatgpStatus = "Property Not Found"
    Case 20: FormatgpStatus = "Property Not Supported"
    Case Else: FormatgpStatus = "Undefined Error"
    End Select
End Function
'end BAS module code

Finally on your test form, place a Command button (Command1) and the following code:

'Form Code

Option Explicit

Private Sub Command1_Click()
    'Create a thumbnail image
    Dim ret As Long
    Dim tr As ThumbRules
    'Set the parameters for sizing the image based on its aspect ratio.
    'Here we will make the thumb 125 pixels wide if it is in landscape orientation
    '    and 200 pixels in height if in portrait orientation
    tr.IfLandscape = FitWidth 'Fit to width if in Landscape orientation
    tr.IfPortrait = FitHeight 'Fit to height if in Portrait orientation
    tr.FitHeightValue = 200
    tr.FitWidthValue = 125
    'Call the thumbnail function with the input file, output file,
    '    sizing parameters, and optionally the JPEG compression value
    ret = CreateJPEGThumb("c:\imgp.jpg", "c:\thumb.jpg", tr)
    If ret <> 0 Then
        MsgBox FormatgpStatus(ret), vbCritical, "Error in GDI+"
    End If
End Sub

Private Sub Form_Load()
    'It is required to initialize GDI+ before use
    If Not gdipLoad() Then
        'Could notinitialize the GDI+ Library
        MsgBox "Error loading GDI+ Library"
        Unload Me
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    'Free the GDI+ Library
    Call gdipUnLoad
End Sub

'end form code

'Any questions just ask
'Hope it helps!


Featured Post


Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now