Solved

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

Posted on 2004-10-18
4
386 Views
Last Modified: 2013-12-03
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.

Thanks,

John
0
Comment
Question by:jbrahy
  • 2
4 Comments
 
LVL 32

Expert Comment

by:Erick37
ID: 12341492
What file formats do you need to work with as input and output?
0
 
LVL 2

Expert Comment

by:ingomar
ID: 12341981
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.
0
 
LVL 1

Author Comment

by:jbrahy
ID: 12342439
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.
0
 
LVL 32

Accepted Solution

by:
Erick37 earned 125 total points
ID: 12344469
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."
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/gdicpp/GDIPlus/aboutGDIPlus/introductiontoGDIPlus/overviewofGDIPlus.asp

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.

http://www.pscode.com/vb/scripts/ShowCode.asp?txtCodeId=37541&lngWId=1

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
            Else
                '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
            Else
                '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!




0

Featured Post

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

759 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now