• 0

[VB.NET] Polygon from image


Question

Hello gang,

I have an issue at work where we need to take parts of an original image and make new images. Think for example a newspaper page. The original page shows many articles and we need to save images for each individual article. The code below works fine if we have a rectangle. But of course, this is not always the case. If we had to grab part of an image that was not a rectangle we would need to use polygons.

The second chunk of code can draw a polygon... but I cant seem to get .DrawImage to use the Points .... what dumb@$$ thing am I doing. Thanks

----------

'Draw rectangle (this code WORKS!!!!)

Dim lWidth As Long = 110

Dim lHeight As Long = 170

Dim lLeft As Long = 260

Dim lTop As Long = 140

Dim bmpImage As Bitmap = Image.FromFile("c:\test.jpg")

Dim bmpCrop As Bitmap

Dim gphCrop As Graphics

Dim recCrop As Rectangle

Dim recDest As Rectangle

'Display the source image (not nessasary to display, but just in case)

Me.picSource.Image = bmpImage

recCrop = New Rectangle(lLeft, lTop, lWidth, lHeight)

bmpCrop = New Bitmap(recCrop.Width, recCrop.Height, bmpImage.PixelFormat)

gphCrop = Graphics.FromImage(bmpCrop)

recDest = New Rectangle(0, 0, lWidth, lHeight)

gphCrop.DrawImage(bmpImage, recDest, recCrop.X, recCrop.Y, recCrop.Width, recCrop.Height, GraphicsUnit.Pixel)

Me.picClip.Image = bmpCrop 'Show the portion of the original clip

--------------------------------------------------

'Draw polygon. This code almost works

Dim lWidth As Long = 110

Dim lHeight As Long = 170

Dim lLeft As Long = 260

Dim lTop As Long = 140

Dim bmpImage As Bitmap = Image.FromFile("c:\test.jpg")

Dim bmpCrop As Bitmap

Dim gphCrop As Graphics

Dim recCrop As Rectangle

Dim recDest As Rectangle

Me.picSource.Image = bmpImage

Dim myGraphics As Graphics

myGraphics = Graphics.FromImage(bmpImage)

Dim myPoints(6) As Point

myPoints(0) = New Point(15, 20)

myPoints(1) = New Point(25, 15)

myPoints(2) = New Point(35, 20)

myPoints(3) = New Point(35, 40)

myPoints(4) = New Point(25, 45)

myPoints(5) = New Point(15, 40)

myPoints(6) = New Point(15, 20)

'This line works, as it does display a polygon shap on the original image

myGraphics.DrawPolygon(pen:=New Pen(Color.Red, Width:=1), points:=myPoints)

recCrop = New Rectangle(lLeft, lTop, lWidth, lHeight)

bmpCrop = New Bitmap(recCrop.Width, recCrop.Height, bmpImage.PixelFormat)

gphCrop = Graphics.FromImage(bmpCrop)

recDest = New Rectangle(0, 0, lWidth, lHeight)

gphCrop.DrawImage(bmpImage, recDest, recCrop.X, recCrop.Y, recCrop.Width, recCrop.Height, GraphicsUnit.Pixel)

'This is where the code doesnt work (boo, hiss!)

gphCrop.DrawImage(bmpImage, myPoints(0)) '<- not working... hummmm

Me.picClip.Image = bmpCrop

Link to comment
https://www.neowin.net/forum/topic/571104-vbnet-polygon-from-image/
Share on other sites

7 answers to this question

Recommended Posts

  • 0
  jameswjrose said:
Hello gang,

I have an issue at work where we need to take parts of an original image and make new images. Think for example a newspaper page. The original page shows many articles and we need to save images for each individual article. The code below works fine if we have a rectangle. But of course, this is not always the case. If we had to grab part of an image that was not a rectangle we would need to use polygons.

The second chunk of code can draw a polygon... but I cant seem to get .DrawImage to use the Points .... what dumb@$$ thing am I doing. Thanks

----------

'Draw rectangle (this code WORKS!!!!)

Dim lWidth As Long = 110

Dim lHeight As Long = 170

Dim lLeft As Long = 260

Dim lTop As Long = 140

Dim bmpImage As Bitmap = Image.FromFile("c:\test.jpg")

Dim bmpCrop As Bitmap

Dim gphCrop As Graphics

Dim recCrop As Rectangle

Dim recDest As Rectangle

'Display the source image (not nessasary to display, but just in case)

Me.picSource.Image = bmpImage

recCrop = New Rectangle(lLeft, lTop, lWidth, lHeight)

bmpCrop = New Bitmap(recCrop.Width, recCrop.Height, bmpImage.PixelFormat)

gphCrop = Graphics.FromImage(bmpCrop)

recDest = New Rectangle(0, 0, lWidth, lHeight)

gphCrop.DrawImage(bmpImage, recDest, recCrop.X, recCrop.Y, recCrop.Width, recCrop.Height, GraphicsUnit.Pixel)

Me.picClip.Image = bmpCrop 'Show the portion of the original clip

--------------------------------------------------

'Draw polygon. This code almost works

Dim lWidth As Long = 110

Dim lHeight As Long = 170

Dim lLeft As Long = 260

Dim lTop As Long = 140

Dim bmpImage As Bitmap = Image.FromFile("c:\test.jpg")

Dim bmpCrop As Bitmap

Dim gphCrop As Graphics

Dim recCrop As Rectangle

Dim recDest As Rectangle

Me.picSource.Image = bmpImage

Dim myGraphics As Graphics

myGraphics = Graphics.FromImage(bmpImage)

Dim myPoints(6) As Point

myPoints(0) = New Point(15, 20)

myPoints(1) = New Point(25, 15)

myPoints(2) = New Point(35, 20)

myPoints(3) = New Point(35, 40)

myPoints(4) = New Point(25, 45)

myPoints(5) = New Point(15, 40)

myPoints(6) = New Point(15, 20)

'This line works, as it does display a polygon shap on the original image

myGraphics.DrawPolygon(pen:=New Pen(Color.Red, Width:=1), points:=myPoints)

recCrop = New Rectangle(lLeft, lTop, lWidth, lHeight)

bmpCrop = New Bitmap(recCrop.Width, recCrop.Height, bmpImage.PixelFormat)

gphCrop = Graphics.FromImage(bmpCrop)

recDest = New Rectangle(0, 0, lWidth, lHeight)

gphCrop.DrawImage(bmpImage, recDest, recCrop.X, recCrop.Y, recCrop.Width, recCrop.Height, GraphicsUnit.Pixel)

'This is where the code doesnt work (boo, hiss!)

gphCrop.DrawImage(bmpImage, myPoints(0)) '<- not working... hummmm

Me.picClip.Image = bmpCrop

Shouldn't this,gphCrop.DrawImage(bmpImage, myPoints(0)) , be this, gphCrop.DrawImage(bmpImage, myPoints) ? Otherwise, you're only passing in one point.

  • 0
  azcodemonkey said:
Shouldn't this,gphCrop.DrawImage(bmpImage, myPoints(0)) , be this, gphCrop.DrawImage(bmpImage, myPoints) ? Otherwise, you're only passing in one point.

I believe I tried that too. (Not at work so...) I'll retry in the morning.

Thanks again CodeMonkey

  • 0

I did try again, no luck. I did find the following code, but it takes an image and fills it into the shape. What I need is to allow the user to create a shape on an image, and then take the data within that shape and create another image.

ANY help.... please (Im not above beggin!)

'This is some code that came from within MSDN.

Public Sub DrawImagePara(e As PaintEventArgs)

' Create image.

Dim newImage As Image = Image.FromFile("SampImag.jpg")

' Create parallelogram for drawing image.

Dim ulCorner As New Point(100, 100)

Dim urCorner As New Point(550, 100)

Dim llCorner As New Point(150, 250)

Dim destPara As Point() = {ulCorner, urCorner, llCorner}

' Draw image to screen.

e.Graphics.DrawImage(newImage, destPara)

End Sub

  • 0

I think you need another approach. /old man voice Back in my day, when I'd program Win32, we'd use regions to crop images to a given shape, and we liked it!

You could create a GraphicsPath from the points you collect from the user. From that, you could generate a region. Get the region for your selected image, and intersect them with an XOR. The result would be your image cropped to the shape of the polygon.

  • 0
  azcodemonkey said:
I think you need another approach. /old man voice Back in my day, when I'd program Win32, we'd use regions to crop images to a given shape, and we liked it!

You could create a GraphicsPath from the points you collect from the user. From that, you could generate a region. Get the region for your selected image, and intersect them with an XOR. The result would be your image cropped to the shape of the polygon.

Oh my... I think I recall reading about that... once upon a time. However, since we have MSDN Universal I got MS involved yesturday. I'm creating a document to send to them Thursday with the details and then we'll see what comes of it.

But I will keep your idea in mind too. Thanks kindly.

  • 0

Hello gang,

We used one of our MSDN support calls with MS to get an answer to the polygon question. I got this response today (took only a few hours to get the response, how great is that!)

I thought it best to post it here in case anyone else needs this sort of thing.

Peace,

James

' Code created by me:

Dim bmpImage As Bitmap = Image.FromFile("c:\test.jpg")

Dim myGraphics As Graphics

Dim myPoints(6) As Point

Me.picSource.Image = bmpImage

myGraphics = Graphics.FromImage(bmpImage)

myPoints(0) = New Point(15, 20)

myPoints(1) = New Point(25, 15)

myPoints(2) = New Point(35, 20)

myPoints(3) = New Point(35, 40)

myPoints(4) = New Point(25, 45)

myPoints(5) = New Point(15, 40)

myPoints(6) = New Point(15, 20)

'This line will display the polygon points,

'but is not nessasary for creating the secondary image

'myGraphics.DrawPolygon(pen:=New Pen(Color.Red, Width:=1), points:=myPoints)

'This line creates a new image based on the above points

Me.picClip.Image = Me.ExtractPolygonAreaOfBitmap(bmpImage, myPoints)

' New code from MS

'When passed a bitmap and an array of points, returns a new bitmap

'which contains the part of the source bitmap described by a polygon

'drawn through the points in the array

Private Function ExtractPolygonAreaOfBitmap(ByRef b As Bitmap, ByRef pts() As Point) As Bitmap

' A GraphicsPath will allow us to clip the output

Dim gp As New GraphicsPath()

' the path should be composed of the polygon

gp.AddPolygon(pts)

' ask the path to tell us how big the bounding rectangle is

' we'll need that later to construct a new bitmap of the right size

Dim rc As RectangleF = gp.GetBounds()

' and it needs to be translated to the origin for clipping

Dim m As New Matrix(1, 0, 0, 1, -rc.X, -rc.Y)

' Now we'll have a clipping path ready to use

gp.Transform(m)

' Create a new bitmap the same size as the polygon area

Dim bmp As New Bitmap(Convert.ToInt32(rc.Width), Convert.ToInt32(rc.Height))

' We need a Graphics so we can draw on our new bitmap

Dim g As Graphics = Graphics.FromImage(bmp)

' Initialize the new bitmap to some color (tranparent? white? your choice)

g.Clear(Color.Transparent)

' We're going to need a target rectangle too

Dim rcDraw As New RectangleF(0, 0, rc.Width, rc.Height)

' set up the clipping

g.Clip = New Region(gp)

' all set - now draw the clipped image

g.DrawImage(b, rcDraw, rc, GraphicsUnit.Pixel)

' clean up

gp.Dispose()

g.Dispose()

' return the result

Return bmp

End Function

This topic is now closed to further replies.
  • Recently Browsing   0 members

    • No registered users viewing this page.
  • Posts

    • They've been focusing on security and quality? Could have fooled me. Their own paying customers literally just got breached because they failed to push SharePoint updates downstream to on prem servers operating outside of their "365" ecosystem.
    • The animosity is unnecessary, when I opened the page I only saw one response which never mentioned your other steps, and when I hit reply it jumped straight to the bottom and again, I saw no other responses.  I was simply agreeing with the first comment that said yes, you should be fine if you erase its current operating system. Using another PC, or the copy of Windows that comes on that PC (former option is more trustworthy), download and run the Windows Media Creation tool.  It will walk you thru the process of downloading Windows and writing it to a USB stick.  It will even ask you at one point whether you're reinstalling it to the current machine or installing it on another machine. Then just boot the PC in question from that USB stick.  Usually spamming Esc, Del, F-8, F-9, F-10, F-11, F-12 or F-2 immediately after power on will bring up a boot menu, it varies by manufacturer.  If Windows starts booting you either missed your window or hit the wrong key. Follow the on-screen instructions.  When it gets to the disk formatting part I usually just delete all the partitions on the destination drive, then select the unpartitioned space as my destination.  The Windows installer will then automatically partition the drive as needed. Be prepared to download drivers from the PC manufacturer's website, they may not come bundled with Windows and you may not be able to use things like WiFi or ethernet until you have them.  They "might" work straight away, but they also might not.  Better to be prepared with a spare PC and a USB stick to transfer them over.
    • Wise Disk Cleaner 11.2.5 by Razvan Serea Wise Disk Cleaner is a free disk utility designed to help you keep your disk clean by deleting any unnecessary files. Usually, these unnecessary, or junk files appear as a result of program's incomplete uninstalls, or Temporary Internet Files. It is best if these files are wiped out from time to time, since they may, at some point, use a considerable amount of space on your drives. Wise Disk Cleaner, with its intuitive and easy to use interface, helps you quickly wipe out all the junk files. Using the program is indeed easy. It also works fast when both scanning for files and deleting files. The new Wise Disk Cleaner has more advantages: improved performance, better interface and scans/cleans more thoroughly. Wise Disk Cleaner Free provides lifetime free update service and Unlimited Free technical support. The first Slimming System software Wise Disk Cleaner is the first system slimming tool, which will help you to remove Windows useless files that you don't need, such as Korean IME, Windows Sample music, videos, pictures, Installers and Uninstallers of Updates Patches etc. Wise Disk Cleaner 11.2.5 Build 845 changelog: Added cleaning rules for Legacy Games Launcher, Letasoft Sound Booster, Macrium Reflect, MagicLine4NX, MAGIX Photostory, MakeHuman, Max Recorder, Maxprog iCash, Lexware, LG PC Suite, Lightworks, LINE, Listary, and LockHunter. Improved cleaning rules for Xunlei, PowerToys, Meitu, OneDrive, and Tencent Video. For security reasons, users can no longer delete the latest system restore point in the Restore Center. Enhanced System Slimming. Fixed minor bugs from the previous version. Download: Wise Disk Cleaner 11.2.5 | 6.9 MB (Freeware) Download: Portable Wise Disk Cleaner 11.2.5 | 7.3 MB View: Wise Disk Cleaner Home Page | Screenshot Get alerted to all of our Software updates on Twitter at @NeowinSoftware
    • I keep getting ignored when I ask what you guys mean by nuke it. I described the steps and I keep getting the same generic instructions. Can you look at what I have posted multiple times already and validate what I have described? You can't assume everyone has your level of expertise and can interpret your nuking advice. After this many posts in this thread, I don't think we need the same generic advice about just nuke it and reinstall. It's already been said. So can you please outline the specifics? Made in Ukraine? Are you sure?
  • Recent Achievements

    • Week One Done
      Itbob513626 earned a badge
      Week One Done
    • One Month Later
      Itbob513626 earned a badge
      One Month Later
    • Rookie
      EdwardFranciscoVilla went up a rank
      Rookie
    • Week One Done
      MoJo624 earned a badge
      Week One Done
    • Collaborator
      aeganwn earned a badge
      Collaborator
  • Popular Contributors

    1. 1
      +primortal
      617
    2. 2
      ATLien_0
      236
    3. 3
      Xenon
      156
    4. 4
      +FloatingFatMan
      120
    5. 5
      Michael Scrip
      114
  • Tell a friend

    Love Neowin? Tell a friend!