Image quality in userform

[Formula11]

I have a spreadsheet from where I need to refer to about 20 diagrams.
Was going to load each diagram onto a userform, because I need to read cells and diagram at the same time.

The issue with images in forms is that the quality is not great, and difficult to read text in image.

Was looking at the file types when loading an image and there is *.wmf and *.emf available. There are vector image types and quality is the same at any resolution level. The file size goes from 76kb (jpg) to 2650kb (emf). The quality is not improved at all though when emf is loaded to form.

Is there anyway to improve quality so as to read text in image?

 

[Jaafar Tribak]

Your best bet is the PNG format which is better for creating images with clear and crisp text as it doesn't lose image data when compressed. (and supports transparency)

 

[Formula11]

OK thanks Jaafar, will use PNG then

Edit: actually PNG is not available, if I load a PNG file using All files (*.*), it won't accept it

 

[Jaafar Tribak]

Yes. Correct. The PNG format is not supported by MSForms controls or the StdPicture object but, you can handle it in vba, by using the GDI+ library or (easier) the Microsoft Windows Image Acquisition (WIA) library .

Take a look at this thread, started by Dan_W, to see how it is done:

Working with images in VBA - Displaying PNG files

Although Excel supports the importing and exporting of PNG files, the image file format is not easy to work with in native VBA, especially when it comes to display PNG images in Userforms/Userform Controls. One option that you may already be aware of is Steve Bullen's PNG loading function using...

www.mrexcel.com

Hope the quality of the text in the resulting image will keep its sharpness after the conversion.

Edit: I am assuming you are dynamically loading the PNG images from the PNG files with code upon loading the userform.
If you want to add static PNG images at design time, then you will need to save the files to disk in some other valid format.

 

[Formula11]

OK thanks again Jaafar, will work through this then

 

[Jaafar Tribak]

OK thanks again Jaafar, will work through this then

Please, do let us know the outcome (ie:= The resulting image quality) . Thanks.

 

[Formula11]

Jaafar, can confirm the instructions in the link load the PNG file, but the quality is not perceptibly different to say a JPEG file.

Example

Original image:
The 30 Most Important SAT & ACT Math Formulas to Learn

Code:

Private Sub UserForm_Initialize()
        Me.Picture = LoadImage("C:\test\figure1.PNG")
        With Picture
            PictureSizeMode = fmPictureSizeModeStretch
        End With
End Sub

Function LoadImage(ByVal Filename As String) As StdPicture
        With CreateObject("WIA.ImageFile")
                .LoadFile Filename
                Set LoadImage = .FileData.Picture
        End With
End Function

 

[Jaafar Tribak]

The original image in the website is not a PNG image. It is a JPEG one.

Although the text/drawing lines are crispy enough in the original image on the website, the image is still a JPEG image (not high resolution), therefore dowloading it then changing its extension to PNG won't improve its quality.

But the main issue you are having here is that you are stretching the image (fmPictureSizeModeStretch) to fit the size of the client area of the container userform ... Stretching equally degrades the image quality.

WIA permits scaling without losing much of the image quality via its filters. So we can use that and the GetClientRect api to get the dimensions of the form client area.

This is a screenshot of the same image, I obtained (much cripsier) using the following code.

Download Example:
WIA_ImageToCientArea.xlsm

In the UserForm Module:

Option Explicit

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
#If VBA7 Then
    Private Declare PtrSafe Function GetClientRect Lib "user32.dll" (ByVal hwnd As Long, lpRect As RECT) As Long
    Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByRef hwnd As Long) As Long
#Else
    Private Declare Function GetClientRect Lib "user32.dll" (ByVal hwnd As Long, lpRect As Any) As Long
    Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByRef hwnd As Long) As Long
#End If


Private Sub UserForm_Initialize()
     FillFormWithImage Form:=Me, imageFilePathName:="C:\test\figure1.PNG"  '<== change PathName + extension to suit.
End Sub


Private Sub FillFormWithImage(ByVal Form As UserForm, ByVal imageFilePathName As String)

    Dim oWIA As Object, oImg As Object
    Dim iWidth As Integer, iHeight As Integer
    Dim hwnd As Long, uRect As RECT

    Call IUnknown_GetWindow(Form, hwnd)
 
    Call GetClientRect(hwnd, uRect)
 
    With uRect
        iWidth = .Right - .Left
        iHeight = .Bottom - .Top
    End With
 
    Set oWIA = CreateObject("WIA.ImageProcess")
    Set oImg = CreateObject("WIA.ImageFile")
    oImg.LoadFile imageFilePathName

    With oWIA
        .Filters.Add .FilterInfos.Item("Scale").FilterID
        .Filters(1).Properties("MaximumWidth") = iWidth
        .Filters(1).Properties("MaximumHeight") = iHeight
        .Filters(1).Properties("PreserveAspectRatio") = False
        Set Form.Picture = .Apply(oImg).FileData.Picture
    End With

End Sub

 

[Formula11]

Thanks Jaafar, this is definitely an improvement.

I was looking at options in the meantime, as follows.

1. Resizing form to make image as small as possible or as large as required. Came across link below.
Resize a UserForm with VBA or Windows API - Excel Off The Grid
The example in the link uses a ListBox control, and it works with an Image control as well.
I tried to modify your solution to place the image in an Image control so that it could resize but couldn't make it work.

2. I have come across some of your solutions to using middle wheel scroll on userforms, for a vertical scroll bar.
Also came across this solution from Andy Pope to zoom and pan on an image in a form, which is very useful.
Pan on a zoomed-in image on a userform [SOLVED]
Was wondering if it's possible to combine the two solutions so that you could zoom in and out of the image at the location of the cursor.

 

[Formula11]

Edit for above:
1. requirement to resize dynamically, below code works

Option Explicit

Private resizeEnabled As Boolean
Private mouseX As Double
Private mouseY As Double
Private minWidth As Double
Private minHeight As Double

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
#If VBA7 Then
    Private Declare PtrSafe Function GetClientRect Lib "user32.dll" (ByVal hwnd As Long, lpRect As RECT) As Long
    Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByRef hwnd As Long) As Long
#Else
    Private Declare Function GetClientRect Lib "user32.dll" (ByVal hwnd As Long, lpRect As Any) As Long
    Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByRef hwnd As Long) As Long
#End If


Private Sub UserForm_Initialize()
    'Position the resize icon
    lblResizer.Left = Me.InsideWidth - lblResizer.Width
    lblResizer.Top = Me.InsideHeight - lblResizer.Height
    minHeight = 125
    minWidth = 125

    'High quality image in form
    Call put_image_in_form
    'FillFormWithImage Form:=Me, imageFilePathName:="C:\test\figure1.PNG"  '<== change PathName + extension to suit.
End Sub

Sub put_image_in_form()
FillFormWithImage Form:=Me, imageFilePathName:="C:\test\figure1.PNG"  '<== change PathName + extension to suit.
End Sub


Private Sub lblResizer_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    'The user clicked on the lblResizer
    resizeEnabled = True
    'Capture the mouse position on click
    mouseX = X
    mouseY = Y
End Sub

Private Sub lblResizer_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    'Check if the UserForm is not resized too small
    Dim allowResize As Boolean
    allowResize = True
    If Me.Width + X - mouseX < minWidth Then allowResize = False
    If Me.Height + Y - mouseY < minHeight Then allowResize = False
    'Check if the mouse clicked on the lblResizer
    If resizeEnabled = True And allowResize = True Then
    'Resize/move objects based on mouse movement since click
        'Resize the UserForm
        Me.Width = Me.Width + X - mouseX
        Me.Height = Me.Height + Y - mouseY
        'Resize controls
        Call put_image_in_form
        'Move the Close Button
        cmdClose.Left = cmdClose.Left + X - mouseX
        cmdClose.Top = cmdClose.Top + Y - mouseY
        'Move the Resizer icon
        lblResizer.Left = Me.InsideWidth - lblResizer.Width
        lblResizer.Top = Me.InsideHeight - lblResizer.Height
    End If
End Sub


Private Sub lblResizer_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    'The user un-clicked on the lblResizer
    resizeEnabled = False
End Sub

Private Sub cmdClose_Click()
    Unload Me
End Sub

Private Sub FillFormWithImage(ByVal Form As UserForm, ByVal imageFilePathName As String)
    Dim oWIA As Object, oImg As Object
    Dim iWidth As Integer, iHeight As Integer
    Dim hwnd As Long, uRect As RECT

    Call IUnknown_GetWindow(Form, hwnd)
 
    Call GetClientRect(hwnd, uRect)
 
    With uRect
        iWidth = .Right - .Left
        iHeight = .Bottom - .Top
    End With
 
    Set oWIA = CreateObject("WIA.ImageProcess")
    Set oImg = CreateObject("WIA.ImageFile")
    oImg.LoadFile imageFilePathName

    With oWIA
        .Filters.Add .FilterInfos.Item("Scale").FilterID
        .Filters(1).Properties("MaximumWidth") = iWidth
        .Filters(1).Properties("MaximumHeight") = iHeight
        .Filters(1).Properties("PreserveAspectRatio") = False
        Set Form.Picture = .Apply(oImg).FileData.Picture
    End With
End Sub