Graphics.RotateTransform() does not rotate my picture - vb.net

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

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

Pixelated Text When Using ObjectListView Custom Renderer

I found an example online of how to create a business card listview item using the ObjectListView. It demonstrates using a custom renderer to manually draw each Tile within the control.
The sample involves creating buffered graphics and manually drawing each item. I have this working, however, I am finding that all text I draw on the tile is looking pixelated (no matter what settings I use), especially if I draw small text. For example, using a default system font on a normal form looks fine, but in my renderer it looks jagered.
The code looks like this:
Imports BrightIdeasSoftware
Imports System.Drawing.Drawing2D
Imports System.IO
Public Class StoreListRenderer
Inherits AbstractRenderer
Public Overrides Function RenderItem(e As DrawListViewItemEventArgs, g As Graphics, itemBounds As Rectangle, rowObject As Object) As Boolean
' If we're in any other view than Tile, return false to say that we haven't done
' the rendereing and the default process should do it's stuff
Dim olv As ObjectListView = TryCast(e.Item.ListView, ObjectListView)
If olv Is Nothing OrElse olv.View <> View.Tile Then
Return False
End If
' Use buffered graphics to kill flickers
Dim buffered As BufferedGraphics = BufferedGraphicsManager.Current.Allocate(g, itemBounds)
g = buffered.Graphics
g.Clear(olv.BackColor)
g.SmoothingMode = ObjectListView.SmoothingMode
g.TextRenderingHint = ObjectListView.TextRenderingHint
If e.Item.Selected Then
Me.BorderPen = Pens.White
Me.HeaderBackBrush = New SolidBrush(olv.HighlightBackgroundColorOrDefault)
Else
Me.BorderPen = New Pen(Color.FromArgb(&H33, &H33, &H33))
Me.HeaderBackBrush = New SolidBrush(Color.FromArgb(&H33, &H33, &H33))
End If
DrawStoreCard(g, itemBounds, rowObject, olv, DirectCast(e.Item, OLVListItem))
' Finally render the buffered graphics
buffered.Render()
buffered.Dispose()
' Return true to say that we've handled the drawing
Return True
End Function
Friend BorderPen As New Pen(Color.FromArgb(&H33, &H33, &H33))
Friend TextBrush As Brush = New SolidBrush(Color.FromArgb(&H22, &H22, &H22))
Friend HeaderTextBrush As Brush = Brushes.AliceBlue
Friend HeaderBackBrush As Brush = New SolidBrush(Color.FromArgb(&H33, &H33, &H33))
Friend BackBrush As Brush = Brushes.LemonChiffon
Friend BackgroundBrush As Brush = New SolidBrush(Color.FromArgb(38, 38, 38))
Public Sub DrawStoreCard(g As Graphics, itemBounds As Rectangle, rowObject As Object, olv As ObjectListView, item As OLVListItem)
Try
Dim _store As StoreObject = TryCast(rowObject, StoreObject)
' Allow a border around the card
itemBounds.Inflate(-5, -5)
g.FillRectangle(BackgroundBrush, itemBounds)
Dim ColouredPanelRect As Rectangle = New Rectangle(itemBounds.Left + 7, itemBounds.Top + 7, 70, 70)
g.FillRectangle(Brushes.IndianRed, ColouredPanelRect)
Dim fmt As New StringFormat()
fmt.Alignment = StringAlignment.Center
fmt.LineAlignment = StringAlignment.Center
For i As Integer = 0 To olv.Columns.Count - 1
Dim column As OLVColumn = olv.GetColumn(i)
If column.IsTileViewColumn Then
'Draw Store Number
Using font As New Font(fontMgr("Mentone Lig"), 36, FontStyle.Regular, GraphicsUnit.Pixel)
g.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAliasGridFit
g.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
g.DrawString(_store.StoreID, font, BackgroundBrush, ColouredPanelRect, fmt)
End Using
'Draw Store Name
Using string_format As New StringFormat()
string_format.Alignment = StringAlignment.Center
string_format.LineAlignment = StringAlignment.Near
g.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
g.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAliasGridFit
g.DrawString(_store.StoreName.ToUpper, New Font("Segoe UI", 9, FontStyle.Regular), Brushes.White, itemBounds, string_format)
End Using
...
I have tried playing around AntiAlias and ClearType but both have the same affect.
UPDATE
Here are my results below with using the same font at the same size:
The text at the top represents a normal label placed on a form. The text at the bottom is text drawn on to a listview item (in Tile mode) using the code above. You can easily identify the difference and see that it is not as smooth. Also the larger I make the text the more unsmooth it gets. I have tried playing around with all the settings and currently have it set to:
g.TextRenderingHint = Drawing.Text.TextRenderingHint.ClearTypeGridFit
g.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
g.CompositingQuality = Drawing2D.CompositingQuality.HighQuality
g.PixelOffsetMode = PixelOffsetMode.HighQuality
Thanks
Okay, I ended up working this out by going through the example again.
The problem was that I was dropping the scaling element from my code which seemed to be causing the pixilation of the text.
By adding the following code back in, it has corrected the smoothness of the text:
Dim size As SizeF = g.MeasureString(txt, font, CInt(itemBounds.Width), fmt)
g.TextRenderingHint = Drawing.Text.TextRenderingHint.ClearTypeGridFit
So my overall code looks like this:
Using font As New Font("Segoe UI", 9, FontStyle.Regular)
' Measure the height of the title
txt = column.GetStringValue(rowObject)
Dim size As SizeF = g.MeasureString(txt, font, CInt(itemBounds.Width), fmt)
g.TextRenderingHint = Drawing.Text.TextRenderingHint.ClearTypeGridFit
g.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
g.CompositingQuality = Drawing2D.CompositingQuality.HighQuality
g.PixelOffsetMode = PixelOffsetMode.HighQuality
g.DrawString(txt, font, Brushes.LightGray, itemBounds, fmt)
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)

Calculate coordinates for rotated text plus bounding border

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:

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.