Zoom in on an image (picture) displayed in workbook

[SerenityNetworks]

I'm using the following code to display an image in a workbook.

Sub Image21()
    On Error GoTo ProcExit21
    Dim objPicture As Picture
    With Sheets("Working").Cells(1, 1) ' Picture displays in cell from row, column
        Set objPicture = .Parent.Pictures.Insert(Sheets("Working").Cells(2, gvarImgColumn + 20).Value) ' Picture path row, column
        objPicture.Width = Sheets("Parameters").Cells(83, 2).Value
        'objPicture.Height = Sheets("Parameters").Cells(84, 2).Value
        objPicture.Top = Sheets("Parameters").Cells(85, 2).Value
        objPicture.Left = Sheets("Parameters").Cells(86, 2).Value
        objPicture.Border.Color = RGB(69, 107, 43)
        objPicture.Border.Weight = xlThick
        objPicture.Border.LineStyle = xlContinuous
    End With
ProcExit21:
End Sub

I would like to be able to zoom in on the image. I am not looking to simply make the image bigger; that I can do. I can control contrast and brightness for all images displayed, rotate a single image, and more, but I am not seeing how I can zoom in on a single image.

Is there a way?

Thanks in advance,
Andrew

 

[SerenityNetworks]

I'm lost. I can use buttons to crop all sides, which effectively zooms the picture. I can crop top, bottom, left, or right. But here is where I have a problem.

Let's say I crop the left 10% off the picture. I keep the display width the same (ex. 800 px). I'd expect the image to get taller, but that's not happening and worse yet some of the right gets cropped off - which is absolutely not what I want happening. If I crop left, I don't want any of the right side of the picture disappearing from view - and I'd prefer none of the top or bottom disappearing either. I can't make this happen.

I've tried also cropping off the left 10% of the picture and at the same time cropping off 10% of the top and 10% of the bottom. Again, I keep the display width the same (ex. 800 px). I would expect the aspect ratio to remain the same with none of the right of the picture being removed from display. But that's not happening. Part of the right of the picture is also not being displayed. Ugh!

How can I crop left, right, top, or bottom and not have any of the opposite side removed from view?

Thanks,
Andrew

Private Function CropImage(xCrop)
    persistShp.Select
    Set shp = persistShp
    If Not shp Is Nothing Then
        If totalCrop < 500 Then ' need to change this ++++++++++
            Selection.ShapeRange.ZOrder msoBringToFront
            If xCrop = "" Then
                topCrop = topCrop + Selection.Height * 0.1
                bottomCrop = bottomCrop + Selection.Height * 0.1
                leftCrop = leftCrop + Selection.Width * 0.1
                rightCrop = rightCrop + Selection.Width * 0.1
                totalCrop = totalCrop + Selection.Height * 0.1 ' need to change this ++++++++++
                shp.PictureFormat.CropTop = topCrop
                shp.PictureFormat.cropBottom = bottomCrop
                shp.PictureFormat.CropLeft = leftCrop
                shp.PictureFormat.CropRight = rightCrop
                'MsgBox "End of IF statement:" & vbCr & vbCr & "Height = " & shp.Height & vbCr & "Width = " & shp.Width & vbCr & vbCr & "totalCrop = " & totalCrop & vbCr & vbCr & "leftCrop = " & leftCrop & vbCr & "topCrop = " & topCrop & vbCr & "rightCrop = " & rightCrop & vbCr & "bottomCrop = " & bottomCrop, vbOKOnly, shp.Name
            ElseIf xCrop = "T" Then
                MsgBox "topCrop = " & topCrop & vbCr & "Selection.Width = " & Selection.Width & vbCr & " Selection.Width * 0.1 = " & Selection.Width * 0.1
                topCrop = topCrop + Selection.Width * 0.1
                shp.PictureFormat.CropTop = topCrop
            ElseIf xCrop = "B" Then
                bottomCrop = bottomCrop + Selection.Width * 0.1
                shp.PictureFormat.cropBottom = bottomCrop
            ElseIf xCrop = "L" Then
                leftCrop = leftCrop + Selection.Height * 0.1
                shp.PictureFormat.CropLeft = leftCrop
            ElseIf xCrop = "R" Then
                rightCrop = rightCrop + Selection.Height * 0.1
                shp.PictureFormat.CropRight = rightCrop
            End If
            shp.Top = Sheets("Parameters").Cells(6, 6).Value    'Tells macro where to place the top of the picture.
            shp.Left = Sheets("Parameters").Cells(7, 6).Value   'Tells macro where to place the left of the picture.
            Selection.ShapeRange.LockAspectRatio = msoTrue
            Selection.ShapeRange.Width = Sheets("Parameters").Cells(8, 6).Value 'Tells macro how wide to keep the image
        Else
            MsgBox "In ELSE statement:" & vbCr & vbCr & "Height = " & shp.Height & vbCr & "Width = " & shp.Width & vbCr & vbCr & "totalCrop = " & totalCrop & vbCr & vbCr & "leftCrop = " & leftCrop & vbCr & "topCrop = " & topCrop & vbCr & "rightCrop = " & rightCrop & vbCr & "bottomCrop = " & bottomCrop, vbOKOnly, shp.Name
        End If
    End If
End Function

 

[Yongle]

Interesting
- I will experiment when back at PC and try to formulate (numerically) exactly what happens when a crop ocuurs

 

[SerenityNetworks]

Thank you. I'm stumped.

 

[Yongle]

Apologies but have not very much time yet to look at this yet (and tomorrow is also committed)

The calculations in your latest function look over-complicated

What I have tested ...
- taking a fresh copy of the image (from the original) each time [ Set shp2 = shp1.Duplicate ]
- deleting the previous duplicate
- cropping again & ramping up the zoom automatically with each new duplicate

Leaving the original image untouched gives more predictable results and is looking promising
- but I am not there yet!

Will post again in about 48 hours

 

[SerenityNetworks]

It doesn't surprise me that my calculations may be overly complicated. I'm an analyst, not a developer by any stretch of the imagination.

Thank you for all your help.

 

[Yongle]

Just thinking aloud ...
I'm travelling so cannot test, but it may be possible to put an enlarged image inside an active-X Image Control with scroll bars for the user to wander around the whole image - do you think that would provide the required functionality ?

 

[Yongle]

following on from post#26, I googled and found this but away from my PC so cannot test

It looks as though an image larger than the screen can be contained inside a userform and scrolled
(seems simpler than endless cropping and resizing)

Have a look if you get a chance, otherwise I will try to pursue later on tomorrow

https://stackoverflow.com/questions/12252569/scrollable-image-in-userform
- the image control is in frame control and the image control doesn't have a border.
- the image control's <code>PictureSizeMode</code> is set to <code>fmPictureSizeModeClip</code> allowing the image to scroll

 

[SerenityNetworks]

Hmmm. Some thoughts... (past and present)

• I used to display the pictures in web elements displayed on the worksheet
  • This method allowed me to scroll using the mouse wheel and wheel left/right toggle (good)
  • This method allowed me to zoom using CTRL+ and CTRL- (good)
    • These top two bullets allowed me to zoom in quickly to the region of interest, which used to be significantly larger than it is now
  • This method allowed me to drag an image from one smaller (web element) window to a larger window (good)
  • This method did not allow me to adjust brightness, contrast, or invert colors (very bad)
  • The next set of images was slow to load (very bad)
    • As the nature of the pictures changed, changing contrast, brightness, and having the ability to invert colors became critical. Speed is also critical. So the last two bullets caused me to change methods to simply displaying the pictures on the worksheet. It's fast and I can manipulate the pictures (brightness, contrast, and invert colors).
• I'm open to displaying a selected picture in a user form, but...
  • It must be fast to load
  • I must be able to still control brightness, contrast, and invert images
  • I must still be able to zoom in quickly to a region of interest
  • Scrolling if necessary must be able to occur using the mouse wheel and wheel left/right toggle (clicking and dragging around scroll bars is too slow)
  • The user needs to be able to type information regarding the region of interest into cells while viewing the region
• Some general tests with the cropping...
  • It usually takes me just 4 clicks to crop to the region of interest. Sometimes takes me 6. But 4 to 6 quick clicks is faster than grabbing and manipulating two different scroll bars, and that's not even counting any clicks I need to make to zoom. So I'm thinking the crop method is faster. The crop method would be pretty good, if only cropping left didn't take off some of the right, top taking off some of the bottom, etc.
  • The fastest would be if I could click and drag over the region of interest and have it expand to a large picture.
    • Or perhaps a click to load the selected image into an Active-X or user form, then a quick click and drag to select the region of interest for display as a larger picture.

I'm open to different methods, but I don't have time to abandon and reinvent the functionality I already have.

Thanks again for your thoughts and assistance. I should have posted more of my requirements from the beginning, but I didn't think the solution would become this involved.

 

[Yongle]

Thanks for your detailed explanation - it's helpful to understand the full background

Test this in a new workbook containing an image
Assign macro "Crop" to the shape, so that clicking on the shape runs the macro
It works perfectly for me every time
- cropping only on one side when any of the 4 specified letters input
- cropping on all 4 sides otherwise

Can you make it deliver a different result ?

Sub Crop()
    Dim cW As Double, cH As Double, w As Double, l As Double, t As Double
    
    With ActiveSheet.Shapes(Application.Caller).PictureFormat
        [COLOR=#006400]'get shape settings[/COLOR]
        With .Parent
            .LockAspectRatio = msoFalse
            l = .Left:     t = .Top:    w = .Width:
            cW = 0.1 * w
            cH = 0.1 * .Height
        End With
        [COLOR=#006400]'crop[/COLOR]
        Select Case UCase(InputBox("T L R B"))
            Case "T":   .CropTop = .CropTop + cH
            Case "L":   .CropLeft = .CropLeft + cW
            Case "R":   .CropRight = .CropRight + cW
            Case "B":   .CropBottom = .CropBottom + cH
            Case Else:  .CropTop = .CropTop + cH
                        .CropLeft = .CropLeft + cW
                        .CropRight = .CropRight + cW
                        .CropBottom = .CropBottom + cH
        End Select
       [COLOR=#006400] 'placement and size[/COLOR]
        With .Parent
            .Width = w: .Left = l:  .Top = t
        End With
    End With
    
End Sub

 

[SerenityNetworks]

Yes. Yesterday, I started a new workbook and kept it simple. I loaded an image and then used buttons to crop all sides, top, bottom, left, or right. It too worked perfectly, although your example is more elegant and I'll be borrowing a good share of that code. Using msoTrue, it expands the image as desired. There is something in the set of routines that detect a mouse click on an image that causes the problem. I just can't figure out what. For the moment I'm going to abandon the listener and just go with button clicks. Doing so will add a mouse click (to select the image to work upon), but I can live with that.

I'll post back on my progress.

Thank you again,
Andrew