User-1688446209 posted
Hi,
Try this code ..its wrking fine for me..
hope this helps
ResizeImage("ThumpNail", 72, 72, flt_image_width, flt_image_height, 115, 86)
-----------
Private Function COMMONFUNCTIONS_IMAGES_RESIZE_TO_TAG(ByVal ORG_Width
As Integer,
ByVal ORG_height
As Integer,
ByVal MaxWidth
As Integer,
ByVal MaxHeight
As Integer)
As String
If ORG_Width > MaxWidth
OrElse ORG_height > MaxHeight
Then
Dim widthRatio
As Double =
CDbl(ORG_Width) /
CDbl(MaxWidth)Dim heightRatio
As Double =
CDbl(ORG_height) /
CDbl(MaxHeight)Dim ratio
As Double = Math.Max(widthRatio, heightRatio)Dim newWidth
As Integer =
CInt((ORG_Width / ratio))Dim newHeight
As Integer =
CInt((ORG_height / ratio))
Return (newWidth.ToString +
"-" + newHeight.ToString)Else
Return ""
End If
End Function
Public Function ResizeImage(ByVal FolderName
As String,
ByVal Resolution1
As Integer,
ByVal Resolution2
As Integer,
ByVal Org_Width
As Double,
ByVal Org_Height
As Double,
ByVal maxwidth
As Integer,
ByVal maxheight
As Integer)
Dim new_width_height
As String
If (maxwidth = maxheight)
Then
new_width_height = maxwidth.ToString +
"-"
+ maxheight.ToString
Else
new_width_height = COMMONFUNCTIONS_IMAGES_RESIZE_TO_TAG(Org_Width, Org_Height, maxwidth, maxheight)
End
If
Dim new_width_height1, new_width_height2(), new_width, new_height
As
String
new_width_height1 = new_width_height.ToString
new_width_height2 = Split(new_width_height1,
"-"
, -1)
new_width = new_width_height2(0)
new_height = new_width_height2(1)
Dim dir As System.IO.DirectoryInfo =
New System.IO.DirectoryInfo(Server.MapPath("~/Upload/MovieImage/"
) & FolderName)
Try
dir.Create()
Catch ex As
Exception
End
Try
If dir.Exists
Then
Dim bmpW, bmpH As
Integer
bmpW = new_width
'New image target width
bmpH = new_height
'New Image target height
If (FileUpload1.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(FileUpload1.FileName, FileUpload1.PostedFile.ContentType))
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(FileUpload1.FileName, 1, (InStr(FileUpload1.FileName,
"."
) - 1))
'Set the save path of the resized image, you will need this directory already created in your web site
Dim file1 As
String
= FileUpload1.PostedFile.FileName
filePath = file1 &
".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(FileUpload1.PostedFile.InputStream)
Dim newBmp As Bitmap =
New
Bitmap(newWidth, newHeight, Imaging.PixelFormat.Format24bppRgb)
newBmp.SetResolution(Resolution1, Resolution2)
'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 Path As
String = dir.FullName &
"\"
& filePath
newBmp.Save(Path, ImageFormat.Jpeg)
'Show the uploaded resized picture in the image control
Image1.ImageUrl = dir.FullName &
"/"
& filePath
Image1.Visible =
True
Return
filePath
Catch ex As
Exception
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."
End
If
End
If
End
If
End
Function
Function CheckFileType(ByVal fileName
As
String,
ByVal MimeType
As
String)
As Boolean
Dim ext As
String = Path.GetExtension(fileName)
Select Case ext.ToLower()
Case ".gif"
If MimeType.ToLower =
"image/gif" Then
Return True
Else
Return False
End If
Case ".png"
If MimeType.ToLower =
"image/png" Then
Return True
ElseIf MimeType.ToLower =
"image/x-png"
Then
Return True
Else
Return False
End If
Case ".jpg"
If MimeType.ToLower =
"image/jpeg" Then
Return True
ElseIf MimeType.ToLower =
"image/pjpeg"
Then
Return True
Else
Return False
End If
Case ".jpeg"
If MimeType.ToLower =
"image/jpeg" Then
Return True
ElseIf MimeType.ToLower =
"image/pjpeg"
Then
Return True
Else
Return False
End If
Case ".bmp"
If MimeType.ToLower =
"image/bmp" Then
Return True
Else
Return False
End If
Case Else
Return False
End Select
End Function
