Center an Image in a Canvas and maintain Aspect Ration

Given a picture of any size
and a Canvas that is SQUARE (192x192 for example)

Draw the picture on the canvas, reducing the size if necessary, but maintain the original aspect ratio.

I’ve done this before, but today I can’t get the math to work :frowning:

Dim gw As Integer = g.width 
Dim gh As Integer = g.height 

p=current_IMAGESET.image(indx)
Dim pw As Integer = p.width
Dim ph As Integer = p.height 
If pw>0 And ph>0 Then 
  Dim a   As Double  = p.width/p.height
  Dim gsw As Integer = gw
  Dim gsh As Integer = gh
  If a>=1 Then 
    gsh = ph * a
    gsw = pw * a
  Else 
    gsw = pw / a 
    gsh = ph / a
  End If
  x=(gw-gsw)/2
  y=(gh-gsh)/2
  g.drawpicture p,x,y,gsw,gsh,  0,0,pw,ph
  s=Str(p.Width)+"x"+Str(p.Height)+":"+Str(a)+"="+Str(gsw)+","+Str(gsh)
  picdrawn=True
End If

Happy New Year Dave! - Try this:

Public Sub DrawPictureInto(Extends g As Graphics, p As Picture, KeepProportions As 
Boolean = True, ResizeSmaller As Boolean = False)
  '-- Draw a picture to fit a Graphics object's size.
  '   p is the Picture to draw
  //
  //   KeepProportions: If True ( Default ), the picture's aspect ratio wil be respected.
  //                    If False, the picture will be redimensioned to fit the Graphics object entirely
  //
  //
  //   ResizeSmaller: If True, the smaller pictures wil be resized to fit the Graphics object dimensions.
  //                  If False ( default ), the smaller pictures will just be drawn centered

  // Precondition
  If p Is Nil then Return

  // Here we go.
  If KeepProportions then

  // No needs to keep the proportions, so just fill g entirely with the p.
g.DrawPicture p, 0, 0, g.Width, g.Height, 0, 0, p.Width, p.Height

     Else

    If p.Width <= g.Width AND p.Height <= g.Height AND Not ResizeSmaller then
  
      // The picture is smaller than g size, so we just need to draw it centered.
  g.DrawPicture p, (g.width - p.Width)/2, (g.Height - p.Height)/2
  
Else
  
  Var XScale, YScale, ScaleFactor As Double
  Var NewWidth, NewHeight As Integer
  
  // At least one of the picture's dimensions is bigger than g size
  // So we choose the smallest scaling factor.
  XScale = g.Width / p.Width
  YScale = g.Height / p.Height
  ScaleFactor = min(XScale, YScale)
  
  // Compute the new sizes
  NewWidth  = Round( p.Width*ScaleFactor )
  NewHeight = Round( p.Height*ScaleFactor )
  
  // Draw the picture scaled
  g.DrawPicture p, ( g.width - NewWidth ) / 2, ( g.Height - NewHeight ) / 2, NewWidth, NewHeight, 0, 0, p.Width, p.Height
  
End If

End If

End Sub

thanks

two issues

If KeepProportions then

should be

If NOT KeepProportions then

and I had to change VAR to DIM (2019r1.1) :slight_smile:

1 Like