Calculate coordinates for rotated text plus bounding border - vb.net

I have a form that is going to allow a user to create custom "stamps" to place on a PDF. The form displays with a image of the first page of the pdf and I want the user to basically click on the screen where they want their stamp and be able to preview what its going to look like. Don't worry about any of the PDF stuff, I have that handled.
To make things snazzy, I have two copies of the image, the normal one and one with reduced brightness. I display the low brightness image and as the user moves the mouse over, a chunk of the original image is revealed or highlighted. I then display in that area the text the user is going to put on the PDF.
I allow the user to use the mousewheel to scroll and change the angle of the text they are placing (from -45 degrees to +45 degrees).
Here is my problem: I can't calculate the proper rectangles/coordinates. Sometimes everything looks great, other times (as font sizes change) they don't quite fit.
How do I calculate the x and y coordinates for:
placement of the rotated text
AND a bounding rectangle padding the text at its width and height with 10px
The code below works, until I start to crank up the font size, then everything gets out of skew.
First two images show text + bounding rectangle at smaller fonts. It looks good:
The next image shows that as the text size gets larger, my pixels are moving all around and gets chopped off. In even larger text, the widths/heights end being way off as well.
Sorry the example images don't show much detail. I have actual data that I can't share.
Private Sub PanelMouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) '// handles the mouse move (handler added elsehwere)
With CType(sender, PictureBox)
.Image.Dispose() '// get rid of old image
Dim b As Bitmap = _curGray.Clone '// the low brightness image as the base image
'// stamp font and text values are initiated from another form
Using g As Graphics = Graphics.FromImage(b),
f As New Font(DefaultFont.FontFamily, CSng(_stmpTools.StampTextSize), If(_stmpTools.StampBold, FontStyle.Bold, FontStyle.Regular))
Const borderWidth As Integer = 10
Const borderPadding As Integer = 5
'// measure the string
Dim szx As SizeF = g.MeasureString(_stmpTools.StampText, f, Integer.MaxValue, StringFormat.GenericDefault)
Dim strLength As Single = szx.Width
Dim strHeight As Single = szx.Height
Dim x As Single = e.X - borderWidth - borderPadding,
y As Single = e.Y
Dim w As Double, h As Double
If Math.Abs(_angle) > Double.Epsilon Then
h = CDbl(strLength) * Math.Sin(CDbl(Math.Abs(_angle)) * Math.PI / 180.0F)
w = Math.Sqrt(CDbl(strLength) * CDbl(strLength) - h * h)
Else
'// its zero. so use calculated values
h = strHeight
w = strLength
End If
'// add space for the 10px border plus 5px of padding
Dim r As New Rectangle(0, 0, w, h)
r.Inflate(borderWidth + borderPadding, borderWidth + borderPadding)
h = r.Height
w = r.Width
'// keep box from moving off the left
If x < .Location.X Then
x = .Location.X
End If
'// keep box from moving off the right
If x > .Location.X + .Width - w Then
x = .Location.X + .Width - w
End If
'// I don't know, but these values work for most smaller fonts, but
'// it has got to be a fluke
If _angle > 0 Then
y = y - h + borderWidth + borderWidth
Else
y = y - borderWidth
End If
'// can't go off the top
If y < .Location.Y Then
y = .Location.Y
End If
'// can't go off the bottom
If y > .Location.Y + .Height - h Then
y = .Location.Y + .Height - h
End If
Dim rect As New Rectangle(x, y, w, h)
g.DrawImage(_curImg, rect, rect, GraphicsUnit.Pixel)
Using br As New SolidBrush(_stmpTools.StampTextColor)
RotateString(_stmpTools.StampText, _angle, e.X, e.Y, f, g, br)
End Using
'//draw bounding rectangle
Using p As New Pen(Color.Black, borderWidth)
g.DrawRectangle(p, rect)
End Using
End Using
'// set the picture box to show the new image
.Image = b
End With
End Sub
Private Sub RotateString(ByVal Text As String, ByVal angle As Integer, _
ByVal x As Integer, ByVal y As Integer, myfont As Font, mydrawing As Graphics, myColor As Brush)
Dim myMatrix As New Matrix
myMatrix.RotateAt(angle * -1, New Point(x, y)) 'Rotate drawing
mydrawing.Transform = myMatrix
mydrawing.DrawString(Text, myFont, myColor, x, y) 'Draw the text string
myMatrix.RotateAt(angle, New Point(x, y)) 'Rotate back
mydrawing.Transform = myMatrix
End Sub
I'm not the greatest when it comes to drawing. So any help would be great
Using the solution below from #LarsTech. I replaced the g.FillRectangle with:
g.DrawImage(_curImg, r, r, GraphicsUnit.Pixel)
_curImg is a copy of the original image with the brightness tuned up. When I change the code from below I end up with:
Note the double lines. They rotate with the stamp, even though they are acting as a background image and should be unrotated
Per suggestion, I changed the DrawStamp from #LarsTech to the following:
Private Sub DrawStamp(g As Graphics, text As String,
f As Font, center As Point, angle As Integer, backImg As Image)
Dim s As Size = g.MeasureString(text, f).ToSize
Dim r As New Rectangle(center.X - (s.Width / 2) - 16,
center.Y - (s.Height / 2) - 16,
s.Width + 32,
s.Height + 32)
g.DrawImage(backImg, r, r, GraphicsUnit.Pixel)
Using m As New Matrix
m.RotateAt(angle, center)
g.Transform = m
Using p As New Pen(Color.Black, 6)
g.DrawRectangle(p, r)
End Using
Using sf As New StringFormat
sf.LineAlignment = StringAlignment.Center
sf.Alignment = StringAlignment.Center
g.DrawString(text, f, Brushes.Black, r, sf)
End Using
g.ResetTransform()
End Using
End Sub
However, I am now left with
Notice it drew the background, then did the rotation and drew the stamp. It ALMOST works. In this example the straight lines show the intended behavior... however i'm looking to fill the entire stamp with the background. That extra white on the sides would have been what was rotated into the stamp's background. I'm confused because the 'grey' portions I would then suspect to be clipping out parts of the image, but they aren't (if i move it over other areas that I unfortunately can't post on here) notice is out of skew except for the fact that the sides of the rectangle paint as such.
Another Edit with hopefully some more info
Here is hopefully a better explaination of what I am trying to do. I use a third party PDF viewer and I need to allow the user to add an image to the PDF. The viewer doesn't allow me to raise click events on it, so in order to grab user mouse clicks, I do the following:
Take a screen grab of form
Hide the PDF Viewer
Add a PictureBox control to my form, replacing the area where the PDF viewer was
With my screen grab, I make a copy of the image with the brightness reduced
Display the gray scale copy of the image and draw directly on the image using mouse over events on the picturebox
I draw a stamp on the picturebox, but want the background of it to be the original (non adjusted brightness image). However, since the area might be transformed using a rotation, I can't grab the background image. If no angle is provided, the source rectangle matches. However if its rotated, I cannot grab the same rotated rectangle off the source image.
Button Click Event:
Dim bds As Rectangle = AxDPVActiveX1.Bounds
Dim pt As Point = AxDPVActiveX1.PointToScreen(bds.Location)
Using bit As Bitmap = New Bitmap(bds.Width, bds.Height)
Using g As Graphics = Graphics.FromImage(bit)
g.CopyFromScreen(New Point(pt.X - AxDPVActiveX1.Location.X, pt.Y - AxDPVActiveX1.Location.Y), Point.Empty, bds.Size)
End Using
_angle = 0
_curImg = bit.Clone
_curGray = Utils.CopyImageAndAdjustBrightness(bit, -100)
End Using
Dim p As New PictureBox
Utils.SetControlDoubleBuffered(p)
p.Dock = DockStyle.Fill
p.BackColor = Color.Transparent
AxDPVActiveX1.Visible = False
p.Image = _curImg.Clone
AddHandler p.MouseClick, AddressOf PanelDownMouse
AddHandler p.MouseMove, AddressOf PanelMouseMove
AddHandler p.MouseWheel, Sub(s As Object, ee As MouseEventArgs)
_angle = Math.Max(Math.Min(_angle + (ee.Delta / 30), 45), -45)
PanelMouseMove(s, ee)
End Sub
AddHandler p.MouseEnter, Sub(s As Object, ee As EventArgs)
CType(s, Control).Focus()
End Sub
AxDPVActiveX1.Parent.Controls.Add(p)
After that code I end up with two images. _curgray is an image with adjusted brightness, and _curImg is my original screen grab.
_curGray:
_curImg:
A mouseMove move event is applied to my new picture box. This is where all the code from earlier in the question comes into play.
Using the code above, my mouseMove event keeps creating a new imageto display in my picture box. If there is no rotation involved, I get pretty much what I'm looking for. Notice in the below image how the background of the stamp is brighter than everything. The portion over the blue square is slightly lighter. I am using this a way to draw the viewers eye to this area... its important for what I'm doing.
However, when applying a rotation to it, I cannot seem to copy from the original image. Look at the following image, the backgroundisn't rotating with it. I need to grab a rotated rectangle from the ORIGINAL image.
http://msdn.microsoft.com/en-us/library/ms142040(v=vs.110).aspx Graphics.DrawImage() accepts
Public Sub DrawImage ( _
image As Image, _
destRect As Rectangle, _
srcRect As Rectangle, _
srcUnit As GraphicsUnit _
)
where I can specify copy this source rectangle from my source image (in this case _curImg) and place onto my new drawing. It does not allow me to apply a transformation to the source rectangle. Basically I want to copy from my source image an area equivalent to the rotated rectangle (based on the transformation from #larstech )
I don't know how to express this concept any clearer. If it still doesn't make sense I will just accept LarsTech answer as the best answer and scrap my idea.

It's just trigonometry:
You know c because you know how wide the original text is, and you know h because you know the height of your text. You also need to know alpha, it's the angle that you rotated your text.
Now you need to work the power of math: First take the small rectangles at the end. In the bottom left you can see, that the angle right of the x is actually 180°-90°-alpha, or 90°-alpha. So alpha is also found on the opposite site. So you can find x:
x = h * sin(alpha)
The same goes for y, but it's either sin(90°-alpha), or cos(alpha)
y = h * cos(alpha)
Next you need to find a and b to complete the rectangle. The large triangle gives you
a = w * cos(alpha)
and
b = w * sin(alpha)
Then just add the parts together:
NewWidth = a + x
NewHeight = b + y
That way you get the size of the bounding box. As for the coordinates, it depends on which point is actually defined when you print the rotated text.

I would try drawing the rectangle and the text together:
Private Sub DrawStamp(g As Graphics, text As String,
f As Font, center As Point, angle As Integer)
Using m As New Matrix
g.SmoothingMode = SmoothingMode.AntiAlias
g.TextRenderingHint = TextRenderingHint.AntiAlias
m.RotateAt(angle, center)
g.Transform = m
Dim s As Size = g.MeasureString(text, f).ToSize
Dim r As New Rectangle(center.X - (s.Width / 2) - 16,
center.Y - (s.Height / 2) - 16,
s.Width + 32,
s.Height + 32)
g.FillRectangle(Brushes.White, r)
Using p As New Pen(Color.Black, 6)
g.DrawRectangle(p, r)
End Using
Using sf As New StringFormat
sf.LineAlignment = StringAlignment.Center
sf.Alignment = StringAlignment.Center
g.DrawString(text, f, Brushes.Black, r, sf)
End Using
g.ResetTransform()
End Using
End Sub
The paint example:
Protected Overrides Sub OnPaint(e As PaintEventArgs)
MyBase.OnPaint(e)
e.Graphics.Clear(Color.LightGray)
Using f As New Font("Calibri", 16, FontStyle.Bold)
DrawStamp(e.Graphics,
"Reviewed By Doctor Papa",
f,
New Point(Me.ClientSize.Width / 2, Me.ClientSize.Height / 2),
-25)
End Using
End Sub
Result:
Here I updated the code to "clip" the rotated rectangle so that I can copy that same area from the original image before applying the text and border:
Private Sub DrawStamp(g As Graphics, text As String,
f As Font, center As Point, angle As Integer)
Dim s As Size = g.MeasureString(text, f).ToSize
Dim r As New Rectangle(center.X - (s.Width / 2) - 16,
center.Y - (s.Height / 2) - 16,
s.Width + 32,
s.Height + 32)
Using bmp As New Bitmap(_curImg.Width, _curImg.Height)
Using gx As Graphics = Graphics.FromImage(bmp)
Using m As New Matrix
m.RotateAt(angle, center)
gx.Transform = m
gx.SetClip(r)
gx.ResetTransform()
End Using
gx.DrawImage(_curImg, Point.Empty)
End Using
g.DrawImage(bmp, Point.Empty)
End Using
Using m As New Matrix
g.SmoothingMode = SmoothingMode.AntiAlias
g.TextRenderingHint = TextRenderingHint.AntiAlias
m.RotateAt(angle, center)
g.Transform = m
Using p As New Pen(Color.Black, 6)
g.DrawRectangle(p, r)
End Using
Using sf As New StringFormat
sf.LineAlignment = StringAlignment.Center
sf.Alignment = StringAlignment.Center
g.DrawString(text, f, Brushes.Black, r, sf)
End Using
g.ResetTransform()
End Using
End Sub
New Result:

Related

How can I generate the faces of a YCbCr cube in VB.NET

I have written a program in VB.NET to generate just one face of a YCbCr colour space cube. I want the final image to look similar to the CbCr plane at constant luma on Wikipedia (where Y=1).
Ultimately, I want to create images of all 6 faces of the cube, so that I can make an animated 3D cube in Photoshop (I already know how to create the cube in Photoshop once I have images of its faces). The finished cube will look similar to the YUV cube on the softpixel website.
Below is the output of my program and the code so far. I had no trouble generating the faces of an RGB colour space cube, but the YCbCr cube is proving problematic. I have applied a YCbCr conversion formula to each pixel in the face of an RGB cube, but the centre of the front face should be white and the centre of the opposite face should be black. Can someone please tell me what code I am missing?
Public Class Form2
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
PictureBox1.Width = 255
PictureBox1.Height = 255
'create new bitmap
Dim newbmp As Bitmap = New Bitmap(255, 255)
'Generate the new image
Dim x As Integer
Dim y As Integer
For y = 0 To 254
For x = 0 To 254
Dim yval As Integer
Dim cb As Integer
Dim cr As Integer
'Convert to YCbCr using these formulas
'0+(0.299*RED)+(0.587*GREEN)+(0.114*BLUE)
'128-(0.168736*RED)-(0.331264*GREEN)+(0.5*BLUE)
'128+(0.5*RED)-(0.418688*GREEN)-(0.081312*BLUE)
yval = Math.Floor(0 + (0.299 * x) + (0.587 * y) + (0.114 * 255))
cb = Math.Floor(128 - (0.168736 * x) - (0.331264 * y) + (0.5 * 255))
cr = Math.Floor(128 + (0.5 * x) - (0.418688 * y) - (0.081312 * 255))
newbmp.SetPixel(x, y, Color.FromArgb(yval, cb, cr))
Next x
Next y
'load image into picturebox
PictureBox1.Image = newbmp
End Sub
End Class

Visual basic create graphics form picturebox then draw shapes

On form load event I create graphics from an empty (no image) picturebox called PB_Pixel_Layout.
Private Sub Main_From_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Pixel_Graphics = PB_Pixel_Layout.CreateGraphics
End Sub
I then draw a bunch of filled ellipses through the SetPixel(). The ellipses get drawn on the picturebox but takes 2 cycles of the the SetPixel() to show. There is also a double window image when the program starts the causes a lag and not sure what is causing the problem but I assume I have not setup the graphics correctly. I tried to run by creating a bitmap at run time instead of using a picturebox and it worked fine so the issue is narrowed down to the create graphics from picturebox. I also tried to loading an image to the picturebox properties but did not make a difference.
Private Sub SetPixel_Grid_Bitmap()
Pen_Grid = New Pen(Color.Gray)
Selected_Pen = New Pen(Color.Yellow)
'draw
For Col = 0 To intColumnCount
For Row = 0 To intRowCount
B_Color = Color.FromArgb(intPatternColorsRed(strhexPixelHexValue(intCounter + intBank)), intPatternColorsGreen(strhexPixelHexValue(intCounter + intBank)), intPatternColorsBlue(strhexPixelHexValue(intCounter + intBank)))
Brush_B = New SolidBrush(B_Color)
'// Grid
Pixel_Graphics.DrawEllipse(Pen_Grid, StartLocation.X + (Col * (intScale + 6)), StartLocation.Y + (Row * (intScale + 6)), intScale, intScale)
'// Fill with color
Pixel_Graphics.FillEllipse(Brush_B, StartLocation.X + (Col * (intScale + 6)) + 2, StartLocation.Y + (Row * (intScale + 6)) + 2, intScale - 4, intScale - 4)
'// Selected
If ArrPixelData_Array(intCounter)(P_Selected) = 1 Then
Pixel_Graphics.DrawEllipse(Selected_Pen, StartLocation.X + (Col * (intScale + 6)), StartLocation.Y + (Row * (intScale + 6)), intScale, intScale)
End If
intCounter = intCounter + 1
Next Row
Next Col
End Sub
Here is the update
Public Sub RefreshDrawing()
bm = New Bitmap(PB_Pixel_Layout.Width, PB_Pixel_Layout.Height)
Using g As Graphics = Graphics.FromImage(BB)
g.SmoothingMode = SmoothingMode.AntiAlias
g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
g.TextRenderingHint = System.Drawing.Text.TextRenderingHint.AntiAlias
End Using
PB_Pixel_Layout.Image = bm ' assign drawn bitmap to picturebox
End Sub
I would suggest to declare a global bitmap
Dim bm As Bitmap
And create a refresh function like (just a general suggestion):
Public Sub RefreshDrawing()
bm = New Bitmap(Me.Drawing.Width, Me.Drawing.Height)
Using g = Graphics.FromImage(bm)
g.SmoothingMode = SmoothingMode.AntiAlias
g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
g.TextRenderingHint = System.Drawing.Text.TextRenderingHint.AntiAlias
Dim r as New RectangleF (200, 100, 400, 300)
g.FillEllipse(pDrwStyle.dstBrush, r) ' draw inside points (area)
g.DrawEllipse(pDrwStyle.dstPen, Rectangle.Round(r)) ' draw ellipse border
End Using
Me.PictureBox1.Image = bm ' assign drawn bitmap to picturebox
End Sub
And in you load event (and perhaps a Refresh button) put simply:
Call RefreshDrawing()
This is very fast and reliable way of drawing graphics.
I would suggest not to use Paint event. Only for temporary drawing, such as drawing in MouseMove mode and such.
As an Alternate suggestion, you could draw it all to a buffer then render that when required.
Like this:
Dim myContext As New BufferedGraphicsContext
Dim mybuff As System.Drawing.BufferedGraphics
(As Globals)
Then add this* before you start drawing anything.
mybuff = myContext.Allocate(picturebox1.CreateGraphics, rectangle)
mybuff.Graphics.CompositingMode = Drawing2D.CompositingMode.SourceOver
mybuff.Graphics.CompositingQuality = Drawing2D.CompositingQuality.AssumeLinear
mybuff.Graphics.SmoothingMode = Drawing2D.SmoothingMode.None
mybuff.Graphics.InterpolationMode = CType(Drawing2D.QualityMode.Low, Drawing2D.InterpolationMode)
mybuff.Graphics.PixelOffsetMode = Drawing2D.PixelOffsetMode.None
*Only first line is required the rest is an example custom configuration.
rectangle is the size of your buffer, it needs to be at least as large as the images destination (picturebox1)
To draw into the buffer just type mybuff.Graphics...
eg.
mybuff.Graphics.FillRectangle(colbrush,50,50, 4, 4)
mybuff.Graphics.FillEllipse(colbrush, 100, 100, 50, 30)
...
When done building the image it needs to be rendered/painted onto the target (picturebox1) like so:
mybuff.Render
The render does not need to come directly after the drawing it can be called from anywhere in your code. So its up to you when it is painted and how often.
Also doing it like this is much faster than drawing directly to a target.
Lastly dispose of my buff and mycontext when you are done with them.
[EDIT]
Forgot to mention that you can also render the buffer to other targets like so:
Mybuff.Render(picturebox2.CreateGraphics)
Mybuff.Render(picturebox47.CreateGraphics)

How can I copy a graphic drawn on a PictureBox to clipboard?

I have a software that builds a 3D text by using grafx.DrawString() and I need to copy this graphic to clipboard. When I try to do so, it throws a NullReferenceException.
How can I copy the graphics drawn on a PictureBox?
This is the code to draw the text:
Dim grafx As Graphics
Private Sub draw_block_text10()
Dim text_size As SizeF
Dim back_brush As Brush = Brushes.Black 'COLOR FOR THE BOARDER TEXT
Dim fore_brush As Brush = Brushes.Blue 'COLOR FOR THE MAIN TEXT
Dim fnt As New Font("Microsoft Sans Serif", NumericUpDown1.Value, FontStyle.Regular)
Dim location_x, location_y As Single 'USED IT FOR THE LOCATION
Dim i As Integer
'CREATE A GRAPHIC OBJECT IN THE PICTUREBOX.
grafx = Me.PictureBox2.CreateGraphics()
'CLEAR THE PICTUREBOX
grafx.Clear(Color.White)
'LOOK THE REQUIRED SIZE TO DRAW THE TEXT
text_size = grafx.MeasureString(Me.TextBox1.Text, fnt)
'ELIMINATE THE REDUNDANT CAlCULATION AFTER GETTING THE LOCATION.
location_x = (Me.PictureBox2.Width - text_size.Width) / 2
location_y = (Me.PictureBox2.Height - text_size.Height) / 2
'FIRST, DRAW THE BLACK BACKGROUND TO GET THE EFFECT,
'AND THE TEXT MUST BE DRAWN REAPETEDLY FROM THE OFFSET RIGHT, UP TO THE MAIN TEXT IS DRAWN.
For i = CInt(nupDepth.Value) To 0 Step -1
grafx.DrawString(TextBox1.Text, fnt, back_brush, _
location_x - i, location_y + i)
Next
Dim mydataandtimeforsave = DateTime.Now.ToString("yyyyMMddHHmmss")
'DRAW THE ROYAL BLUE FOR THE MAIN TEXT OVER THE BLACk TEXT
grafx.DrawString(TextBox1.Text, fnt, fore_brush, location_x, location_y)
Dim bmp As New Bitmap(Me.PictureBox2.Width, Me.PictureBox2.Height)
Dim g As Graphics = Graphics.FromImage(bmp)
g.Clear(Color.Transparent)
''Perform Drawing here
End Sub
This is the code to copy to clipboard:
Clipboard.SetDataObject( _
DirectCast(PictureBox2.Image.Clone, Bitmap), _
True)
Beep()
Using a Graphics object created from a PictureBox control (PictureBox.CreateGraphics()) to draw on doesn't actually set/change the Image property of the PictureBox. You can confirm that by checking for PictureBox2.Image Is Nothing, which will return true if the PictureBox had no image before drawing on it.
Instead, create an Image with the dimensions of the PictureBox, use Graphics.FromImage() to create your Graphics object, draw what you need to draw, and then assign the image to the PictureBox.Image property.
Something like this should work fine:
Dim bmp As New Bitmap(PictureBox2.Width, PictureBox2.Height)
Using g As Graphics = Graphics.FromImage(bmp)
g.Clear(Color.White)
text_size = g.MeasureString(Me.TextBox1.Text, fnt)
location_x = (Me.PictureBox2.Width - text_size.Width) / 2
location_y = (Me.PictureBox2.Height - text_size.Height) / 2
For i = CInt(nupDepth.Value) To 0 Step -1
g.DrawString(TextBox1.Text, fnt, back_brush, location_x - i, location_y + i)
Next
g.DrawString(TextBox1.Text, fnt, fore_brush, location_x, location_y)
End Using
PictureBox2.Image = bmp
Note: Always remember to dispose the created Graphics object when you finish using it either by calling .Dispose() or by wrapping it in a Using statement like what I did above.
Instead of
Clipboard.SetDataObject(DirectCast(PictureBox2.Image.Clone, Bitmap), True)
Use
Clipboard.SetDataObject(PictureBox2.Image, 2)

Drawing rect in picturebox not done to right scale for mouse

I currently have a picture box where the user will click and drag to draw a rectangle over an image (one that can be changed regularly). When they're done (mouse_up), I will display the relative points of the rect in a text box to the resolution.
So, for example, the user draws from top left (0,0) to bottom right of a 1920 x 680 image (picturebox.right, picturebox.bottom) for a rect, the text box will show (1920,680) for the end point. That's mostly just ratio stuff.
I am using the code from an answer of a previous question of mine (Having trouble drawing simple rectangle in picturebox) to draw it.
The Problem: The box doesn't follow the mouse since the images have to be done in stretch mode. They're usually pretty large (like 1920 x 680) and can't fit in a regular gui. There are multiple resolutions, so got to go dynamic with the ratios. Without editing, this code works great in normal mode, but that doesn't work for usability. So, when you draw the box, it's really small and not relative to the mouse (so I can't display the end point on the textboxes).
Here's an example of what I mean. I've dragged my mouse halfway across the image:
What I've tried: I've attempted to counter act it by ratios, but it still doesn't fix the displaying the end point issue, or does it really follow the mouse that well. It's usually off by at least 10 or so pixels to the left. Here's my adjusted code for that:
Private Sub DrawRectangle(ByVal pnt As Point)
Try
Dim g As Graphics
g = Graphics.FromImage(img)
g.DrawImage(imgClone, 0, 0) 'we are clearing img with imgClone. imgClone contains the original image without the rectangles
Dim w_ratio As Integer = Math.Floor(img.Width / pbZoneImage.Width)
Dim h_ratio As Integer = Math.Floor(img.Height / pbZoneImage.Height)
Dim customPen As New Pen(currentColor, 5)
'If pnt.X = mouse_Down.X Or pnt.Y = mouse_Down.Y Then
' g.DrawLine(customPen, mouse_Down.X, mouse_Down.Y, pnt.X * w_ratio, pnt.Y * h_ratio)
'Else
theRectangle = New Rectangle(Math.Min(mouse_Down.X, pnt.X * w_ratio), Math.Min(mouse_Down.Y, pnt.Y * h_ratio),
Math.Abs(mouse_Down.X - pnt.X * w_ratio), Math.Abs(mouse_Down.Y - pnt.Y * h_ratio))
g.DrawRectangle(customPen, theRectangle)
'End If
g.Dispose()
pbZoneImage.Invalidate() 'draw img to picturebox
Catch ex As Exception
End Try
End Sub
I've also tried just getting the end display point (x,y) to match the relative end of the rectangle, but again it isn't working with the ratios.
Any ideas on how to make this work as well as it does in normal mode as it does in stretch? I'm also open to different controls or just any tips in general. Thanks!
This can be done with many ways but the easiest is to use a picturebox with SizeMode = Normal. Load your images:
img = New Bitmap(pbZoneImage.Width, pbZoneImage.Height)
imgClone = My.Resources.... 'real dimensions
Dim g As Graphics = Graphics.FromImage(img)
'it will scale the image, no need for stretch mode
g.DrawImage(imgClone, 0, 0, pbZoneImage.Width, pbZoneImage.Height)
g.Dispose()
pbZoneImage.Image = img
Then draw normally:
Private Sub DrawRectangle(ByVal pnt As Point)
Try
Dim g As Graphics
g = Graphics.FromImage(img)
g.DrawImage(imgClone, 0, 0, pbZoneImage.Width, pbZoneImage.Height) 'we are clearing img with imgClone. imgClone contains the original image without the rectangles
Dim customPen As New Pen(currentColor, 5)
'If pnt.X = mouse_Down.X Or pnt.Y = mouse_Down.Y Then
' g.DrawLine(customPen, mouse_Down.X, mouse_Down.Y, pnt.X * w_ratio, pnt.Y * h_ratio)
'Else
theRectangle = New Rectangle(Math.Min(mouse_Down.X, pnt.X), Math.Min(mouse_Down.Y, pnt.Y),
Math.Abs(mouse_Down.X - pnt.X), Math.Abs(mouse_Down.Y - pnt.Y))
g.DrawRectangle(customPen, theRectangle)
'End If
g.Dispose()
pbZoneImage.Invalidate() 'draw img to picturebox
Catch ex As Exception
End Try
End Sub
In mouse up event scale to get the correct result:
Private Sub pbZoneImage_MouseUp(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles pbZoneImage.MouseUp
Dim width, height As Integer
width = CInt(Math.Abs(mouse_Down.X - e.X) * (imgClone.Width / pbZoneImage.Width))
height = CInt(Math.Abs(mouse_Down.Y - e.Y) * (imgClone.Height / pbZoneImage.Height))
TextBox1.Text = width.ToString + " " + height.ToString
End Sub

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)