'ImageMod Code Module
'By: Kanaida
'Created 9/10/2013
'Version: 1.0
'Class module
Sub Class_Globals
End Sub
'Initializes the object. You can add parameters to this method if needed.
Public Sub Initialize
End Sub
' Copy the image from pic_src into pic_dst so it fits and
' has the same aspect ratio as the original picture.
Public Sub FitBitmapToView(pic_src As Bitmap, pic_dst As View) As Bitmap
'Original Source: http://www.vb-helper.com/howto_fit_picture_to_box.html
'Ported by: Kanaida
'Created: 9/10/2013
'Description: Original made to work with the ImageDownloader Service to
'fit bitmaps To target ImageViews
Dim aspect_src As Float
Dim wid As Float
Dim hgt As Float
' Get the original picture's aspect ratio.
aspect_src = pic_src.Width / pic_src.Height
' Get the size available.
wid = pic_dst.Width
hgt = pic_dst.Height
' Adjust the wid/hgt ratio to match aspect_src.
If wid / hgt > aspect_src Then
' The area is too short and wide.
' Make it narrower.
wid = aspect_src * hgt
Else
' The area is too tall and thin.
' Make it shorter.
hgt = wid / aspect_src
End If
' Center the image at the correct size.
Dim b2 As Bitmap
b2.InitializeMutable(pic_dst.Width,pic_dst.Height)
Dim c As Canvas
c.Initialize2(b2)
Dim r1 As Rect
r1.Initialize(0,0,pic_src.Width,pic_src.Height)
Dim Left As Float =(pic_dst.Width - wid) / 2
Dim Top As Float = (pic_dst.Height - hgt) / 2
Dim Right As Float = Left+wid
Dim Bottom As Float = Top+hgt
Dim r2 As Rect
r2.Initialize(Left,Top,Right,Bottom)
'You can make the background color something else.
'I didn't need it as a parameter.
c.DrawColor(Colors.White)
c.DrawBitmap(pic_src,r1,r2)
Return b2
End Sub