I was trying to help someone out in the MSDN forum, pictures change height width, with wanting to resize images from within an MS Access database. As you can see from my initial post, there are a multitude of possible approaches:
- Consume a COM object that does these thing
- Image Magick
- Stephen Lebans had an image class that apparently could do this type of thing and much more, see: http://www.lebans.com/imageclass.htm
- FreeImage
- Windows Image Acquisition (WIA)
After my initial post just offering a few options, I decided to hand the OP a working solution because I know it isn’t always easy to translate some of our suggestions into concrete solutions, so I created the following Function which employs WIA. As you can see, it is very simple and straightforward. As always, to avoid requiring any reference libraries, this function uses Late Binding techniques.
'---------------------------------------------------------------------------------------
' Procedure : WIA_ResizeImage
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Resize an image based on Max width and Max height using WIA
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
' Req'd Refs: Late Binding -> None required
' Early Binding -> Microsoft Windows Image Acquisition Library vX.X
'
' Windows Image Acquisition (WIA)
' https://msdn.microsoft.com/en-us/library/windows/desktop/ms630368(v=vs.85).aspx
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sInitialImage : Fully qualified path and filename of the original image to resize
' sResizedImage : Fully qualified path and filename of where to save the resized image
' lMaximumWidth : Maximum allowable image width
' lMaximumHeight: Maximum allowable image height
' bPreserveAspectRatio: Whether the image aspect ratio should be preserved, or not
' bOverwrite : Whether it should overwrite the output file if it already exists
'
' Usage:
' ~~~~~~
' Call WIA_ResizeImage("C:\Users\Public\Pictures\Sample Pictures\Chrysanthemum.jpg", _
' "C:\Users\MyUser\Desktop\Chrysanthemum_small.jpg", _
' 800, 600)
' Call WIA_ResizeImage("C:\Users\Public\Pictures\Sample Pictures\Chrysanthemum.jpg", _
' "C:\Users\MyUser\Desktop\Chrysanthemum_small.jpg", _
' 800, 600, False)
' Call WIA_ResizeImage("C:\Users\Public\Pictures\Sample Pictures\Chrysanthemum.jpg", _
' "C:\Users\MyUser\Desktop\Chrysanthemum_small.jpg", _
' 800, 600, True, True)
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2017-01-18 Initial Release
' 2 2022-12-15 Added bPreserveAspectRatio argument
' Added bOverwrite argument
'---------------------------------------------------------------------------------------
Public Function WIA_ResizeImage(sInitialImage As String, sResizedImage As String, _
lMaximumWidth As Long, lMaximumHeight As Long, _
Optional bPreserveAspectRatio As Boolean = True, _
Optional bOverwrite As Boolean = False) As Boolean
On Error GoTo Error_Handler
#Const WIA_EarlyBind = False 'True => Early Binding / False => Late Binding
#If WIA_EarlyBind = True Then
Dim oIF As WIA.ImageFile
Dim oIP As WIA.ImageProcess
Set oIF = New WIA.ImageFile
Set oIP = New WIA.ImageProcess
#Else
Dim oIF As Object
Dim oIP As Object
Set oIF = CreateObject("WIA.ImageFile")
Set oIP = CreateObject("WIA.ImageProcess")
#End If
If Len(Dir(sResizedImage)) > 0 Then
If bOverwrite = True Then
Kill sResizedImage
Else
Exit Function
End If
End If
oIP.Filters.Add oIP.FilterInfos("Scale").FilterID
oIP.Filters(1).Properties("MaximumWidth") = lMaximumWidth
oIP.Filters(1).Properties("MaximumHeight") = lMaximumHeight
oIP.Filters(1).Properties("PreserveAspectRatio") = bPreserveAspectRatio
oIF.LoadFile sInitialImage
Set oIF = oIP.Apply(oIF)
oIF.SaveFile sResizedImage
WIA_ResizeImage = True
Error_Handler_Exit:
On Error Resume Next
Set oIP = Nothing
Set oIF = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: WIA_ResizeImage" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function
The function will return True when the Resize operation is successful and False in all other cases. So you can validate your calls to the function very easily.
Also note that this function can both reduce or blow up an image. It works fine either way, but obviously, blowing up a picture will automatically imply a lost of quality.
Over the years and over the various editions of MS Access I have found ControlTips to be useful, but unreliable. Under various conditions, they don’t seem to always display, or display promptly and then become frustrating. So my basic idea was to replace the built-in ControlTip with a dynamic pop-up form which could display my text.
