Split an Image into different PictureBoxes - vb.net

I have a Image with size 187x16 which contain 10 smaller Images in a row.
I want split those Images into 10 different PictureBoxes.
Original Image:
Dim fr_bm As New Bitmap(Image.FromFile(AppDomain.CurrentDomain.BaseDirectory & "/images/u/image.gif"))
Dim to_bm As New Bitmap(16, 16)
Dim unitsimagearray(9) As Image
Dim gr As Graphics = Graphics.FromImage(to_bm)
For i As Integer = 0 To 9
Dim fr_rect As New Rectangle(i * 19, 0, 16, 16) '0,19,38,76
Dim to_rect As New Rectangle(0, 0, 16, 16)
gr.DrawImage(fr_bm, to_rect, fr_rect, GraphicsUnit.Pixel)
unitsimagearray(i) = to_bm
Next
u1.Image = unitsimagearray(0)
But the PictureBox shows all the splitted images.

The main problem with your current code is that the destination image (the image containing a slice of the original), is created once but painted many times.
Since the original image has transparent pixels, the result of the painting will be accumulated.
You can see the transparent sections overlapping.
It can be easily corrected, creating a new Bitmap for each slice of the original. You could also re-paint the same image with a transparent color, but this is faster.
In code, I'm assembling all the PictureBox controls that will receive the slices in one array, so you can assign the Image in the same loop that creates the Bitmaps.
You called the first PictureBox u1, so I'm following the same naming convention.
You will dispose of the Bitmap contained in the unitsimagearray when you don't need them anymore or the application closes.
Original Bitmap (.GIF):
Sliced images (2x). Anti-aliasing and transparency are preserved:
Private unitsimagearray(9) As Bitmap
Dim imagePath As String = Path.Combine(AppDomain.CurrentDomain.BaseDirectory, "images/u/image.gif")
Dim picBoxes() As PictureBox = {u1, u2, u3, u4, u5, u6, u7, u8, u9, u10}
Using sourceBitmap As Bitmap = Image.FromStream(New MemoryStream(File.ReadAllBytes(imagePath)))
For idx As Integer = 0 To picBoxes.Length - 1
Dim slice As Bitmap = New Bitmap(16, 16, PixelFormat.Format32bppArgb)
Using g As Graphics = Graphics.FromImage(slice)
Dim sourceRect As New Rectangle(idx * 19, 0, 16, 16)
Dim destinationRect As New Rectangle(0, 0, 16, 16)
g.DrawImage(sourceBitmap, destinationRect, sourceRect, GraphicsUnit.Pixel)
unitsimagearray(idx) = slice
picBoxes(idx).Image = unitsimagearray(idx)
End Using
Next
End Using

Related

Arint System.Drawing.Graphics suppose to write/modify the image its attached to?

As you use a graphics object shouldn't the changes occur on the bitmap (source image) at some point? Running the code below I get 5 images that are all identical to the source. 1.bmp, 2.bmp, 3.bmp, 4.bmp, and 5.bmp are identical to "scaleCharacter" except 4 & 5 have higher compression (smaller file size)
Private Function DrawCharacterMenu() As Boolean
Try
'Background
Dim rect As Rectangle = New Rectangle(100, 100, 128, 128)
Graphics.FromImage(Render).FillRectangle(Brushes.Black, rect)
'Scale up sprite
Dim scaleCharacter As Bitmap = ActiveCharacter.img.Clone
Using grDest = Graphics.FromImage(scaleCharacter)
scaleCharacter.Save("1.bmp")
grDest.ScaleTransform(4.0F, 4.0F)
scaleCharacter.Save("2.bmp")
grDest.InterpolationMode = Drawing2D.InterpolationMode.NearestNeighbor
scaleCharacter.Save("3.bmp")
grDest.DrawImage(scaleCharacter, 0, 0)
scaleCharacter.Save("4.bmp")
End Using
scaleCharacter.Save("5.bmp")
'Draw scaled up sprite to rendering
Graphics.FromImage(Render).DrawImage(scaleCharacter, 100, 100)
Catch ex As Exception
addDebugMessage("Error: Mainmenu.DrawCharacterMenu: " & ex.Message)
Return False
End Try
Return True
End Function
I would Expect 1 to be the same as 'scaleCharacter'
2 and beyond to be 4 times larger (32x32 to 128x128)
3 and beyond to have less interpolation (not looked stretched)
The finished 'scaleCharacter' drawn onto the rendering also is identical to the original image...
All your images are the same because technically you never change them.
Graphics.ScaleTransform() changes only the internal "world" matrix used when drawing primitives. ScaleTransform(4.0F, 4.0F) makes the drawing grid 4x wider and 4x taller, but it doesn't change the image itself until you draw something on it. For instance, if you were to draw a 20 x 10 rectangle on your image now it would result in a rectangle 80 x 40 in size.
To resize the actual image you have to create a new bitmap with the scaled size, then draw the old image scaled onto it.
Changing Graphics.InterpolationMode affects only newly drawn objects. Again it doesn't change your image until you draw something on it.
Finally, while grDest.DrawImage(scaleCharacter, 0, 0) does change your image, it draws the same image in the top-left corner (0, 0) of itself, so there is no visible change.
Here's how you can make it work:
Scaling your image:
'Scale factor.
Dim scaleFactor As Single = 4.0F
'Create a new bitmap of the scaled size.
Using scaledBmp As New Bitmap(scaleCharacter.Width * scaleFactor, scaleCharacter.Height * scaleFactor)
Using g As Graphics = Graphics.FromImage(scaledBmp)
'Draw the old image, scaled, onto the new one.
'srcRect: The rectangle specifying which portion of the source image (scaleCharacter) to draw.
' We want the full image so we specify (0, 0, source width, source height).
'destRect: The rectangle specifying where on the destination image (scaledBmp) to draw the source image.
' Since we want to scale it we specify the full destination image (0, 0, dest width, dest height).
Dim srcRect As New Rectangle(0, 0, scaleCharacter.Width, scaleCharacter.Height)
Dim destRect As New Rectangle(0, 0, scaledBmp.Width, scaledBmp.Height)
g.DrawImage(scaleCharacter, destRect, srcRect, GraphicsUnit.Pixel)
'Save the image.
scaledBmp.Save("2.bmp")
End Using
End Using
Scaling your image using Nearest Neighbour interpolation:
'Create a new bitmap of the scaled size.
Using scaledBmp As New Bitmap(scaleCharacter.Width * scaleFactor, scaleCharacter.Height * scaleFactor)
Using g As Graphics = Graphics.FromImage(scaledBmp)
'Set the interpolation mode before drawing.
g.InterpolationMode = Drawing2D.InterpolationMode.NearestNeighbor
'Draw the old image, scaled, onto the new one.
'srcRect: The rectangle specifying which portion of the source image (scaleCharacter) to draw.
' We want the full image so we specify (0, 0, source width, source height).
'destRect: The rectangle specifying where on the destination image (scaledBmp) to draw the source image.
' Since we want to scale it we specify the full destination image (0, 0, dest width, dest height).
Dim srcRect As New Rectangle(0, 0, scaleCharacter.Width, scaleCharacter.Height)
Dim destRect As New Rectangle(0, 0, scaledBmp.Width, scaledBmp.Height)
g.DrawImage(scaleCharacter, destRect, srcRect, GraphicsUnit.Pixel)
'Save the image.
scaledBmp.Save("3.bmp")
End Using
End Using

Saving a Drawing but not a Full Image in VB.net

I'm working on making a paint-esq image manipulator in VB.Net, and I'm still new to vb. I want the user to be able to upload an image and make adjustments to it, such as adding lines and text. I also want the user to be able to transfer the drawings and text they added to a different baseimage. For example, if the user draws a dog on top of a picture of a park, they can change it so the dog is on a street instead.
I've been messing with the idea of loading the image as the picturebox.backgroundImage, but running into difficulties changing the backgroundImage without reseting the drawings and with croping the image. I've also been dabling in having two pictureboxes with the one on top for drawings, but I'm running into transparency and cropping issues
Here is the code I'm using to establish my picturebox by setting the base image as .backgroundImage
Private Sub LoadImage(thisImage As Image)
'we set the picturebox size according to image, we can get image width and height with the help of Image.Width and Image.height properties.
img.BackgroundImage = thisImage 'c'
img.Image = New Bitmap(thisImage.Width, thisImage.Height) 'c'
img.BorderStyle = BorderStyle.FixedSingle
End Sub
example of the image maniputlation
Private Sub ButtonDone_Click(sender As Object, e As EventArgs) Handles ButtonDone.Click, DoneToolStripMenuItem.Click
Cursor = Cursors.Default
Select Case LCase(stateFlag)
Case "header"
'Reset stuff back to normal
ButtonHeader.Text = "Header"
stateFlag = ""
Cancel_Button.Enabled = False
'set up space to draw on the image
Dim newBm As New Bitmap(img.Image.Width, img.Image.Height)
' First we define a rectangle with the help of already calculated points
Dim newGraphics As Graphics = Graphics.FromImage(newBM) ' create graphics
newGraphics.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
newGraphics.PixelOffsetMode = Drawing2D.PixelOffsetMode.HighQuality
newGraphics.CompositingQuality = Drawing2D.CompositingQuality.HighQuality
'set image attributes
newGraphics.DrawImage(img.Image, New Rectangle(0, 0, img.Image.Width + 1, img.Image.Height + 1), _
0, 0, img.Image.Width + 1, img.Image.Height + 1, GraphicsUnit.Pixel)
'Draw Edges for header
newGraphics.DrawLine(Pens.Black, startPoint.X, borderSize - 20, startPoint.X, borderSize - 50)
newGraphics.DrawLine(Pens.Black, endPoint.X, borderSize - 20, endPoint.X, borderSize - 50)
Dim drawFont As New Font("Times New Roman", 12)
Dim drawBrush As New SolidBrush(Color.Black)
Dim stringSize As SizeF = newGraphics.MeasureString(HeaderLabel.Text, drawFont)
' Draw header label inbetween the two edges.
newGraphics.DrawString(HeaderLabel.Text, drawFont, drawBrush, (startPoint.X + endPoint.X) / 2 - (stringSize.Width / 2), borderSize - 45)
img.Image = newBm
PushUndo(img.Image.Clone)
End Sub
I would advise trying the following method to use one picturebox on top of the other, it is a lot simpler than some other methods. In your form load handler, do something like:
pctBackground.BackgroundImage = Bitmap.FromFile("park.jpg")
pctForeground.BackColor = Color.Transparent
pctForeground.Parent = pctBackground
pctForeground.Image = New Bitmap(pctForeground.ClientSize.Width, pctForeground.ClientSize.Height)
Then when you have drawn on the pctForeground, save it like:
pctForeground.Image.Save("dog_in_park.png", System.Drawing.Imaging.ImageFormat.Png)

Obtaing the ROI in Visual basic errors in code after conversion from C

I've been working on obtaining the ROI of an image, I'm trying to get a square shaped box that will hoover around the region an be able to click and get the standard deviation. I'm familiar with c so i used the c to VB converter, but im getting errors that the statement is not valid in namespace. Everything seems to compatible to VB code. I will be grateful for any suggestions on this matter. Thanks
Private Function DrawRoi(Image As Bitmap, rect As RectangleF) As oid
Dim roi As New Rectangle()
roi.X = CInt(CSng(Image.Width) * rect.X)
roi.Y = CInt(CSng(Image.Height) * rect.Y)
roi.Width = CInt(CSng(Image.Width) * rect.Width)
roi.Height = CInt(CSng(Image.Height) * rect.Height)
Dim timer As New Stopwatch()
timer.Start()
' graphics manipulation takes about 240ms on 1080p image
Using roiMaskImage As Bitmap = CreateRoiMaskImage(ImageWithRoi.Width, ImageWithRoi.Height, roi)
Using g As Graphics = Graphics.FromImage(ImageWithRoi)
g.DrawImage(Image, 0, 0)
g.DrawImage(roiMaskImage, 0, 0)
Dim borderPen As Pen = CreateRoiBorderPen(ImageWithRoi)
g.DrawRectangle(borderPen, roi)
End Using
End Using
Debug.WriteLine("roi graphics: {0}ms", timer.ElapsedMilliseconds)
Me.imagePictureBox.Image = ImageWithRoi
End Function
Private Function CreateRoiMaskImage(width As Integer, height As Integer, roi As Rectangle) As Bitmap
Dim image As New Bitmap(width, height, PixelFormat.Format32bppArgb)
Using g As Graphics = Graphics.FromImage(image)
Dim dimBrush As New SolidBrush(Color.FromArgb(64, 0, 0, 0))
g.FillRectangle(dimBrush, 0, 0, width, height)
Dim roiBrush As New SolidBrush(Color.Red)
g.FillRectangle(roiBrush, roi)
image.MakeTransparent(Color.Red)
Return image
End Using
End Function

Vb.net changing colors of a picture

I am struggling with the following problem: I have a small picture with is painted in red. This color must be changed to another color (users'choice). I used msdn and some googling did the following:
Private Function GetPicture(Iterator As Integer, tempfile As String) As String
Dim Rstring = ""
If Colors.Count = 0 OrElse Iterator >= Colors.Count Then
Rstring = tempfile
Else
Dim NewPicture = My.Computer.FileSystem.GetTempFileName()
My.Computer.FileSystem.CopyFile(tempfile, NewPicture, True)
Dim mypict = New Bitmap(NewPicture)
Dim ColorList As New List(Of Color)
For x = 0 To mypict.Width - 1
For y = 0 To mypict.Height - 1
Dim mypixel = mypict.GetPixel(x, y)
If ColorList.Contains(mypixel) = False Then
ColorList.Add(mypixel)
End If
Next
Next
Dim NewColor = Color.FromArgb(255, 0, 0, 255)
Dim ListOfColorMaps As New List(Of ColorMap)
For Each elem In ColorList
Dim newcolormap = New ColorMap
newcolormap.OldColor = elem
newcolormap.NewColor = NewColor
ListOfColorMaps.Add(newcolormap)
Next
Dim imageAttributes As New ImageAttributes()
Dim width As Integer = mypict.Width
Dim height As Integer = mypict.Height
Dim colorMap As New ColorMap()
'colorMap.OldColor = Color.FromArgb(255, 0, 0, 0) ' opaque red
'colorMap.NewColor = Color.FromArgb(255, 0, 0, 255) ' opaque blue
Dim remapTable As ColorMap() = ListOfColorMaps.ToArray
imageAttributes.SetRemapTable(remapTable, ColorAdjustType.Bitmap)
Dim tempBmp = New Bitmap(width, height)
Dim g = Graphics.FromImage(tempBmp)
g.DrawImage(tempBmp, New Rectangle(0, 0, width, height), 0, 0, width, height, GraphicsUnit.Pixel, imageAttributes)
g.Save()
g.Dispose()
mypict.Dispose()
Dim NewFileName = NewPicture.Remove(NewPicture.IndexOf("."c) - 1) & ".png"
tempBmp.Save(NewFileName, Imaging.ImageFormat.Png)
My.Computer.FileSystem.DeleteFile(NewPicture)
tempBmp.Dispose()
Rstring = NewPicture
End If
Return Rstring
The Code runs without exceptions, and it seems to find the desired colors but the saved tempbmp contains no picture. Does this happen because the code runs in a dll without graphic?
You can pretty much ignore the "IF" part - that has something to do with another usecase.
Greetings and sincere thanks
Christian Sauer
You are getting no picture displayed because you are drawing an empty bitmap.
Your problem starts here:
Dim tempBmp = New Bitmap(width, height)
Dim g = Graphics.FromImage(tempBmp)
g.DrawImage(tempBmp, New Rectangle(0, 0, width, height), 0, 0, width, height, _
GraphicsUnit.Pixel, imageAttributes)
You create a new bitmap (probably with a white background).
Then you create a new Graphics object from your empty bitmap.
Then you draw the empty bitmap onto itself.
What you should be doing is drawing the mypict object (which is the bitmap whose colors you want to change). Thus your third line should be as follows:
g.DrawImage(mypict, New Rectangle(0, 0, width, height), 0, 0, width, height, _
GraphicsUnit.Pixel, imageAttributes)
Since the Graphics object g is associated with tempBmp (which is empty prior to the DrawImage operation) drawing mypict will draw to it with your parameters.
One other recommendation is that you remove the g.Save() line. You save a graphics object when you plan to restore it later. Doing a Graphics.Save() does not save a picture. What really saves the changes you have made is the tempBmp.Save() line.

Graphics.RotateTransform() does not rotate my picture

I have problem with Graphics.RotateTransfrom() with the following code :
Dim newimage As Bitmap
newimage = System.Drawing.Image.FromFile("C:\z.jpg")
Dim gr As Graphics = Graphics.FromImage(newimage)
Dim myFontLabels As New Font("Arial", 10)
Dim myBrushLabels As New SolidBrush(Color.Black)
Dim a As String
'# last 2 number are X and Y coords.
gr.DrawString(MaskedTextBox2.Text * 1000 + 250, myFontLabels, myBrushLabels, 1146, 240)
gr.DrawString(MaskedTextBox2.Text * 1000, myFontLabels, myBrushLabels, 1146, 290)
a = Replace(Label26.Text, "[ mm ]", "")
gr.DrawString(a, myFontLabels, myBrushLabels, 620, 1509)
a = Replace(Label5.Text, "[ mm ]", "")
gr.DrawString(a, myFontLabels, myBrushLabels, 624, 548)
gr.RotateTransform(90.0F)
gr.DrawString(a, myFontLabels, myBrushLabels, 0, 0)
PictureBox1.Image = newimage
I dont know why but my image in pictureBox1 is not rotated. Someone known solution ?
The issue at hand is that the RotateTransform method does not apply to the existing image.
Instead, it applies to the transformation matrix of the graphics object. Basically, the transformation matrix modifies the coordinate system used to add new items.
Try the following :
Dim gfx = Graphics.FromImage(PictureBox1.Image)
gfx.DrawString("Test", Me.Font, Brushes.Red, New PointF(10, 10))
gfx.RotateTransform(45)
gfx.DrawString("Rotate", Me.Font, Brushes.Red, New PointF(10, 10))
The first string is drawn normally, while the second is drawn rotated.
So what you need to do is create a new graphics object, apply your rotation, draw your source image onto the graphics (graphics.DrawImage), and then draw all your text :
' Easy way to create a graphisc object
Dim gfx = Graphics.FromImage(PictureBox1.Image)
gfx.Clear(Color.Black)
gfx.RotateTransform(90) ' Rotate by 90°
gfx.DrawImage(Image.FromFile("whatever.jpg"), New PointF(0, 0))
gfx.DrawString("Test", Me.Font, Brushes.Red, New PointF(10, 10))
gfx.DrawString("Rotate", Me.Font, Brushes.Red, New PointF(10, 10))
But beware of rotation, you'll find that you need to change the coordinates at which you draw your image (Or change the RenderingOrigin property of the graphics, setting it to the center of the image makes it easier to handle rotations), otherwise your picture won't be visible (it will be drawn, but off the visible part of the graphics).
Hope that helps