Looking for help here, i have a transparent picturebox (using fucshia as transparencyKey) named PB1 with PB1.Location.X = 145 , PB1.Location Y = 7 and a button named btnTakePic. The codes are as follows :
Private Sub btnTakePic_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnTakePic.Click
Dim Bound As Rectangle
Dim Pic As Graphics
Dim screenshot As System.Drawing.Bitmap
Bound = Screen.PrimaryScreen.Bounds
screenshot = New System.Drawing.Bitmap(PB1.Bounds.Width, PB1.Bounds.Height, System.Drawing.Imaging.PixelFormat.Format32bppPArgb)
Pic = Graphics.FromImage(screenshot)
Pic.CopyFromScreen(CInt(LocPBX.Text), CInt(LocPBY.Text), 0, 0, Bounds.Size, CopyPixelOperation.SourceCopy)
PB1.Image = screenshot
PB1.SizeMode = PictureBoxSizeMode.StretchImage
End Sub
Private Sub Main_LocationChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.LocationChanged
LocX.Text = Me.Location.X
LocY.Text = Me.Location.Y
LocPBX.Text = Val(PB1.Location.X) + Val(LocX.Text) + 3
LocPBY.Text = Val(PB1.Location.Y) + Val(LocY.Text + 25)
End Sub
Now the question is : it produces screenshot as exactly what i want, but when i click the btnTakePic , The picture will overlap the old one, I want to erase the old picture screenshot from memory and substituting it with a new one, how to do that ?
Clear out the previous image and refresh the picturebox before taking a new shot:
Private Sub btnTakePic_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnTakePic.Click
PB1.Image = Nothing
PB1.Refresh()
Dim pt As Point = PB1.PointToScreen(New Point(0, 0))
Dim screenshot As New System.Drawing.Bitmap(PB1.Size.Width, PB1.Size.Height, System.Drawing.Imaging.PixelFormat.Format32bppPArgb)
Using Pic As Graphics = Graphics.FromImage(screenshot)
Pic.CopyFromScreen(pt.X, pt.Y, 0, 0, PB1.Size, CopyPixelOperation.SourceCopy)
End Using
PB1.Image = screenshot
PB1.SizeMode = PictureBoxSizeMode.StretchImage
End Sub
How do you know what you're taking a picture of, though, if you already have a screenshot displayed?
Related
I am trying to write (type) directly onto a bitmap. I need to be able to type at the mouse position, so where ever on the screen i click the mouse, I can start typing text with the keyboard.
Here is a working VS 2017 VB Win Form code that will print "Hello World" at the mousedown position. But it only works with predetermined text. I would like to be able to just type at that spot. I feel I am so close, just can't get it to work.
Imports System.IO
Imports System.Windows.Forms.DataVisualization.Charting
Public Class Form1
Dim WithEvents Chart1 As New Chart
Private Structure TextPoints
Dim MPos As Point
Dim Txt As String
End Structure
Private TextList As New List(Of TextPoints)
Private TempPoint As Point
Private FirstPoint As Point
Dim xcnt As Integer = -1
Dim ycnt As Integer = -1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
Me.Size = New Size(1100, 700)
Me.Location = New Point(10, 10)
MakeBackImage()
With Chart1
.Name = "Chart1"
.Location = New System.Drawing.Point(40, 40)
.Size = New System.Drawing.Size(1010, 610)
.BackImage = "BackImg.jpg"
.Parent = Me
End With
End Sub
Private Sub Chart1_MouseDown(ByVal sender As Object,
ByVal e As System.Windows.Forms.MouseEventArgs) _
Handles Chart1.MouseDown
FirstPoint = New Point(e.X, e.Y)
TempPoint = New Point(e.X, e.Y)
Me.Refresh()
End Sub
Private Sub Chart1_MouseUp(ByVal sender As Object,
ByVal e As System.Windows.Forms.MouseEventArgs) _
Handles Chart1.MouseUp
Dim T As New TextPoints With {
.MPos = TempPoint,
.Txt = "Hello World"}
TextList.Add(T)
Me.Refresh()
End Sub
Private Sub MakeBackImage()
Dim x, y As Integer
Dim img As Image = New Bitmap(1020, 620)
Dim graphics As Graphics = Graphics.FromImage(img)
graphics.Clear(Drawing.Color.White)
For x = 0 To 1000 Step 20
graphics.DrawLine(Pens.Black, x, 0, x, 600)
xcnt += 1
Next
For y = 0 To 600 Step 20
ycnt += 1
graphics.DrawLine(Pens.Black, 0, y, 1000, y)
Next
img.Save("BackImg.jpg", Imaging.ImageFormat.Jpeg)
End Sub
Private Sub Chart1_Paint(ByVal sender As Object,
ByVal e As System.Windows.Forms.PaintEventArgs) _
Handles Chart1.Paint
Dim drawString As String = "Hello World"
Dim drawFont As New Font("Arial", 14)
Dim drawBrush As New SolidBrush(Color.Black)
For Each t As TextPoints In TextList
e.Graphics.DrawString(t.Txt, drawFont,
drawBrush, t.MPos.X, t.MPos.Y)
Next
End Sub
End Class
This is a simplified code. Actually, the background image is only created once, but I added code to dynamically create it here to make the demo better.
I am new to programming. Can anybody help me with creating line/shape in picturebox with grips on the line/shape. Like we do it in CAD softwares.
And i want to know how to create a line on mouse click until another mouse click event occurs.
Public Class Form1
Dim isDrag As Boolean = False
Dim theRectangle As New Rectangle(New Point(0, 0), New Size(0, 0))
Dim startPoint As Point
Dim IsDimension As Boolean = False
Dim LineLocationStPoint As Point = Nothing
Dim LineLocationEndPoint As Point = Nothing
Dim cnt As Integer = 0
Dim LineArray As New ArrayList
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim fd As OpenFileDialog = New OpenFileDialog()
Dim strFileName As String
fd.Title = "Open File Dialog"
fd.Filter = "(*.PDF;*.DWG;*.TIFF;*.TIF)|*.PDF;*.DWG;*.TIFF;*.TIF|All files (*.*)|*.*"
fd.FilterIndex = 2
fd.RestoreDirectory = True
If fd.ShowDialog() = DialogResult.OK Then
strFileName = fd.FileName
'ShowFileInWebBrowser(WebBrowser1, strFileName)
PictureBox1.Load(strFileName)
End If
End Sub
Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As _
System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
If (e.Button = MouseButtons.Right) Then
isDrag = True
End If
Dim control As Control = CType(sender, Control)
startPoint = control.PointToScreen(New Point(e.X, e.Y))
If (e.Button = MouseButtons.Left) Then
IsDimension = True
LineLocationStPoint = e.Location
LineArray.Add(e.Location)
End If
End Sub
Private Sub Form1_MouseMove(ByVal sender As Object, ByVal e As _
System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
If (isDrag) Then
ControlPaint.DrawReversibleFrame(theRectangle, Me.BackColor, _
FrameStyle.Dashed)
Dim endPoint As Point = CType(sender, Control).PointToScreen(New Point(e.X, e.Y))
Dim width As Integer = endPoint.X - startPoint.X
Dim height As Integer = endPoint.Y - startPoint.Y
theRectangle = New Rectangle(startPoint.X, startPoint.Y, _
width, height)
ControlPaint.DrawReversibleFrame(theRectangle, Me.BackColor, _
FrameStyle.Dashed)
End If
If IsDimension Then
LineLocationEndPoint = e.Location
Dim g As Graphics = PictureBox1.CreateGraphics()
g.DrawLine(Pens.Red, LineLocationStPoint, e.Location)
g.Dispose()
End If
End Sub
Private Sub Form1_MouseUp(ByVal sender As Object, ByVal e As _
System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseUp
If IsDimension Then
PictureBox1.Refresh()
ElseIf isDrag Then
' If the MouseUp event occurs, the user is not dragging.
isDrag = False
' Draw the rectangle to be evaluated. Set a dashed frame style
' using the FrameStyle enumeration.
ControlPaint.DrawReversibleFrame(theRectangle, Me.BackColor, _
FrameStyle.Dashed)
' Find out which controls intersect the rectangle and change their color.
' The method uses the RectangleToScreen method to convert the
' Control's client coordinates to screen coordinates.
Dim i As Integer
Dim controlRectangle As Rectangle
For i = 0 To Controls.Count - 1
controlRectangle = Controls(i).RectangleToScreen _
(Controls(i).ClientRectangle)
If controlRectangle.IntersectsWith(theRectangle) Then
Controls(i).BackColor = Color.BurlyWood
End If
Next
' Reset the rectangle.
theRectangle = New Rectangle(0, 0, 0, 0)
End If
End Sub
But it creates the line continuously from selected point. Whereas I want to create a line only for showing user the path of line. And i have implemented selection rectangle an right click button
Procedure for working:
Toolbar will contain line and Area
Open a file(image file)
click on line button of toolbar
*Come to picturebox
*click on one point of screen
*dynamic line starts drawing on screen (line will be from the 1st clicked point to where ever mouse mouse)
*when user clicks the next time the line is created.
click area of toolbar
*come back to picturebox
*operation same like line but when user clicks third point on picture box a shaded rectangle should appear.
http://www.vb-helper.com/howto_2005_line_control.html
For those who want to implement line with resizing grip in it.
For adding re sizable line you need to add a customized control of your own. Use this custom control and add/use it in form for further use.
Thanks everyone for helping
I'm currently making an arcade shooting game in Visual Basic which spawns enemies at the top of the form which move vertically downward toward the player. My current code spawns the enemy, but any attempt to add another 'enemyShip' to the 'enemyShips' array fails and hence, only a single enemy is spawned. Any help as to how to spawn multiple enemies would be appreciated. My current code is below:
Dim enemySize As Integer = 32
Dim enemySpawn As New Point(150, 0)
Dim enemyShip As New Rectangle(150, 0, enemySize, enemySize)
Dim enemyLoc As New Point(enemyShip.Location)
Dim enemySpr As Image = My.Resources.sprEnemy32x32
Dim enemySpeed As Integer = 5
Dim enemyShips(-1) As Rectangle
Dim intCount As Integer = 0
Dim g, bbg As Graphics
Dim backBuff As Bitmap
Private Sub frmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
g = Me.CreateGraphics
backBuff = New Bitmap(300, 300, Imaging.PixelFormat.Format32bppPArgb)
bbg = Graphics.FromImage(backBuff)
tmrSpawn.Enabled = True
tmrRender.Enabled = True
End Sub
Private Sub tmrSpawn_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmrSpawn.Tick
SpawnEnemy()
End Sub
Private Sub SpawnEnemy()
'Add enemyShip to index in array enemyShips
'Add 1 to enemyShip's index so new rectangle is stored in the next index
ReDim Preserve enemyShips(intCount)
enemyShips(intCount) = enemyShip
intCount += 1
'Move newly created enemyShip vertically downward on the form
For Each Me.enemyShip In enemyShips
enemyLoc = New Point(enemyShip.Location.X, enemyShip.Location.Y + enemySpeed)
enemyShip.Location = enemyLoc
Next
End Sub
Private Sub tmrRender_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmrRender.Tick
bbg.DrawImage(enemySpr, enemyShip)
g.DrawImage(backBuff, 0, 0)
bbg.Clear(Color.Gray)
End Sub
i want to maintain the location of picturebox2 which is inside a panel. in my case, the image looks like this.. https://encrypted-tbn0.gstatic.com/images?q=tbn:ANd9GcQ8SUu7ZXBJVXrhic-Xou9OsW4h7QDd8yH5xhYtV3DlnJ0Q1UVJiw (there's a map /picturebox1/ and the color green locator or pointer is another picturebox /picturebox2/)
is it possible to zoom in and zoom out the image without losing the right coordinates? Because i want to maintain the location of the locator(picturebox2) in the map (picturebox1)
so far, i can now zoom in and zoom out the image in the scrollable panel using trackbar. but my only problem is that, the picturebox2 (another image above the picturebox1) needs to move its location as picturebox1 is zooming.
Public ClassForm1
Private img original As Image
Private m_PanStartPoint As New Point
Private n_PanStartPoint As New Point
Private Sub Form1_Load(ByVal sender AsSystem.Object, ByVal e AsSystem.EventArgs) Handles MyBase.Load
imgoriginal = Image.FromFile("C:\New Folder\picture1.jpg")
PictureBox1.BackgroundImageLayout = ImageLayout.Stretch
zoomSlider.Minimum = 1
zoomSlider.Maximum = 5
zoomSlider.SmallChange = 1
zoomSlider.LargeChange = 1
zoomSlider.UseWaitCursor = False
Me.DoubleBuffered = True
Panel1.AutoScroll = True
PictureBox1.SizeMode = PictureBoxSizeMode.AutoSize
PictureBox1.Parent = PictureBox1
PictureBox2.Parent = PictureBox1
PictureBox1.BackColor = Color.Transparent
Dim mstream As NewSystem.IO.MemoryStream()
PictureBox1.Image = Image.FromStream(mstream)
PictureBox2.Location = NewSystem.Drawing.Point(100, 100)
End Sub
Public Function pictureboxzoom(ByValimgAsImage, ByVal size AsSize) AsImage
Dim bm As Bitmap = New Bitmap(img, Convert.ToInt32(img.Width * size.Width), Convert.ToInt32(img.Height * size.Height))
Dim grap As Graphics = Graphics.FromImage(bm)
grap.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
Return bm
End Function
Private Sub zoomSlider_Scroll(ByVal sender AsSystem.Object, ByVal e AsSystem.EventArgs) Handles zoomSlider.Scroll
If zoomSlider.Value> 0 Then
PictureBox1.Image = Nothing
PictureBox1.Image = pictureboxzoom(imgoriginal, New Size(zoomSlider.Value, zoomSlider.Value))
End If
End Sub
Private Sub PictureBox1_MouseDown(ByVal sender AsObject, ByVal e AsSystem.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
m_PanStartPoint = NewPoint(e.X, e.Y)
End Sub
Private Sub PictureBox1_MouseMove(ByVal sender AsObject, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
If e.Button = Windows.Forms.MouseButtons.Left Then
Dim DeltaX As Integer = (m_PanStartPoint.X - e.X)
Dim DeltaY As Integer = (m_PanStartPoint.Y - e.Y)
Panel1.AutoScrollPosition = _
New Drawing.Point((DeltaX - Panel1.AutoScrollPosition.X), _
(DeltaY - Panel1.AutoScrollPosition.Y))
Button1.Location = New System.Drawing.Point(0, 0)
End If
End Sub
End Class
I'm creating a little snipping tool-like program in VB.NET and I can screenshot any area I want provided it is a rectangle area. I select the area in the screen and save it as an image. That's easy.
My problem is that I want to be able to screenshot not only a rectangular (standard rectangle shape area), but selecting/drawing an ellipse and screenshot the inside part of it. See the image below:
is there any way to achieve this or any library I can use for that?
Here's my current code:
Public Class Form3
Private _bRubberBandingOn As Boolean = False
Private _pClickStart As New Point
Private _pClickStop As New Point
Private _pNow As New Point
Private Sub Form3_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
Me._bRubberBandingOn = Not _bRubberBandingOn
If Me._bRubberBandingOn Then
If _pClickStart = Nothing Then _pClickStart = New Point
_pClickStart.X = e.X
_pClickStart.Y = e.Y
_pNow.X = e.X
_pNow.Y = e.Y
End If
Me.Invalidate()
End Sub
Private Sub Form3_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
If Me._bRubberBandingOn Then
If _pNow = Nothing Then _pNow = New Point
Me._pNow.X = e.X
Me._pNow.Y = e.Y
Me.Invalidate()
End If
End Sub
Private Sub Form3_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp
Me._bRubberBandingOn = Not Me._bRubberBandingOn
If Not Me._bRubberBandingOn Then
If _pClickStop = Nothing Then _pClickStop = New Point
_pClickStop.X = e.X
_pClickStop.Y = e.Y
Me.Invalidate()
End If
End Sub
Private Sub Form3_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
Dim _rRectangle As New Rectangle
Dim _penNew As New Pen(Color.Black, 2)
_rRectangle.X = _pClickStart.X
_rRectangle.Y = _pClickStart.Y
If Me._bRubberBandingOn Then
_rRectangle.Width = Me._pNow.X - _pClickStart.X
_rRectangle.Height = Me._pNow.Y - _pClickStart.Y
Else
_rRectangle.Width = Me._pClickStop.X - _pClickStart.X
_rRectangle.Height = Me._pClickStop.Y - _pClickStart.Y
End If
_penNew.DashStyle = Drawing2D.DashStyle.Solid
e.Graphics.DrawEllipse(_penNew, _rRectangle)
End Sub
End Class
Is there any way to achieve this or any library I can use for that?
Is it any way to get a handle of that painted line/shape and then use it to create a screenshot? I actually searched about this but didn't found anything meaningful yet.
thanks in advance for your time.
Take the image that you are drawing the ellipse on top of and do the following:
Dim theBitmap As Bitmap = DirectCast(Image.FromFile("PathToFileYouAreDrawingEllipseOn.bmp"), Bitmap)
Dim theEllipseBitmap As New Bitmap(theBitmap.Width, theBitmap.Height)
Dim theGraphics As Graphics = Graphics.FromImage(theEllipseBitmap)
Dim theGraphicsPath As New GraphicsPath()
' The (10,10) coordinates here are made up, you will need to take what is drawn by the user (starting x,y; ending x,y, etc.)
theGraphicsPath.AddEllipse(10, 10, theBitmap.Width - 20, theBitmap.Height - 20)
theGraphics.Clear(Color.Magenta)
theGraphics.SetClip(theGraphicsPath)
theGraphics.DrawImage(theBitmap, New Rectangle(0, 0, theBitmap.Width, theBitmap.Height), 0, 0, theBitmap.Width, theBitmap.Height, _
GraphicsUnit.Pixel)
theGraphics.Dispose()
theEllipseBitmap.MakeTransparent(Color.Magenta)
' Save the ellipse bitmap to a PNG file format
string fileName = "PathToYourDesiredOutput.png"
theEllipseBitmap.Save(fileName, System.Drawing.Imaging.ImageFormat.Png)