Private Function UploadThumbnail(ByVal myUpload As FileUpload, ByVal nameExtension As String, ByVal myNewHeight As Integer, ByVal myNewWidth As Integer, ByVal compression As Int16, ByVal leadName As String) As Boolean
Dim myresult As Boolean = True
'Const bmpW = 300 'New image target width
Dim bmpW = myNewWidth
'Const bmpH = 226 'New Image target height
Dim bmpH = myNewHeight
If (myUpload.HasFile) Then
'Clear the error label text
lblError.Text = ""
'Check to make sure the file to upload has a picture file format extention and set the target width and height
If (CheckFileType(myUpload.FileName)) Then
Dim newWidth As Integer = bmpW
Dim newHeight As Integer = bmpH
'Use the uploaded filename for saving without the '.' extension
Dim upName As String = Mid(myUpload.FileName, 1, (InStr(myUpload.FileName, ".") - 1))
upName = nameExtension & leadName & lblLandRef.Text
'Set the save path of the resized image, you will need this directory already created in your web site
Dim filePath As String = "" & upName & ".jpg"
'Create a new Bitmap using the uploaded picture as a Stream
'Set the new bitmap resolution to 72 pixels per inch
Dim upBmp As Bitmap = Bitmap.FromStream(myUpload.PostedFile.InputStream)
Dim newBmp As Bitmap = New Bitmap(newWidth, newHeight, Imaging.PixelFormat.Format24bppRgb)
newBmp.SetResolution(72, 72)
'Get the uploaded image width and height
Dim upWidth As Integer = upBmp.Width
Dim upHeight As Integer = upBmp.Height
Dim newX As Integer = 0 'Set the new top left drawing position on the image canvas
Dim newY As Integer = 0
Dim reDuce As Decimal
'Keep the aspect ratio of image the same if not 4:3 and work out the newX and newY positions
'to ensure the image is always in the centre of the canvas vertically and horizontally
If upWidth > upHeight Then 'Landscape picture
reDuce = newWidth / upWidth
'calculate the width percentage reduction as decimal
newHeight = Int(upHeight * reDuce)
'reduce the uploaded image height by the reduce amount
newY = Int((bmpH - newHeight) / 2)
'Position the image centrally down the canvas
newX = 0 'Picture will be full width
ElseIf upWidth < upHeight Then 'Portrait picture
reDuce = newHeight / upHeight
'calculate the height percentage reduction as decimal
newWidth = Int(upWidth * reDuce)
'reduce the uploaded image height by the reduce amount
newX = Int((bmpW - newWidth) / 2)
'Position the image centrally across the canvas
newY = 0 'Picture will be full hieght
ElseIf upWidth = upHeight Then 'square picture
reDuce = newHeight / upHeight
'calculate the height percentage reduction as decimal
newWidth = Int(upWidth * reDuce)
'reduce the uploaded image height by the reduce amount
newX = Int((bmpW - newWidth) / 2) 'Position the image centrally across the canvas
newY = Int((bmpH - newHeight) / 2) 'Position the image centrally down the canvas
End If
'Create a new image from the uploaded picture using the Graphics class
'Clear the graphic and set the background colour to white
'Use Antialias and High Quality Bicubic to maintain a good quality picture
'Save the new bitmap image using 'Png' picture format and the calculated canvas positioning
Dim newGraphic As Graphics = Graphics.FromImage(newBmp)
Try
newGraphic.Clear(Color.White)
newGraphic.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
newGraphic.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
newGraphic.DrawImage(upBmp, newX, newY, newWidth, newHeight)
'Dim ep As EncoderParameters = CompressImageParameters(newBmp)
Dim eps As EncoderParameters = New EncoderParameters(1)
eps.Param(0) = New EncoderParameter(Encoder.Quality, _
compression)
Dim ici As ImageCodecInfo = GetEncoderInfo("image/jpeg")
'newBmp.Save(MapPath(filePath), ici, eps)
newBmp.Save(MapPath(filePath), Imaging.ImageFormat.Jpeg)
Return myresult
Catch ex As Exception
myresult = False
lblError.Text = ex.ToString
Finally
upBmp.Dispose()
newBmp.Dispose()
newGraphic.Dispose()
End Try
Else
lblError.Text = "Please select a picture with a file format extension of either Bmp, Jpg, Jpeg, Gif or Png."
myresult = False
Return myresult
End If
End If
End Function