I have two bmp files:
footer.bmp: 200 x 200
product.bmp: 1000 x 1000
I want to create a new bmp file with 200 x 500:
Append the footer.bmp into the bottom of the new image - position (0, 300)
Resize the product.bmp to 200 x 300 and position into (0, 0)
How do I do this using VB.NET?
Dim oBitmap As New Bitmap(200, 500)
Dim oGraphics As Graphics
oGraphics = Graphics.FromImage(oBitmap)
... ?
Dim Path As String = "C:\Delivery\"
Dim Height As Integer = 400
Using oFooter As System.Drawing.Image = Drawing.Image.FromFile(Path + "Footer.png")
Dim Width As Integer = oFooter.Width
Using oBitmap As New Bitmap(Width, Height)
Using oGraphic As Graphics = Graphics.FromImage(oBitmap)
Using oBrush As New SolidBrush(Color.White)
oGraphic.FillRectangle(oBrush, 0, 0, Width, Height)
End Using
oGraphic.DrawImage(oFooter, 0, 300)
Using oProduto As System.Drawing.Image = Drawing.Image.FromFile(Path + "Produto.png")
Dim pWidth As Integer = oProduto.Width
Dim pHeight As Integer = oProduto.Height
If pWidth > Width Then
pHeight = CInt(pHeight * Width / pWidth)
pWidth = Width
End If
If pHeight > Height Then
pWidth = CInt(pWidth * Height / pHeight)
pHeight = Height
End If
Dim x As Integer = CInt((Width - pWidth) / 2)
Dim y As Integer = CInt((Height - oFooter.Height - pHeight) / 2)
oGraphic.DrawImage(oProduto, x, y, pWidth, pHeight)
End Using
oBitmap.Save(Path + "Final.jpg", Imaging.ImageFormat.Jpeg)
End Using
End Using
End Using
Related
I'm trying to convert an SVG file to any format of image file.
I'm creating SVG file from base30 value.
Public Sub SaveSignature()
Dim B30 As New Base30Converter
Dim Img = B30.GetData("aQ4895d6d7j5h94840Z39baa6bfb6430Y4538d6a49c59db8863003240Z4374b7ek7j4a33Y255e8j5d6Z52Y3b2428385e9n1vd1Bfq6a4Z4Y3949456Z1e91wi2B2N1u2Eh1H9bY5j81ye1w1u8e5724983329d8pe1Ai1Nf1V1Uft9d5_7WZ266594c4g7gc36452542000Y2648a67334524112100Z1235766Y64Z9ah593420Y75g7d483401000Z34Y133Z332Y7e29262300Z43a3652Y26252556400Z2ig6h2200473720Y2263542006736424241000Z826010")
Dim svg = SVGConverter.ToSVG(Img)
Dim sw As New System.IO.StreamWriter("D:\Sign.svg", False)
sw.Write(svg)
sw.Close()
Dim bmp As Bitmap = renderFile("D:\Sign.svg")
Dim g As Graphics
g = Graphics.FromImage(bmp)
Using g
g.Clear(Color.White)
g.DrawImageUnscaled(bmp, 0, 0)
End Using
bmp.Save("D:\Sign.bmp", System.Drawing.Imaging.ImageFormat.Bmp)
bmp.Save("D:\Sign.jpg", System.Drawing.Imaging.ImageFormat.Jpeg)
bmp.Save("D:\Sign.emf", System.Drawing.Imaging.ImageFormat.Emf)
End Sub
Public Function renderFile(filename As String) As Bitmap
Dim displaySize As System.Drawing.Size
displaySize.Width = 300
displaySize.Height = 200
Dim svgDoc As SvgDocument = SvgDocument.Open(filename)
Dim svgSize = svgDoc.GetDimensions()
If svgSize.Width = 0 Then
Throw New Exception("SVG does not have size specified. Cannot work with it.")
End If
Dim displayProportion = (displaySize.Height * 1.0F) / displaySize.Width
Dim svgProportion = svgSize.Height / svgSize.Width
Dim scalingFactor As Single = 0.0F
Dim padding As Integer = 10
If displayProportion > svgProportion Then
scalingFactor = ((displaySize.Width - padding * 2) * 1.0F) / svgSize.Width
Else
scalingFactor = ((displaySize.Height - padding * 2) * 1.0F) / svgSize.Height
End If
If scalingFactor < 0 Then
Throw New Exception("Viewing area is too small to render the image")
End If
Dim centeringX As Integer = Convert.ToInt16((displaySize.Width - (padding + CInt(svgDoc.Width) * scalingFactor)) / 2)
Dim centeringY As Integer = Convert.ToInt16((displaySize.Height - (padding + CInt(svgDoc.Height) * scalingFactor)) / 2)
svgDoc.Transforms = New SvgTransformCollection()
svgDoc.Transforms.Add(New SvgTranslate(padding + centeringX, padding + centeringY))
svgDoc.Transforms.Add(New SvgScale(scalingFactor))
svgDoc.Width = New SvgUnit(svgDoc.Width.Type, displaySize.Width)
svgDoc.Height = New SvgUnit(svgDoc.Height.Type, displaySize.Height)
Return svgDoc.Draw()
End Function
After all these process the image file left with empty file.
The base30 value I'm getting from a signature panel in asp application.
I am making a lunar lander game, and want the spaceship to rotate when the left and right arrow keys are pressed.
I know how to move an image using a picture box and the keydown event, but there isn't anyway to directly rotate a picture box. Do i need to use the image a different way to be able to achieve what I want? Any help is much appreciated.
Make a new class inheriting from picturebox. Use that. You can edit the designer.vb to change the type.
This is pseudocode, untested, so it certainly won't run.
class RotateablePictureBox
inherits picturebox
public property RotationAngle as single
overrides onpaint(e as ...)
e.graphics.rotatetransform(rotationangle)
mybase.onpaint(e)
That's the idea that Hans Passant is talking about (might have to do the DrawImage yourself too and skip the mybase.onpaint - it's done like e.graphics.onpaint(TheImage,dimensions etc...))
This is my first time posting code so let me know how I can improve it for the group. I developed this class using code from http://www.devasp.net/net/articles/display/391.htmlenter code here
I hope this helps. This is the button code
Private Sub btnRotateLeft_Click(sender As Object, e As EventArgs) Handles btnRotateLeft.Click
' IMAGE IS THE NEW OBJECT FROM THE CLASS. PASS THE PICTUREBOX CONTROL(pbItems)
image.RotateLeft(pbItems)
End Sub
This is the class
Imports System.Math
Public Class clsImage
Private wid As Single
Private hgt As Single
Public Function RotateLeft(ByVal picSource As PictureBox) As PictureBox
'ROTATES THE IMAGE LEFT
Dim bm_in = New Bitmap(picSource.Image)
wid = bm_in.Width
hgt = bm_in.Height
Dim corners As Point() = {New Point(0, 0), New Point(wid, 0), New Point(0, hgt), New Point(wid, hgt)}
Dim cx As Single = wid / 2
Dim cy As Single = hgt / 2
Dim i As Long
'ROTATES LEFT
For i = 0 To 3
corners(i).X -= cx
corners(i).Y -= cy
Next i
'THE ROTATION ANGLE IS HARD CODED HERE BUT COULD BE PASS TO THE CLASS
Dim theta As Single = Single.Parse(90) * PI / 180.0
Dim sin_theta As Single = Sin(theta)
Dim cos_theta As Single = Cos(theta)
Dim X As Single
Dim Y As Single
For i = 0 To 3
X = corners(i).X
Y = corners(i).Y
corners(i).X = X * cos_theta + Y * sin_theta
corners(i).Y = -X * sin_theta + Y * cos_theta
Next i
Dim xmin As Single = corners(0).X
Dim ymin As Single = corners(0).Y
For i = 1 To 3
If xmin > corners(i).X Then xmin = corners(i).X
If ymin > corners(i).Y Then ymin = corners(i).Y
Next i
For i = 0 To 3
corners(i).X -= xmin
corners(i).Y -= ymin
Next i
Dim bm_out As New Bitmap(CInt(-2 * xmin), CInt(-2 * ymin))
Dim gr_out As Graphics = Graphics.FromImage(bm_out)
ReDim Preserve corners(2)
gr_out.DrawImage(bm_in, corners)
picSource.Image = bm_out
Return picSource
End Function
Public Function RotateRight(ByVal picSource As PictureBox) As PictureBox
'ROTATES THE IMAGE RIGHT
Dim bm_in = New Bitmap(picSource.Image)
wid = bm_in.Width
hgt = bm_in.Height
Dim corners As Point() = {New Point(0, 0), New Point(wid, 0), New Point(0, hgt), New Point(wid, hgt)}
Dim cx As Single = wid / 2
Dim cy As Single = hgt / 2
Dim i As Long
'ROTATES RIGHT
For i = 0 To 3
corners(i).X -= cx
corners(i).Y -= cy
Next i
'THE ROTATION ANGLE IS HARD CODED HERE BUT COULD BE PASS TO THE CLASS
Dim theta As Single = Single.Parse(-90) * PI / 180.0
Dim sin_theta As Single = Sin(theta)
Dim cos_theta As Single = Cos(theta)
Dim X As Single
Dim Y As Single
For i = 0 To 3
X = corners(i).X
Y = corners(i).Y
corners(i).X = X * cos_theta + Y * sin_theta
corners(i).Y = -X * sin_theta + Y * cos_theta
Next i
Dim xmin As Single = corners(0).X
Dim ymin As Single = corners(0).Y
For i = 1 To 3
If xmin > corners(i).X Then xmin = corners(i).X
If ymin > corners(i).Y Then ymin = corners(i).Y
Next i
For i = 0 To 3
corners(i).X -= xmin
corners(i).Y -= ymin
Next i
Dim bm_out As New Bitmap(CInt(-2 * xmin), CInt(-2 * ymin))
Dim gr_out As Graphics = Graphics.FromImage(bm_out)
ReDim Preserve corners(2)
gr_out.DrawImage(bm_in, corners)
picSource.Image = bm_out
Return picSource
End Function
End Class
I have been working on an app to search for 3 pixels in a certain area then play a sound. It currently works however I wish to reduce the zone of which it searches from the whole screen to a rectangular area on my screen, this is to save memory usage of the app, here's the code that works
Private Sub dcdTimer_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles dcdTimer.Tick
Dim screensize As Size = New Size(My.Computer.Screen.Bounds.Width, My.Computer.Screen.Bounds.Height)
Dim screenshot As New Bitmap(My.Computer.Screen.Bounds.Width, My.Computer.Screen.Bounds.Height)
Dim ge As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(screenshot)
Dim pointx As Integer = 1
Dim pointy As Integer = 1
ge.CopyFromScreen(New Point(0, 0), New Point(0, 0), screensize)
looking = True
Try
While looking = True
Dim atpoint As Color = screenshot.GetPixel(pointx, pointy)
Dim reckcol1 As Color = Color.FromArgb(a, r, g, b) 'first pixel colour
Dim reckcol2 As Color = Color.FromArgb(a1, r1, g1, b1) 'second pixel colour
Dim reckcol3 As Color = Color.FromArgb(a2, r2, g2, b2) 'third pixel colour
If atpoint = reckcol1 Then 'Matches 3 pixels
Dim testPoint As Color = screenshot.GetPixel(pointx, pointy + 10)
If testPoint = reckcol2 Then
Dim testPoint2 As Color = screenshot.GetPixel(pointx + 10, pointy + 10)
If testPoint2 = reckcol3 Then
My.Computer.Audio.Play(sounddir + "Found.wav")
looking = False
Sleep(15000)
pointx = 0
pointy = 0
End If
End If
End If
pointy = pointy + 1
If pointy = My.Computer.Screen.Bounds.Height Then
pointy = 0
pointx = pointx + 1
End If
End While
Catch ex As Exception
End Try
End Sub
I tried to use this code as suggested:
Dim pointofY As New Point(500, 400)
Dim screensize As New Size(400, 200)
Dim screenshot As New Rectangle(pointofY, screensize)
Dim ge As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(screenshot)
However, using a rectangle does not allow me to use getpixel or use ge.copyfromscreen
I was in the process of using Pixel to do my search between a large image and a small image. I got that one to successfully work but am having trouble getting the lockbits version to do what I want it to do.
Fist I want to loop through the large image finding the first pixel of the smaller image inside it. Then once finding the first pixel to do a math equation to tell me what percentage of accuracy it got off it. In doing so if it meets the criteria to move my mouse to that location on the screen at the first pixel (top most left) of that small image inside the large image. Which works with a great rate of success and is extremely fast compared to GetPixel format.
Problem Cannot get location on the large image of where the beginning Pixel of the small image is and move the mouse to that location. Below is the code:
Try
Dim ifnd As Boolean = False
Dim PreviousX As Integer
Dim PreviousY As Integer
PreviousX = MousePosition.X
PreviousY = MousePosition.Y
Dim MatchCount As Integer = 0
Dim oX As Integer = 0
Dim oi As Integer = 0
Dim iX As Integer = 0
Dim iY As Integer = 0
Dim bmp_original As Bitmap
Dim ImG As Bitmap
ImG = PictureBox2.BackgroundImage
bmp_original = ImG
Dim bmp_large As Bitmap
Dim SmG As Image
SmG = PictureBox1.BackgroundImage
bmp_large = SmG
Dim bmg As Bitmap
'large image
ImG = BBt
'small image
bmg = Abt
Thread.Sleep(1000)
'large image
If BBt Is Nothing Then
Dim xbit As Bitmap = New Bitmap(Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height)
Dim g As Graphics = Graphics.FromImage(xbit)
BBt = xbit
g.CopyFromScreen(0, 0, 0, 0, Screen.PrimaryScreen.Bounds.Size)
g.Dispose()
Thread.Sleep(2000)
End If
'small image
PictureBox5.BackgroundImage = Abt
'large image
PictureBox6.BackgroundImage = BBt
'For value As Integer = 0 To 5
'For value As Integer = 10 To 0 Step -2
Thread.Sleep(1000)
'original image
Dim oRect As New Rectangle(0, 0, bmg.Width, bmg.Height)
Dim oBmpData As BitmapData = bmg.LockBits(oRect, ImageLockMode.ReadWrite, System.Drawing.Imaging.PixelFormat.Format24bppRgb)
Dim oPtr As IntPtr = oBmpData.Scan0
Dim oPixels(99) As Integer
Dim oMaxPix As Integer = bmg.Width + bmg.Height
Marshal.Copy(oPtr, oPixels, 0, oMaxPix)
Dim smWidth As Integer
smWidth = bmg.Width - 1
'small image
PictureBox3.BackgroundImage = bmg
'large image
Dim lRect As Rectangle = New Rectangle(0, 0, bmp_large.Width, bmp_large.Height)
Dim lBmpData As BitmapData = ImG.LockBits(lRect, ImageLockMode.ReadWrite, System.Drawing.Imaging.PixelFormat.Format24bppRgb)
Dim lPtr As IntPtr = lBmpData.Scan0
Dim PixelCount As Integer = ImG.Width * ImG.Height
Dim lPixels(PixelCount - 1) As Integer
Marshal.Copy(lPtr, lPixels, 0, PixelCount)
'large image
PictureBox4.BackgroundImage = ImG
Dim MathScore As Integer
Dim MaxScore As Integer = bmg.Height
'beginning of Marshal Loop
For i As Integer = 0 To lPixels.GetUpperBound(0)
If oPixels(0) = lPixels(i) Then
'we have a match for top left pixel - so compare the other pixels
Dim PixelsToLeft As Integer = (i Mod ImG.Width) - 1 'pixels to left of 10by10 section of large image
Dim PixelsToRight As Integer = ImG.Width - PixelsToLeft - smWidth 'pixels to right of 10by10 section of large image
Dim d As Integer = PixelsToLeft + PixelsToRight 'array distance between right edge of 10by10 section and left edge of next row
For y As Integer = 0 To 9
For x As Integer = 0 To 9
Dim oIndex As Integer = (y * 10) + x
Dim lIndex As Integer = (i + (y * (d + smWidth))) + x
If oPixels(oIndex) = lPixels(lIndex) Then
MathScore = MathScore + 1
xx = oPixels(0) + 2
yy = lPixels(i) + 3
SetCursorPos(xx, yy)
End If
Next
Next
If MathScore >= Val(MaxScore / 2.5) Then
SetCursorPos(xx, yy)
Dim percent As String
Dim myDec As Decimal
'inttemp = (intData2 * 100) / intData1
myDec = Val((MathScore * 100) / MaxScore)
myDec = FormatNumber(myDec, 0)
percent = myDec & "%"
Label16.Text = "Match Score: " & percent
Label17.Text = "Math Score: " & MathScore & " out of " & MaxScore
Me.ToolStripStatusLabel2.Text = "Completed"
Me.Button4.Enabled = True
GoTo Foundit
End If
End If
Next
PictureBox1.Image = (Abt)
PictureBox2.Image = (BBt)
ImG.UnlockBits(oBmpData)
bmg.UnlockBits(lBmpData)
Foundit:
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
Catch
End Try
Now if I could figure out how to get the mouse to move on the screen then I would have figured it out. Unfortunately I have been working on this for several days without any success. If you could help I would greatly appreciate it. Thank you in advance.
to move the mouse do this
dim a as new point
a.x = "the number you want"
a.y = "the number you want"
windows.forms.cursor.position = a
How to resize the Picturebox so it can show the full image if the image size is less than monitor size ! I wrote a code which can not resize (but still posting the code)!
Code before loading image on a button click
Dim bmp As Bitmap
bmp = New Bitmap(path)
If bmp.Width < picBox.Image.Width Then picBox.Width = bmp.Width : If bmp.Height < picBox.Image.Height Then picBox.Height = bmp.Height
picBox.Invalidate() : picBox.Refresh()
'picBox.SetBounds(x,y,width,height)
The code does not resize the picturebox, it's just untouched !
Edit
The form has the picBox and a groupbox [dock enabled] control only.
bmp = New Bitmap(dlgOpen.FileName)
picBox.SizeMode = PictureBoxSizeMode.Normal
Dim w As Integer = picBox.ClientSize.Width
Dim h As Integer = picBox.ClientSize.Height
If bmp.Width > w Then
w = bmp.Width
End If
If bmp.Height > h Then
h = bmp.Height
End If
If w > Me.Width - grpBox.Width Then
w = Me.Width - grpBox.Width
End If
If h > grpBox.Height Then
h = grpBox.Height
End If
picBox.ClientSize = New Size(w, h)
picBox.ImageLocation = dlgOpen.FileName
This code does not re-sizes the picture box either .
In .NET, there's the Public Enumeration PictureBoxSizeMode that allows you to change how the PictureBox handles differently sized images:
Normal
StretchImage
AutoSize
CenterImage
Zoom
You can set it for the current PictureBox via the .SizeMode property. AutoSize is probably what you are looking for. If it is larger than the window or frame, you will have to handle this in a PictureBox.Resize event to either resize the window or rescale the image.
So, it might be something like:
Dim bmp As Bitmap
bmp = New Bitmap(path)
picBox.SizeMode = PictureBoxSizeMode.AutoResize
picBox.Image = bmp
Dim bmp As New Bitmap(path)
PictureBox1.SizeMode = PictureBoxSizeMode.Normal
Dim w As Integer = PictureBox1.ClientSize.Width
Dim h As Integer = PictureBox1.ClientSize.Height
If bmp.Width > w Then
w = bmp.Width
End If
If bmp.Height > h Then
h = bmp.Height
End If
If w > maxWidth Then
w = maxWidth
End If
If h > maxHeight Then
h = maxHeight
End If
PictureBox1.ClientSize = New Size(w, h)
PictureBox1.Image = bmp
Picture-box can be re-sized only before loading the image, there after it is read only and has no effect !