VB.NET - Create An Image - Resize But Add Background To Remainding Space - vb.net

I am attempting to resize an image to specific dimensions but I do not want to stretch the image at all if it is smaller than my chosen dimensions. Instead I want to add a black background around the image area that is not in use.
I think that the easiest way to do this would be to create a new image of my desired dimensions & set a background color & then add & center the image over top of this background.
I have created a Bitmap using:
Dim bmp As New Drawing.Bitmap(500, 500)
Dim grap As Drawing.Graphics = Drawing.Graphics.FromImage(bmp)
grap.Clear(Drawing.Color.Black)
From this point I got a bit lost on how to complete the process, all that is needed is to add an image to the Bitmap & center.
Any ideas would be much appretiated

I haven't tested this but it looks like you've pretty much got what you want but:
grap.Clear(Drawing.Color.Black)
Will surely just wipe the entire graphic back to black.
Try doing the clear prior to drawing image:
Graphics pic = this.CreateGraphics();
pic.Clear(Color.Black);
pic.DrawImage(img, new Point(center));

Ended up using:
' Load Image
Dim FilePath As String = "testimage.jpg"
Dim OriginalImage As New Bitmap(FilePath)
' Resize Image While Maintaining Aspect Ratio
Dim aspectRatio As Double
Dim newHeight As Integer
Dim newWidth As Integer
Dim maxWidth As Integer = 500
Dim maxHeight As Integer = 500
' Calculate Size
If OriginalImage.Width > maxWidth Or OriginalImage.Height > maxHeight Then
If OriginalImage.Width >= OriginalImage.Height Then ' image is wider than tall
newWidth = maxWidth
aspectRatio = OriginalImage.Width / maxWidth
newHeight = CInt(OriginalImage.Height / aspectRatio)
Else ' image is taller than wide
newHeight = maxHeight
aspectRatio = OriginalImage.Height / maxHeight
newWidth = CInt(OriginalImage.Width / aspectRatio)
End If
Else ' if image is not larger than max then increase size
If OriginalImage.Width > OriginalImage.Height Then
newWidth = maxWidth
aspectRatio = OriginalImage.Width / maxWidth
newHeight = CInt(OriginalImage.Height / aspectRatio)
Else
newHeight = maxHeight
aspectRatio = OriginalImage.Height / maxHeight
newWidth = CInt(OriginalImage.Width / aspectRatio)
End If
' Below keeps original height & width instead of resizing to fit new height / width
' newWidth = OriginalImage.Width
' newHeight = OriginalImage.Height
End If
Dim newImg As New Bitmap(OriginalImage, CInt(newWidth), CInt(newHeight)) '' blank canvas
' Create New Bitmap
Dim bmp As New Drawing.Bitmap(500, 500)
Dim grap As Drawing.Graphics = Drawing.Graphics.FromImage(bmp)
grap.Clear(Drawing.Color.Black)
Dim g As Graphics = Graphics.FromImage(bmp)
' Calculate Points To Insert Resized Image
Dim InsertX As Integer
Dim InsertY As Integer
' Calculate Y Axis Point
If newImg.Height >= 500 Then
InsertY = 0
Else
InsertY = CInt(((500 - newImg.Height) / 2))
End If
' Calculate X Axis Point
If newImg.Width >= 500 Then
InsertX = 0
Else
InsertX = CInt(((500 - newImg.Width) / 2))
End If
' Add Resized Image To Canvas
g.DrawImage(newImg, New Point(InsertX, InsertY))

By using just the ratio of the larger axis, you can fail in the situation that the other ratio forces you to exceed the other axis.
i.e. 1400x1000 ->( i want to fit into 300x200) -> but just with 1400/300 ratio (4.6) the result will be 300x214.
I think it would be useful to check both ratios and continue with the bigger

Related

VB.net crop an image (jpg) like ms paint with no quality loss

Given an jpg image slightly larger than 19" x 23" I need to crop it to exactly 19" x 23" and preserve the original quality using VB.NET.
I can do this in MS paint, If I open a 2851 x 4651 200 DPI jpg and use the Image Properties dialog I can change the width and Height to 3800 x 4600 (exactly 19" x 23" # 200 DPI).
The resultant image is identical to the original in quality and compression but is cropped on the right and bottom by the 51 pixels. The file size is slightly smaller as expected.
When I use the many techniques I have found on SO to crop/resize an image when I save the image it always saves as 96 DPI. I can adjust the width and height to accommodate the 96 DPI so the end result is exactly 19" x 23", however the resulting pixilation is higher than the original, and the files size is considerably smaller, so obvious quality loss.
What I want is to do is (a simple?) crop like MS paint does. Just take a little off the side and bottom, but I cannot seem to save an image with anything other than 96 DPI.
If I can figure out how to the save the cropped file at 200 DPI (or whatever the original image was) I think what I have will work fine.
I am willing to use an external library if that is what it takes.
Here is one example that works in the sense that the resulting image is 19" x 23" and the image is actually scaled preserving the aspect ratio, however the quality is less than the original.
This code is from another SO answer with some minor modifications.
Public Shared Function ResizeImage(SourceImage As Drawing.Image, TargetWidthIn As Decimal, TargetHeightIn As Decimal) As Drawing.Bitmap
'Dim TargetWidth As Integer = TargetWidthIn * SourceImage.HorizontalResolution
'Dim TargetHeight As Integer = TargetHeightIn * SourceImage.VerticalResolution
Dim TargetWidth As Integer = TargetWidthIn * 96
Dim TargetHeight As Integer = TargetHeightIn * 96
Dim bmSource = New Drawing.Bitmap(SourceImage)
Dim bmDest As New Drawing.Bitmap(TargetWidth, TargetHeight, Drawing.Imaging.PixelFormat.Format32bppArgb)
Dim nSourceAspectRatio = bmSource.Width / bmSource.Height
Dim nDestAspectRatio = bmDest.Width / bmDest.Height
Dim NewX = 0
Dim NewY = 0
Dim NewWidth = bmDest.Width
Dim NewHeight = bmDest.Height
If nDestAspectRatio = nSourceAspectRatio Then
'same ratio
ElseIf nDestAspectRatio > nSourceAspectRatio Then
'Source is taller
NewWidth = Convert.ToInt32(Math.Floor(nSourceAspectRatio * NewHeight))
NewX = Convert.ToInt32(Math.Floor((bmDest.Width - NewWidth) / 2))
Else
'Source is wider
NewHeight = Convert.ToInt32(Math.Floor((1 / nSourceAspectRatio) * NewWidth))
NewY = Convert.ToInt32(Math.Floor((bmDest.Height - NewHeight) / 2))
End If
Using grDest = Drawing.Graphics.FromImage(bmDest)
With grDest
.CompositingQuality = Drawing.Drawing2D.CompositingQuality.HighQuality
'.InterpolationMode = Drawing.Drawing2D.InterpolationMode.HighQualityBicubic
.InterpolationMode = Drawing.Drawing2D.InterpolationMode.NearestNeighbor
.PixelOffsetMode = Drawing.Drawing2D.PixelOffsetMode.HighQuality
.CompositingMode = Drawing.Drawing2D.CompositingMode.SourceCopy
'.SmoothingMode = Drawing.Drawing2D.SmoothingMode.AntiAlias
'.CompositingMode = Drawing.Drawing2D.CompositingMode.SourceOver
.DrawImage(bmSource, NewX, NewY, NewWidth, NewHeight)
End With
End Using
Return bmDest
End Function
I found a solution on SO here
I modifyed my original code above to keep the DPI of the original image:
Dim TargetWidth As Integer = TargetWidthIn * SourceImage.HorizontalResolution
Dim TargetHeight As Integer = TargetHeightIn * SourceImage.VerticalResolution
Then after the call to ResizeImage:
Select Case imageType.ToLower
Case "jpg"
Dim jpgEncoder As ImageCodecInfo = GetEncoder(ImageFormat.Jpeg)
Dim myEncoder As System.Drawing.Imaging.Encoder = System.Drawing.Imaging.Encoder.Quality
Dim myEncoderParams As New EncoderParameters(1)
Dim myEncoderQuality As New EncoderParameter(myEncoder, CType(98L, Int32)) '98%
myEncoderParams.Param(0) = myEncoderQuality
bm.SetResolution(img.HorizontalResolution, img.VerticalResolution)
bm.Save(tempfile, jpgEncoder, myEncoderParams)
Case "png", "gif"
bm.Save(tempfile, System.Drawing.Imaging.ImageFormat.Png)
Case "tiff", "tif"
bm.Save(tempfile, System.Drawing.Imaging.ImageFormat.Tiff)
Case Else
bm.Save(tempfile, System.Drawing.Imaging.ImageFormat.Png)
End Select
bm.Dispose()
I only use jpg now so I don't know if the tiff and png parts work, but it seems using the jpeg encoder allowed me to save the file with 200 DPI and maintain the original quality.
Here is the GetEncoder part that is missing from the other post:
Private Shared Function GetEncoder(f As Drawing.Imaging.ImageFormat) As ImageCodecInfo
Dim myEncoders() As ImageCodecInfo
myEncoders = ImageCodecInfo.GetImageEncoders()
Dim numEncoders As Integer = myEncoders.GetLength(0)
Dim strNumEncoders As String = numEncoders.ToString()
' Get the info. for all encoders in the array.
If numEncoders > 0 Then
Dim myEncoderInfo(numEncoders * 10) As String
For i As Integer = 0 To numEncoders - 1
If myEncoders(i).FilenameExtension.Contains(f.ToString.ToUpper) Then
Return myEncoders(i)
End If
Next
End If
Return Nothing

Do I have to DISPOSE and how should I do it?

I zoom an image with the following code
While PictureBox1.Image.Height < ScreenHeight
PictureBox1.Image = New Bitmap(Image1, PictureBox1.Image.Width * 1.003, PictureBox1.Image.Height * 1.003)
Me.PictureBox1.Update()
End While
Do I need to dispose within the loop (but how do I preserve my image then?) or is it sufficient to dispose only once outside the loop?
Do I use Picturebox1.Image.Dispose()
Do I also need to use PictureBox1.Image = Nothing
Thanks for any useful information
This seems to work well
Dim Width, Height As Integer
Width = PictureBox1.Image.Width
Height = PictureBox1.Image.Height
While Height < ScreenHeight And (Microsoft.VisualBasic.DateAndTime.Timer - StartTime) < ScreenSaverDuration
PictureBox1.Image = New Bitmap(Image1, Width * 1.003, Height * 1.003)
Width = PictureBox1.Image.Width
Height = PictureBox1.Image.Height
Me.PictureBox1.Update()
PictureBox1.Image.Dispose()
End While
Dim Height As Integer = PictureBox1.Image.Height
Dim Width As Integer = PictureBox1.Image.Width
While PictureBox1.Image.Height < ScreenHeight
Height *= 1.003
Width *= 1.003
End While
PictureBox1.Image = New Bitmap(Image1, Width, Height)
PictureBox1.Update()

How Can I re-size an image in VB.Net

I need it so that in my code if something evaluates to true it changes the image location and size.
This is my code so far:
With picValueTwentySix
.Location = New Point(302, 134)
.Size = New System.Drawing.Size(169, 40)
.SizeMode = PictureBoxSizeMode.Zoom
End With
Anybody know why it isn't re-sizing?
Thanks!
As everyone has already mentioned, you need to work the the image. Here is a function I made up for ease of use.
Public Function ResizeImage(ByVal image As Image, ByVal size As Size, Optional ByVal preserveAspectRatio As Boolean = True) As Image
Try
Dim newWidth As Integer
Dim newHeight As Integer
If preserveAspectRatio Then
Dim originalWidth As Integer = image.Width
Dim originalHeight As Integer = image.Height
Dim percentWidth As Single = CSng(size.Width) / CSng(originalWidth)
Dim percentHeight As Single = CSng(size.Height) / CSng(originalHeight)
Dim percent As Single = IIf(percentHeight < percentWidth, percentHeight, percentWidth)
newWidth = CInt(originalWidth * percent)
newHeight = CInt(originalHeight * percent)
Else
newWidth = size.Width
newHeight = size.Height
End If
Dim newImage As Image = New Bitmap(newWidth, newHeight)
Using graphicsHandle As Graphics = Graphics.FromImage(newImage)
graphicsHandle.InterpolationMode = InterpolationMode.HighQualityBicubic
graphicsHandle.DrawImage(image, 0, 0, newWidth, newHeight)
End Using
Return newImage
Catch ex As Exception
Return image
End Try
End Function
Basically it creates a new blank graphic to the dimensions you request, then copies the original image to it while scaling it to fit. I think if you step throw it a line at a time you should be pretty self explanatory, but ask if you have questions...
As stated by #Plutonix, changing the Picturebox size will not affect the image size itself, you have to make sure the actual image size is bigger than the size of the picture box, set the size mode of the picturebox to stretchimage, in this case once you resize the picture box the change will reflect. Also refresh the picture box after resizing.

How do I add constraints to image resizing code? i.e. no larger than 165x146

How do I add constraints to image resizing code? I want the image to be no larger then 165x146. The below code does not hold the constraint when image is 525x610
intWidth = 165 '*** Fix Width ***'
intHeight = 146 '*** Fix Width ***'
If objGraphic.Width > intWidth Then
Dim ratio As Double = objGraphic.Height / objGraphic.Width
intHeight = ratio * intWidth
objBitmap = New Bitmap(objGraphic, intWidth, intHeight)
ElseIf objGraphic.Height > intHeight Then
Dim ratio As Double = objGraphic.Width / objGraphic.Height
intWidth = ratio * intHeight
objBitmap = New Bitmap(objGraphic, intWidth, intHeight)
Else
objBitmap = New Bitmap(objGraphic)
End If
I think you want to maintain the aspect ratio of your image? If so, this method might be appropriate; you will need to multiply the width and height by the ratio you obtain.
'define max size of image
intWidth = 165
intHeight = 146
'if the width/height is larger than the max, determine the appropriate ratio
Dim widthRatio as Double = Math.Min(1, intWidth / objGraphic.Width)
Dim heightRatio as Double = Math.Min(1, intHeight / objGraphic.Height)
'take the smaller of the two ratios as the one we will use to resize the image
Dim ratio as Double = Math.Min(widthRatio, heightRatio)
'apply the ratio to both the width and the height to ensure the aspect is maintained
objBitmap = New Bitmap(objGraphic, CInt(objGraphic.Width * ratio), CInt(objGraphic.Height * ratio))
Edit: Probably need to explicitly convert new height and width to ints

Referencing screen height and width in vb.net

How do I reference the screen height and width in vb.net? For example, the bottom right corner's locations, the top right corner's locations, etc.
I tried My.Computer.Screen but couldnt find anything that told me the size.
You can use:
My.Computer.Screen.Bounds
or:
Screen.PrimaryScreen.Bounds
Bounds is a rectangle that provides the size. Alternatively, you can look at the WorkingArea, which will not include the task bar and docked windows.
You can use something like:
My.Computer.Screen.Bounds.Size.Width
My.Computer.Screen.Bounds.Size.Height
For WPF you can use:
System.Windows.SystemParameters.PrimaryScreenWidth
System.Windows.SystemParameters.PrimaryScreenHeight
dim height as integer = Screen.PrimaryScreen.Bounds.Height
dim width as integer = Screen.PrimaryScreen.Bounds.Width
Insert this code into form_load. I put some resolutions...
Dim dw As Double
Dim dh as Double
Width = Screen.PrimaryScreen.Bounds.Width
If (Width = 1366) Then
dw = 1
ElseIf (Width = 1920) Then
dw = 1.4055
ElseIf (Width = 1280) Then
dw = 0.9379
End If
For Each c As Control In Me.Controls
c.Width = CInt(CDbl(c.Width * dw))
Next
Height = My.Computer.Screen.Bounds.Size.Height
If (Height = 768) Then
dh = 1
ElseIf (Height = 1080) Then
dh = 1.4062
ElseIf (Height = 1024) Then
dh = 1.3333
End If
For Each g As Control In Me.Controls
g.Height = CInt(CDbl(g.Height * dh))
Next