Type Text Directly On A Bitmap Image at Mouse Position - vb.net

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.

Related

Save a drawing from picturebox to SQL I VB.NET

I'm trying to do a visitor control program and save the visitor info as well their signature to a SQL db. The PictureBox code is working great but I can't save the image, I've searched and I saw that it can also be saved as binary. I don't want to save it locally 'cause it's never the same visitor and my goal is to real put everything on the database. Any ideas on how to solve this?
The code used to draw a signature comes from this SO question:
How to draw a signature and save it to disc as a Bitmap?
Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.Drawing.Imaging
Imports System.IO
Public Class registrovisitas
Private signatureObject As New Dictionary(Of Integer, List(Of Point))
Private signaturePen As New Pen(Color.Black, 4)
Private currentCurvePoints As List(Of Point)
Private currentCurve As Integer = -1
Private Sub pBoxSignature_MouseDown(sender As Object, e As MouseEventArgs) Handles pBoxSignature.MouseDown
currentCurvePoints = New List(Of Point)
currentCurve += 1
signatureObject.Add(currentCurve, currentCurvePoints)
End Sub
Private Sub pBoxSignature_MouseMove(sender As Object, e As MouseEventArgs) Handles pBoxSignature.MouseMove
If e.Button <> MouseButtons.Left OrElse currentCurve < 0 Then Return
signatureObject(currentCurve).Add(e.Location)
pBoxSignature.Invalidate()
End Sub
Private Sub pBoxSignature_Paint(sender As Object, e As PaintEventArgs) Handles pBoxSignature.Paint
If currentCurve < 0 OrElse signatureObject(currentCurve).Count = 0 Then Return
DrawSignature(e.Graphics)
End Sub
Private Sub DrawSignature(g As Graphics)
g.CompositingQuality = CompositingQuality.HighQuality
g.SmoothingMode = SmoothingMode.AntiAlias
For Each curve In signatureObject
If curve.Value.Count < 2 Then Continue For
Using gPath As New GraphicsPath()
gPath.AddCurve(curve.Value.ToArray(), 0.5F)
g.DrawPath(signaturePen, gPath)
End Using
Next
End Sub
Private Sub registrovisitas_Load(sender As Object, e As EventArgs) Handles MyBase.Load
dtp_FECHA.Format = DateTimePickerFormat.Custom
dtp_FECHA.CustomFormat = "dd/MM/yyyy"
End Sub
Private Sub Nuevo_ID_VISITA()
Dim rs As New ADODB.Recordset
Dim strconsultamax As String = "Select max(ID_RegistroVisitas)+1 as Nuevo_ID_VISITA from [Registro Visitas]"
rs.Open(strconsultamax, BdSQL, 1, 3)
lbl_ID.Text = rs("Nuevo_ID_VISITA").Value.ToString
rs.Close()
rs = Nothing
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Nuevo_ID_VISITA()
Dim bmp As New Bitmap(pBoxSignature.Width, pBoxSignature.Height)
pBoxSignature.DrawToBitmap(bmp, New Rectangle(0, 0, pBoxSignature.Width, pBoxSignature.Height))
Dim rs As New ADODB.Recordset
rs.Open("Select * from [Registro Visitas]", BdSQL, 1, 3)
rs.AddNew()
If rs.EOF = True Then rs.AddNew()
rs("ID_RegistroVisitas").Value = lbl_ID.Text
rs("Fecha_RegistroVisitas").Value = dtp_FECHA.Value
rs("Visitante_RegistroVisitas").Value = txt_VISITANTE.Text
rs("DNI_RegistroVisitas").Value = txt_DNI.Text
rs("hentrada_RegistroVisitas").Value = txt_hE.Text
rs("NTarjeta_RegistroVisitas").Value = txt_mE.Text
rs("Motivo_RegistroVisitas").Value = txt_MOTIVO.Text
rs("Destinatario_RegistroVisitas").Value = txt_DEST.Text
rs("FirmaDest_RegistroVisitas").Value = bmp
rs("Tipo_de_Registro").Value = "1"
rs.Update()
MessageBox.Show("S'han guardat els canvis")
rs.Close()
rs = Nothing
End Sub
End Class

Should I use me.invalidate or me.refresh when repainting my form?

I'm experimenting on paint event in Windows Form, what I want to achieved is to repaint the colors of the arrow. I think I successfully did that, I just have a question on whether should I use the Me.Invalidate or Me.Refresh when performing the repaint event on the form? Both of them are working.
Note that I will create many objects later so one of my goals is to lessen the performance issues.
When you clicked the button 1 it will change the color of the line 1 to yellow using the Me.Invalidate, when you clicked the button 2 it will change the line 1 to blue using the Me.Refresh. Both of them are working.
This is my whole code:
Public Class Form1
Private Sub Form1_Paint(sender As Object, e As PaintEventArgs) Handles MyBase.Paint
drawLeftArrow(e, "a", 100, 250, 400, 50)
End Sub
Dim aPen As Pen = New Pen(Color.Red, 8)
Dim bPen As Pen
Dim cPen As Pen
Dim line1 As Point()
Dim line2 As Point()
Dim line3 As Point()
Sub drawLeftArrow(e As PaintEventArgs, letterPosition As String, startPointX As Integer, startPointY As Integer, endPointX As Integer, endPointY As Integer)
bPen = New Pen(Color.Green, 8)
cPen = New Pen(Color.Yellow, 8)
Dim mycap As Drawing2D.CustomLineCap = New Drawing2D.AdjustableArrowCap(5, 5)
' Create points that define curve.
Dim startPoint As New Point(startPointX, startPointY)
Dim endPoint As New Point(endPointX, endPointY)
Select Case letterPosition
Case "a"
Dim middlePoint1 As New Point(startPointX + 250, startPointY)
Dim middlePoint2 As New Point(startPointX + 300, endPointY + 150)
line1 = {startPoint, middlePoint1}
line2 = {middlePoint1, middlePoint2}
line3 = {middlePoint2, endPoint}
cPen.CustomEndCap = mycap
' Draw lines between original points to screen.
e.Graphics.DrawLines(aPen, line1)
e.Graphics.DrawLines(bPen, line2)
e.Graphics.DrawLines(cPen, line3)
Exit Select
End Select
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
aPen = New Pen(Color.Yellow, 8)
Me.Invalidate()
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
aPen = New Pen(Color.Blue, 8)
Me.Refresh()
End Sub
End class
Output:

A Graphics object cannot be created from an image that has an indexed pixel format

I have a program that when you click on picturebox1, it transfers the image inside it to picturebox2. Then I have an interpolation code to modify it to a nearestneighbor pixel rendering. It also draws a pixel grid on picturebox2 to line up around the pixels. I have picturebox2 set to stretch image. I tried 2 different methods of drawing on the picturebox2. I am having a problem converting the image back to the right size to transfer it back to picturebox1 after its been edited with the paintbrush.
CODE:
Imports System.Windows.Forms
Imports System.Drawing
Imports System
Imports System.IO
Public Class Form1
Dim Brush = Brushes.Black
Dim COLOR1 As Color
Dim BMP As Bitmap
Dim Draw As Boolean
CODE: when you click on the picturebox1(topleft) it transfers its image to picturebox2(canvaseditor) does the grid draw, interpolate mode etc.
Private Sub topleft_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles topleft.Click
tiledcanvas.BackgroundImage = topleft.Image
Label1.Text = "Top-Left"
'CANVAS PIXEL GRID CODE
If topleft.Image Is Nothing Then
Else
canvaseditor.Image = Nothing
canvaseditor.Image = topleft.Image
canvaseditor.Width = topleft.Width * 8 + 1
canvaseditor.Height = topleft.Height * 8 + 1
'load and draw the image(s) once
BackgroundImage1 = New Bitmap(topleft.Image)
bmpNew = New Bitmap(canvaseditor.Width * scaleFactor, canvaseditor.Height * scaleFactor)
Using g As Graphics = Graphics.FromImage(bmpNew)
g.InterpolationMode = System.Drawing.Drawing2D.InterpolationMode.NearestNeighbor
g.PixelOffsetMode = System.Drawing.Drawing2D.PixelOffsetMode.Half
g.DrawImage(BackgroundImage1, 0, 0, bmpNew.Width, bmpNew.Height)
End Using
canvaseditor.Focus()
GroupBox13.Focus()
End If
End Sub
CODE: the paintbrush code, the mousedown, mousemove, and mouseup events on picturebox2(canvaseditor)
Private Sub canvaseditor_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles canvaseditor.MouseMove
If Draw = True Then
PaintBrush(e.X, e.Y)
Else
End If
'If down = True Then
'canvaseditor.CreateGraphics.FillRectangle(Brush, e.X, e.Y, 8, 8)
'End If
' LocalMousePosition = canvaseditor.PointToClient(Cursor.Position)
'Dim X As Integer
'Dim Y As Integer
'If LocalMousePosition.X > 0 And LocalMousePosition.X < 9 Then
'X = 1
' ElseIf LocalMousePosition.X > 8 And LocalMousePosition.X < 17 Then
'X = 2
'ElseIf LocalMousePosition.X > 16 And LocalMousePosition.X < 25 Then
'X = 3
'End If
'Label6.Text = (X & ", " & Y)
End Sub
Private Sub PaintBrush(ByVal X As Integer, ByVal Y As Integer)
Using g As Graphics = Graphics.FromImage(canvaseditor.Image)
g.FillRectangle(New SolidBrush(Color.Black), New Rectangle(X, Y, 6, 6))
End Using
canvaseditor.Refresh()
End Sub
Private Sub canvaseditor_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles canvaseditor.MouseDown
'down = True
'If down = True Then
'Dim NEWBMP As New Bitmap(topleft.Width, topleft.Height)
'Dim graph As Graphics = Graphics.FromImage(NEWBMP)
' graph.FillRectangle(Brush, e.X, e.Y, 8, 8)
'topleft.Image = NEWBMP
'End If
'down = True
'If down = True Then
'canvaseditor.CreateGraphics.FillRectangle(Brush, e.X, e.Y, 8, 8)
'End If
Draw = True
PaintBrush(e.X, e.Y)
End Sub
Private Sub canvaseditor_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles canvaseditor.MouseUp
Draw = False
End Sub
and heres the first paint sub i made:
Private Sub canvaseditor_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles canvaseditor.Paint
If Not bmpNew Is Nothing Then
e.Graphics.DrawImage(bmpNew, 0, 0)
End If
Dim g As Graphics = e.Graphics
Dim pn As New Pen(Color.DimGray) '~~~ color of the lines
Dim x As Integer
Dim y As Integer
Dim intSpacing As Integer = 8 '~~~ spacing between adjacent lines
'~~~ Draw the horizontal lines
x = canvaseditor.Width
For y = 0 To canvaseditor.Height Step intSpacing
g.DrawLine(pn, New Point(0, y), New Point(x, y))
Next
'~~~ Draw the vertical lines
y = canvaseditor.Height
For x = 0 To canvaseditor.Width Step intSpacing
g.DrawLine(pn, New Point(x, 0), New Point(x, y))
Next
End Sub
hoping this is understandable so someone can point me in the right direction. thanks.

how to maintain the location of a picturebox in the panel

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

How to screenshot only the area inside an Ellipse?

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)