PictureBox shouldn't fire events on its own - vb.net

I am writing a WinForms application (.NET 4.8) with which you can load a picture into a PictureBox, move it, zoom it and finally draw on it.
It is planned that the picture will be moved first and then drawn on it. Therefore, the picture is only assigned to the PictureBox when the relevant radio button has been checked. Unfortunately, the assignment of an image raises the paint event again and again. There is an infinite loop when triggered once. How can I prevent this? I've already tried to inherit from PictureBox and set the settings differently.
Public Class PictBoxEx : Inherits PictureBox
Public Sub New()
SetStyle(ControlStyles.Selectable Or ControlStyles.UserMouse, True) ' Important so that the PictureBox does not throw events on its own!
End Sub
End Class
Private Sub PictureBoxEx1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBoxEx1.Paint
If LoadedImage Is Nothing Then
Return
End If
If RadioButton_verschieben.Checked Then
Dim the_rectangle_to_be_zoomed_in_and_drawn As RectangleF = calculate_zoomed_and_or_moved_rect()
e.Graphics.DrawImage(LoadedImage, the_rectangle_to_be_zoomed_in_and_drawn)
ElseIf RadioButton_freihand.Checked Then
PictureBoxEx1.Image = Nothing
GC.Collect()
PictureBoxEx1.Image = LoadedImage
FunctionsToDraw.DrawTheUsersPath(e.Graphics)
End If
End Sub
This is the problematic procedure.↑
In case you need more information, I'll put the source code in here.
Form1.vb
Imports System.Drawing.Drawing2D
Imports Microsoft.VisualBasic.ControlChars
Imports Microsoft.WindowsAPICodePack.Dialogs
Public NotInheritable Class FormMain
'— — — — — — — — — — — — — — — — — — — — — — — — — — — — — — —
'these variables are used for moving and zooming
Private Shared LoadedImage As System.Drawing.Bitmap
Private Shared current_Zoom_factor As Single = 1.0F
Private mouse_location As PointF = Point.Empty
Private image_location As PointF = Point.Empty
Private image_rect As RectangleF = RectangleF.Empty
Private mouse_up_must_follow As Boolean
Private moving As Boolean
'— — — — — — — — — — — — — — — — — — — — — — — — — — — — — — —
'these variables are used for drawing
Private Shared _manuallydrawnpathonscreen As New System.Drawing.Drawing2D.GraphicsPath
Private last_mouse_location_on_screen As Point
Public Shared Property Manuallydrawnpathonscreen As GraphicsPath
Get
Return _manuallydrawnpathonscreen
End Get
Set(value As GraphicsPath)
_manuallydrawnpathonscreen = value
End Set
End Property
Private Sub FormMain_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.BackColor = Color.FromArgb(0, 0, 31) ' very dark blue
For Each Bu As Button In Me.Controls.OfType(Of Button)
Bu.BackColor = Color.FromArgb(201, 201, 189)
Next
RadioButton_verschieben.Text = $"verschieben{NewLine}und{NewLine}zoomen"
RadioButton_verschieben.Checked = True
End Sub
Private Sub ButtonStart_Click(sender As Object, e As EventArgs) Handles ButtonStart.Click
Using OFD As New CommonOpenFileDialog
OFD.Title = "Bild zum Öffnen auswählen"
OFD.Filters.Add(New CommonFileDialogFilter("images", ".jpg;.jpeg;.bmp;.png"))
OFD.InitialDirectory = Environment.GetFolderPath(Environment.SpecialFolder.Desktop)
If OFD.ShowDialog() = CommonFileDialogResult.Ok Then
LoadedImage = Nothing
PictureBoxEx1.Image = Nothing
GC.Collect()
LoadedImage = New System.Drawing.Bitmap(OFD.FileName)
current_Zoom_factor = 1.0F
mouse_location = Point.Empty
image_location = Point.Empty
image_rect = RectangleF.Empty
Manuallydrawnpathonscreen.ClearMarkers()
'PictureBoxEx1.Image = LoadedImage
resize_PictureBox()
Else
Return
End If
End Using
End Sub
Private Sub resize_PictureBox()
If LoadedImage Is Nothing Then Return
'Width of the current picture
Dim Aktuelle_Breite As Integer = LoadedImage.Size.Width
'Height of the current picture
Dim Aktuelle_Hoehe As Integer = LoadedImage.Size.Height
' possible width on Form
Dim Moegliche_Breite As Integer = 1762
' possible height on Form
Dim Moegliche_Hoehe As Integer = 1000
If Aktuelle_Breite > Moegliche_Breite OrElse Aktuelle_Hoehe > Moegliche_Hoehe Then
PictureBoxEx1.SizeMode = PictureBoxSizeMode.StretchImage
PictureBoxEx1.Size = If(CInt(Math.Round(Aktuelle_Breite * Moegliche_Hoehe / Aktuelle_Hoehe, 0)) > Moegliche_Breite,
New Size(Moegliche_Breite, CInt(Math.Round(Aktuelle_Hoehe * Moegliche_Breite / Aktuelle_Breite, 0))),
New Size(CInt(Math.Round(Aktuelle_Breite * Moegliche_Hoehe / Aktuelle_Hoehe, 0)), Moegliche_Hoehe))
Else
PictureBoxEx1.SizeMode = PictureBoxSizeMode.Normal
PictureBoxEx1.Size = New Size(Aktuelle_Breite, Aktuelle_Hoehe)
End If
End Sub
Private Sub PictureBoxEx1_MouseDown(sender As Object, e As MouseEventArgs) Handles PictureBoxEx1.MouseDown
Select Case e.Button
Case MouseButtons.Left
If RadioButton_verschieben.Checked Then
mouse_location = e.Location
image_location = image_rect.Location ' ist (0|0) wenn Bild frisch geladen
Me.Cursor = Cursors.NoMove2D
mouse_up_must_follow = True
moving = True
PictureBoxEx1.Invalidate()
Return
ElseIf RadioButton_freihand.Checked Then
Manuallydrawnpathonscreen.AddLine(last_mouse_location_on_screen, e.Location)
End If
Case MouseButtons.Right
If RadioButton_freihand.Checked Then
Manuallydrawnpathonscreen.ClearMarkers()
PictureBoxEx1.Invalidate()
End If
Case Else
Exit Select
End Select
End Sub
Private Sub PictureBoxEx1_MouseMove(sender As Object, e As MouseEventArgs) Handles PictureBoxEx1.MouseMove
If e.Button = MouseButtons.Left AndAlso mouse_up_must_follow Then
If RadioButton_verschieben.Checked Then
'for Zoom
image_rect.Location = New PointF(image_location.X + (e.Location.X - mouse_location.X),
image_location.Y + (e.Location.Y - mouse_location.Y))
mouse_up_must_follow = True
moving = True
PictureBoxEx1.Invalidate()
Return
' end Zoom region
ElseIf RadioButton_freihand.Checked Then
mouse_up_must_follow = True
moving = True
Manuallydrawnpathonscreen.AddLine(last_mouse_location_on_screen, e.Location)
PictureBoxEx1.Invalidate()
End If
End If
last_mouse_location_on_screen = e.Location
End Sub
Private Sub PictureBoxEx1_MouseUp(sender As Object, e As MouseEventArgs) Handles PictureBoxEx1.MouseUp
If e.Button = MouseButtons.Left AndAlso mouse_up_must_follow Then
If RadioButton_verschieben.Checked Then
Me.Cursor = Cursors.Default
mouse_up_must_follow = False
moving = False
Return
ElseIf RadioButton_freihand.Checked Then
Manuallydrawnpathonscreen.CloseFigure()
mouse_up_must_follow = False
End If
End If
last_mouse_location_on_screen = e.Location
End Sub
Private Sub PictBox1_MouseWheel(sender As System.Object, e As MouseEventArgs) Handles PictureBoxEx1.MouseWheel
If RadioButton_verschieben.Checked Then
If e.Delta > 0 Then
current_Zoom_factor += (1.0F / 30.0F)
PictureBoxEx1.Invalidate()
Else
If current_Zoom_factor > 0.0F Then
current_Zoom_factor -= (1.0F / 30.0F)
PictureBoxEx1.Invalidate()
End If
End If
End If
End Sub
Private Sub PictureBoxEx1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBoxEx1.Paint
If LoadedImage Is Nothing Then
Return
End If
If RadioButton_verschieben.Checked Then
Dim the_rectangle_to_be_zoomed_in_and_drawn As RectangleF = calculate_zoomed_and_or_moved_rect()
e.Graphics.DrawImage(LoadedImage, the_rectangle_to_be_zoomed_in_and_drawn)
ElseIf RadioButton_freihand.Checked Then
PictureBoxEx1.Image = Nothing
GC.Collect()
PictureBoxEx1.Image = LoadedImage
FunctionsToDraw.DrawTheUsersPath(e.Graphics)
End If
End Sub
Private Function calculate_zoomed_and_or_moved_rect() As RectangleF
image_rect.Width = PictureBoxEx1.Width
image_rect.Height = PictureBoxEx1.Height
Dim newLocation As PointF
If moving Then
newLocation = image_rect.Location
Else
newLocation = New PointF(
PictureBoxEx1.Location.X + (PictureBoxEx1.Size.Width / 2.0F) - image_rect.Width * current_Zoom_factor / 2.0F,
PictureBoxEx1.Location.Y + (PictureBoxEx1.Size.Height / 2.0F) - image_rect.Height * current_Zoom_factor / 2.0F)
End If
Dim scaled As New RectangleF(newLocation,
New SizeF(image_rect.Width * current_Zoom_factor, image_rect.Height * current_Zoom_factor))
Return scaled
End Function
End Class
FunctionsToDraw.vb
Public NotInheritable Class FunctionsToDraw
Public Shared Sub DrawTheUsersPath(ByVal g As Drawing.Graphics)
If g Is Nothing Then
Return
End If
g.SmoothingMode = System.Drawing.Drawing2D.SmoothingMode.AntiAlias
g.CompositingQuality = System.Drawing.Drawing2D.CompositingQuality.HighQuality
g.PixelOffsetMode = System.Drawing.Drawing2D.PixelOffsetMode.HighQuality
g.InterpolationMode = System.Drawing.Drawing2D.InterpolationMode.HighQualityBilinear
Using Pen_green As New Pen(Color.FromArgb(0, 210, 0), 2.0F)
g.DrawPath(Pen_green, FormMain.Manuallydrawnpathonscreen)
End Using
End Sub
End Class

I've now solved the problem. You all were right – it was not wise to assign a picture to the Picturebox in the paint event handler, especially since I also want to draw on the zoomed rectangle. I thought I had to get the problem resolved first, but then discovered that this was actually the problem.
I've done it now. I can draw on the zoomed and shifted rectangle.
I created a second form showing the current values of the mouse and the rectangle. In the near future, I will test to calculate where the coordinates are on the original image when I draw a GraphicsPath on the zoomed and shifted image.
I'm putting the entire code online because I have rebuilt a lot. You are welcome to submit suggestions for improvement.
Form1.vb
#Disable Warning CA1707
Imports Microsoft.VisualBasic.ControlChars
Imports Microsoft.WindowsAPICodePack.Dialogs
Public NotInheritable Class FormMain
Private Shared _lF As LoggingForm
Private Shared _deu As New System.Globalization.CultureInfo("de-DE")
'— — — — — — — — — — — — — — — — — — — — — — — — — — — — — — —
'these variables are used for moving and zooming
Private Shared _loadedImage As System.Drawing.Bitmap
Private Shared current_Zoom_factor As Single = 1.0F
Private mouse_location As PointF = Point.Empty
Private image_location As PointF = Point.Empty
Private image_rect As RectangleF = RectangleF.Empty
Private mouse_up_must_follow As Boolean
Private moving As Boolean
'— — — — — — — — — — — — — — — — — — — — — — — — — — — — — — —
'these variables are used for drawing
Private Shared _manuallydrawnpathonscreen As New System.Drawing.Drawing2D.GraphicsPath
Private Shared _lastMouseLocationOnScreen As Point = Point.Empty
Public Shared Property Manuallydrawnpathonscreen As Drawing2D.GraphicsPath
Get
Return _manuallydrawnpathonscreen
End Get
Set(value As Drawing2D.GraphicsPath)
_manuallydrawnpathonscreen = value
End Set
End Property
Public Shared Property LoadedImage As Bitmap
Get
Return _loadedImage
End Get
Set(value As Bitmap)
_loadedImage = value
End Set
End Property
Public Shared Property LastMouseLocationOnScreen As Point
Get
Return _lastMouseLocationOnScreen
End Get
Set(value As Point)
_lastMouseLocationOnScreen = value
End Set
End Property
Public Shared Property Deu As System.Globalization.CultureInfo
Get
Return _deu
End Get
Set(value As System.Globalization.CultureInfo)
_deu = value
End Set
End Property
Public Shared Property LF As LoggingForm
Get
Return _lF
End Get
Set(value As LoggingForm)
_lF = value
End Set
End Property
'— — — — — — — — — — — — — — — — — — — — — — — — — — — — — — —
Private Sub FormMain_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.BackColor = Color.FromArgb(0, 0, 31) ' very dark blue
For Each Bu As Button In Me.Controls.OfType(Of Button)
Bu.BackColor = Color.FromArgb(201, 201, 189)
Next
RadioButton_verschieben.Text = $"verschieben{NewLine}und{NewLine}zoomen"
RadioButton_verschieben.Checked = True
'––––––––––––––––––––––––––––––––––––––––––––––
' Find a second screen if possible.
Dim allScreens As Screen() = Screen.AllScreens
If allScreens.Length = 2 Then
Me.Location = New Point(allScreens(1).Bounds.X, allScreens(1).Bounds.Y)
End If
'––––––––––––––––––––––––––––––––––––––––––––––
End Sub
Private Sub FormMain_Shown(sender As Object, e As EventArgs) Handles MyBase.Shown
LF = New LoggingForm
LF.Show()
End Sub
Private Sub ButtonStart_Click(sender As Object, e As EventArgs) Handles ButtonStart.Click
Using OFD As New CommonOpenFileDialog
OFD.Title = "Bild zum Öffnen auswählen"
OFD.Filters.Add(New CommonFileDialogFilter("images", ".jpg;.jpeg;.bmp;.png"))
OFD.InitialDirectory = Environment.GetFolderPath(Environment.SpecialFolder.Desktop)
If OFD.ShowDialog() = CommonFileDialogResult.Ok Then
LoadedImage = Nothing
PictureBoxEx1.Image = Nothing
LoadedImage = New System.Drawing.Bitmap(OFD.FileName)
current_Zoom_factor = 1.0F
mouse_location = Point.Empty
image_location = Point.Empty
image_rect = RectangleF.Empty
PictureBoxEx1.Image = LoadedImage ' must be assigned once so that the PictureBox assumes the correct dimensions with ‘resize_PictureBox()’. This is also important later for the rectangle.
resize_PictureBox()
PictureBoxEx1.Image = Nothing
GC.Collect()
Else
Return
End If
End Using
End Sub
Private Sub resize_PictureBox()
If LoadedImage Is Nothing Then Return
'Width of the current picture
Dim Aktuelle_Breite As Integer = LoadedImage.Size.Width
'Height of the current picture
Dim Aktuelle_Hoehe As Integer = LoadedImage.Size.Height
' possible width on Form
Dim Moegliche_Breite As Integer = 1762
' possible height on Form
Dim Moegliche_Hoehe As Integer = 1000
If Aktuelle_Breite > Moegliche_Breite OrElse Aktuelle_Hoehe > Moegliche_Hoehe Then
PictureBoxEx1.SizeMode = PictureBoxSizeMode.StretchImage
PictureBoxEx1.Size = If(CInt(Math.Round(Aktuelle_Breite * Moegliche_Hoehe / Aktuelle_Hoehe, 0)) > Moegliche_Breite,
New Size(Moegliche_Breite, CInt(Math.Round(Aktuelle_Hoehe * Moegliche_Breite / Aktuelle_Breite, 0))),
New Size(CInt(Math.Round(Aktuelle_Breite * Moegliche_Hoehe / Aktuelle_Hoehe, 0)), Moegliche_Hoehe))
Else
PictureBoxEx1.SizeMode = PictureBoxSizeMode.Normal
PictureBoxEx1.Size = New Size(Aktuelle_Breite, Aktuelle_Hoehe)
End If
End Sub
Private Sub PictureBoxEx1_MouseDown(sender As Object, e As MouseEventArgs) Handles PictureBoxEx1.MouseDown
Select Case e.Button
Case MouseButtons.Left
If RadioButton_verschieben.Checked Then
mouse_location = e.Location
image_location = image_rect.Location ' is (0 | 0) if the picture is freshly loaded
Me.Cursor = Cursors.NoMove2D
mouse_up_must_follow = True
moving = True
Return
ElseIf RadioButton_freihand.Checked Then
mouse_up_must_follow = True
Manuallydrawnpathonscreen.AddLine(LastMouseLocationOnScreen, e.Location)
PictureBoxEx1.Invalidate()
End If
Case MouseButtons.Right
If RadioButton_freihand.Checked Then
Manuallydrawnpathonscreen = New Drawing2D.GraphicsPath
PictureBoxEx1.Invalidate()
End If
Case Else
Exit Select
End Select
End Sub
Private Sub PictureBoxEx1_MouseMove(sender As Object, e As MouseEventArgs) Handles PictureBoxEx1.MouseMove
If e.Button = MouseButtons.Left AndAlso mouse_up_must_follow Then
If RadioButton_verschieben.Checked Then
'for Zoom
image_rect.Location = New PointF(image_location.X + (e.Location.X - mouse_location.X),
image_location.Y + (e.Location.Y - mouse_location.Y))
mouse_up_must_follow = True
moving = True
PictureBoxEx1.Invalidate()
Return
' end Zoom region
ElseIf RadioButton_freihand.Checked Then
mouse_up_must_follow = True
moving = True
Manuallydrawnpathonscreen.AddLine(LastMouseLocationOnScreen, e.Location)
PictureBoxEx1.Invalidate()
End If
End If
LastMouseLocationOnScreen = e.Location
End Sub
Private Sub PictureBoxEx1_MouseUp(sender As Object, e As MouseEventArgs) Handles PictureBoxEx1.MouseUp
If e.Button = MouseButtons.Left AndAlso mouse_up_must_follow Then
If RadioButton_verschieben.Checked Then
Me.Cursor = Cursors.Default
mouse_up_must_follow = False
moving = False
Return
ElseIf RadioButton_freihand.Checked Then
Manuallydrawnpathonscreen.CloseFigure()
mouse_up_must_follow = False
End If
End If
LastMouseLocationOnScreen = e.Location
End Sub
Private Sub PictBox1_MouseWheel(sender As System.Object, e As MouseEventArgs) Handles PictureBoxEx1.MouseWheel
If RadioButton_verschieben.Checked Then
If e.Delta > 0 Then
current_Zoom_factor += (1.0F / 30.0F)
PictureBoxEx1.Invalidate()
Else
If current_Zoom_factor > 0.0F Then
current_Zoom_factor -= (1.0F / 30.0F)
PictureBoxEx1.Invalidate()
End If
End If
End If
End Sub
Private Sub PictureBoxEx1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBoxEx1.Paint
If LoadedImage Is Nothing Then
Return
End If
If RadioButton_verschieben.Checked Then
Dim the_rectangle_to_be_zoomed_in_and_drawn As RectangleF = calculate_zoomed_and_or_moved_rect()
e.Graphics.DrawImage(LoadedImage, the_rectangle_to_be_zoomed_in_and_drawn)
LF.updateListBox1(the_rectangle_to_be_zoomed_in_and_drawn.X.ToString(Deu),
the_rectangle_to_be_zoomed_in_and_drawn.Y.ToString(Deu),
the_rectangle_to_be_zoomed_in_and_drawn.Width.ToString(Deu),
the_rectangle_to_be_zoomed_in_and_drawn.Height.ToString(Deu),
current_Zoom_factor.ToString(Deu))
ElseIf RadioButton_freihand.Checked Then
Dim the_rectangle_to_be_zoomed_in_and_drawn As RectangleF = calculate_zoomed_and_or_moved_rect()
FunctionsToDraw.DrawTheUsersPath(e.Graphics, the_rectangle_to_be_zoomed_in_and_drawn)
End If
End Sub
Private Function calculate_zoomed_and_or_moved_rect() As RectangleF
image_rect.Width = PictureBoxEx1.Width
image_rect.Height = PictureBoxEx1.Height
Dim newLocation As PointF
If moving Then
newLocation = image_rect.Location
Else
newLocation = New PointF(
PictureBoxEx1.Location.X + (PictureBoxEx1.Size.Width / 2.0F) - image_rect.Width * current_Zoom_factor / 2.0F,
PictureBoxEx1.Location.Y + (PictureBoxEx1.Size.Height / 2.0F) - image_rect.Height * current_Zoom_factor / 2.0F)
End If
Dim scaled As New RectangleF(newLocation,
New SizeF(image_rect.Width * current_Zoom_factor, image_rect.Height * current_Zoom_factor))
Return scaled
End Function
End Class
#Enable Warning CA1707
FunctionsToDraw.vb
Public NotInheritable Class FunctionsToDraw
Public Shared Sub DrawTheUsersPath(g As Graphics, ByVal r As RectangleF)
If g Is Nothing OrElse r.Width = 0.0F Then
Return
End If
g.SmoothingMode = System.Drawing.Drawing2D.SmoothingMode.AntiAlias
g.CompositingQuality = System.Drawing.Drawing2D.CompositingQuality.HighQuality
g.PixelOffsetMode = System.Drawing.Drawing2D.PixelOffsetMode.HighQuality
g.InterpolationMode = System.Drawing.Drawing2D.InterpolationMode.HighQualityBilinear
Using Pen_green As New Pen(Color.FromArgb(0, 210, 0), 2.0F)
g.DrawImage(FormMain.LoadedImage, r)
g.DrawPath(Pen_green, FormMain.Manuallydrawnpathonscreen)
FormMain.LF.updateListBox2(FormMain.LastMouseLocationOnScreen.X.ToString(FormMain.Deu),
FormMain.LastMouseLocationOnScreen.Y.ToString(FormMain.Deu))
End Using
End Sub
End Class
PictureBoxEx.vb
Public NotInheritable Class PictureBoxEx : Inherits PictureBox
Public Sub New()
SetStyle(ControlStyles.Selectable Or ControlStyles.UserMouse, True)
End Sub
End Class

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

Rotated plane—projected and drawn in 2D—looks crooked instead of straight at some edges

Introductory remarks
The purpose of this program is to rotate a mathematical plane around the x and z axes and to project this onto the 2D GUI.
First about the sign convention:
The plane lies in the xz-plane (so at the origin), where +x goes to the right, +y to the depth of the picture and +z to the top (compare: I look at another person as a person).
Many vectors are used to fill the surface. Depending on the size of the plane, there are often more than 40,000 vectors. So I decided to run the calculation function asynchronously. Since it is now cumbersome / nonsensical to paint in the PictureBox, I write in a bitmap, which I then assign to the PictureBox after each calculation process. Since the Graphics.DrawLine function reached its limits in terms of performance, I integrated SkiaSharp from Visual Studio's own Nuget package manager. Now, I write in an SKBtmap and can move the plane with the WASD keys and get a new image within a few hundred milliseconds.
For the projection, I use a formula that I found at StackOverflow a few months ago. I have now shown it clearly and distinctly. Since the plane partly comes towards me when turning, the distance to me changes. So, I subtract the distance_to_plane to get the real distance.
Dim projected As New PointF(
CSng((Camera - Window_distance) / (Camera - distance_to_plane) * rotatedVec.X),
CSng(-(Camera - Window_distance) / (Camera - distance_to_plane) * rotatedVec.Z))
What is my concern to you:
As you can see from the pictures, the plane has some curves (outliers) at the edges where it should be straight instead. I can't explain the effect.
I suspect the above formula. To remedy this, I set the camera very far away from the plane, and the projection window far away ‘enough’ from both the camera and the plane.
I'll put the complete source code online, maybe it's something else (a typical effect?).
Form ‘Create’ to instantiate a new plane.
Plane strongly rotated around the z-axis with odd edges in the middle. As you can see from the values, the camera is currently 2660 units of length away from the plane, and the projection window is 1000 units of length. (Camera – window 1660)
Form1.vb
Public NotInheritable Class FormMain
Private Plane1 As PlaneInTermsOfGeometry = Nothing
Public ReadOnly Deu As New System.Globalization.CultureInfo("de-DE")
Private Sub FormMain_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.BackColor = Color.FromArgb(184, 176, 143)
For Each but As Button In Me.Controls.OfType(Of Button)
but.BackColor = Color.FromArgb(201, 200, 193)
Next
TextBox_Window.Text = "-1000"
Label5.Text = ""
Label6.Text = ""
End Sub
Private Sub FormMain_Shown(sender As Object, e As EventArgs) Handles MyBase.Shown
New_Plane()
End Sub
Private Sub Button_new_plane_Click(sender As Object, e As EventArgs) Handles Button_new_plane.Click
New_Plane()
End Sub
Private Async Sub New_Plane()
Using FNP As New FormCreateNewPlane
If FNP.ShowDialog(Me) <> DialogResult.OK Then
Return
End If
Plane1 = New PlaneInTermsOfGeometry(
FNP.A0x,
FNP.A0y,
FNP.A0z,
FNP.ABx,
FNP.ABy,
FNP.ABz,
FNP.ACx,
FNP.ACy,
FNP.ACz,
FNP.Enlargement)
Await Plane1.process_async()
PictureBox1.Image = Nothing
PictureBox1.Image = PlaneInTermsOfGeometry.displayedBitmap
Label5.Text = Math.Round(Plane1.current_x_angle, 0).ToString(Deu)
Label6.Text = Math.Round(Plane1.current_z_angle, 0).ToString(Deu)
TextBox_Kamera.Text = Math.Round(Plane1.Camera, 0).ToString(Deu)
End Using
End Sub
Private Sub TextBox_Kamera_TextChanged(sender As Object, e As EventArgs) Handles TextBox_Kamera.TextChanged
If Plane1 Is Nothing Then Return
Dim Kamera As Double
If Double.TryParse(TextBox_Kamera.Text, Kamera) Then
TextBox_Kamera.ForeColor = Color.FromArgb(0, 125, 0)
Plane1.Camera = Kamera
Else
TextBox_Kamera.ForeColor = Color.Red
End If
End Sub
Private Sub TextBox_Fenster_TextChanged(sender As Object, e As EventArgs) Handles TextBox_Window.TextChanged
If Plane1 Is Nothing Then Return
Dim Fenster As Double
If Double.TryParse(TextBox_Window.Text, Fenster) Then
TextBox_Window.ForeColor = Color.FromArgb(0, 125, 0)
Plane1.Window_distance = Fenster
Else
TextBox_Window.ForeColor = Color.Red
End If
End Sub
Private Async Sub FormMain_KeyDown(sender As Object, e As KeyEventArgs) Handles MyBase.KeyDown
If Plane1 Is Nothing Then Return
Select Case e.KeyCode
Case Keys.W
If Plane1.current_x_angle > -90.0 Then
Plane1.change_x_angle(-1.0)
Await Plane1.process_async()
PictureBox1.Image = Nothing
GC.Collect()
PictureBox1.Image = PlaneInTermsOfGeometry.displayedBitmap
Label5.Text = Math.Round(Plane1.current_x_angle, 0).ToString(Deu)
Label6.Text = Math.Round(Plane1.current_z_angle, 0).ToString(Deu)
TextBox_KOForm.Text = Plane1.Cartesian_Equation()
End If
Case Keys.S
If Plane1.current_x_angle < 90.0 Then
Plane1.change_x_angle(1.0)
Await Plane1.process_async()
PictureBox1.Image = Nothing
GC.Collect()
PictureBox1.Image = PlaneInTermsOfGeometry.displayedBitmap
Label5.Text = Math.Round(Plane1.current_x_angle, 0).ToString(Deu)
Label6.Text = Math.Round(Plane1.current_z_angle, 0).ToString(Deu)
TextBox_KOForm.Text = Plane1.Cartesian_Equation()
End If
Case Keys.A
If Plane1.current_z_angle > -90.0 Then
Plane1.change_z_angle(-1.0)
Await Plane1.process_async()
PictureBox1.Image = Nothing
GC.Collect()
PictureBox1.Image = PlaneInTermsOfGeometry.displayedBitmap
Label5.Text = Math.Round(Plane1.current_x_angle, 0).ToString(Deu)
Label6.Text = Math.Round(Plane1.current_z_angle, 0).ToString(Deu)
TextBox_KOForm.Text = Plane1.Cartesian_Equation()
End If
Case Keys.D
If Plane1.current_z_angle < 90.0 Then
Plane1.change_z_angle(1.0)
Await Plane1.process_async()
PictureBox1.Image = Nothing
GC.Collect()
PictureBox1.Image = PlaneInTermsOfGeometry.displayedBitmap
Label5.Text = Math.Round(Plane1.current_x_angle, 0).ToString(Deu)
Label6.Text = Math.Round(Plane1.current_z_angle, 0).ToString(Deu)
TextBox_KOForm.Text = Plane1.Cartesian_Equation()
End If
Case Else
Exit Select
End Select
End Sub
Private Async Sub FormMain_MouseWheel(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseWheel
If Plane1 Is Nothing Then Return
If e.Delta > 0 Then
' The Camera must be in front of the window.
If (Plane1.Camera - Plane1.Window_distance) < 0.0 Then
Plane1.change_Camera_distance(20.0)
Await Plane1.process_async()
PictureBox1.Image = Nothing
GC.Collect()
PictureBox1.Image = PlaneInTermsOfGeometry.displayedBitmap
End If
Else
Plane1.change_Camera_distance(-20.0)
Await Plane1.process_async()
PictureBox1.Image = Nothing
GC.Collect()
PictureBox1.Image = PlaneInTermsOfGeometry.displayedBitmap
End If
TextBox_Kamera.Text = Math.Round(Plane1.Camera, 0).ToString(Deu)
End Sub
End Class
class PlaneInTermsOfGeometry (By the way: I was politely instructed to choose a reasonable name for this class instead of just "Plane"...)
Imports System.Windows.Media.Media3D
Imports SkiaSharp
Public NotInheritable Class PlaneInTermsOfGeometry
Private Structure VA0
Public x As Double
Public y As Double
Public z As Double
End Structure
Private A0 As VA0
Private Structure VAB
Public x As Double
Public y As Double
Public z As Double
End Structure
' →
Private AB As VAB
Private Structure VAC
Public x As Double
Public y As Double
Public z As Double
End Structure
' →
Private AC As VAC
Private ReadOnly allVectors As New List(Of Vector3D)
''' <summary>
''' in degrees
''' </summary>
Public current_x_angle As Double = 0.0
''' <summary>
''' in degrees
''' </summary>
Public current_z_angle As Double = 0.0
''' <summary>
''' The picture in which is written and which is shown by the PictureBox.
''' </summary>
Public Shared displayedBitmap As System.Drawing.Bitmap
''' <summary>
''' The camera position on the y-axis (we look along the +y arrow).
''' </summary>
Public Camera As Double = -2660.0
''' <summary>
''' The projection window position on the y-axis. Absolute value!
''' </summary>
Public Window_distance As Double = -1000.0
''' <summary>
''' The distance from the origin of coordinates to the x-length
''' </summary>
Private ReadOnly oneSide As Double
Private ReadOnly Grid As New List(Of Vector3D)
Public Sub New(ByVal A0x As Double,
ByVal A0y As Double,
ByVal A0z As Double,
ByVal ABx As Double,
ByVal ABy As Double,
ByVal ABz As Double,
ByVal ACx As Double,
ByVal ACy As Double,
ByVal ACz As Double,
ByVal enlarg As Double)
Me.A0.x = A0x
Me.A0.y = A0y
Me.A0.z = A0z
Me.AB.x = ABx * enlarg
Me.AB.y = ABy
Me.AB.z = ABz
Me.AC.x = ACx
Me.AC.y = ACy
Me.AC.z = ACz * enlarg
Me.oneSide = ABx * enlarg
For x As Double = -AB.x To AB.x Step 1.0
For z As Double = -AC.z To AC.z Step 2.0
allVectors.Add(New Vector3D(x, 0.0, z))
' For the grid
If CSng(x) Mod 15.0F = 0.0F Then
Grid.Add(New Vector3D(x, 0.0, z))
Else
Grid.Add(New Vector3D(0.0, 0.0, 0.0))
End If
Next
Next
End Sub
Public Sub change_Camera_distance(ByVal dy As Double)
Camera += dy
End Sub
Public Sub change_x_angle(ByVal value As Double)
current_x_angle += value
End Sub
Public Sub change_z_angle(ByVal value As Double)
current_z_angle += value
End Sub
Private Function rotate_around_x_axis(ByVal vec1 As Vector3D) As Vector3D
Return New Vector3D(
vec1.X,
vec1.Y * Math.Cos(current_x_angle * Math.PI / 180.0) - vec1.Z * Math.Sin(current_x_angle * Math.PI / 180.0),
vec1.Y * Math.Sin(current_x_angle * Math.PI / 180.0) + Math.Cos(current_x_angle * Math.PI / 180.0) * vec1.Z)
End Function
Private Function rotate_around_z_axis(ByVal vec2 As Vector3D) As Vector3D
Return New Vector3D(
Math.Cos(current_z_angle * Math.PI / 180.0) * vec2.X - vec2.Y * Math.Sin(current_z_angle * Math.PI / 180.0),
Math.Sin(current_z_angle * Math.PI / 180.0) * vec2.X + vec2.Y * Math.Cos(current_z_angle * Math.PI / 180.0),
vec2.Z)
End Function
Public Async Function process_async() As Task(Of Boolean)
Return Await Task.Run(Function() processing())
End Function
Private Function processing() As Boolean
displayedBitmap = Nothing
Dim i As Integer = 0
Dim imageInfo As New SKImageInfo(FormMain.PictureBox1.Size.Width, FormMain.PictureBox1.Size.Height)
Using surface As SKSurface = SKSurface.Create(imageInfo)
Using canvas As SKCanvas = surface.Canvas
canvas.Translate(FormMain.PictureBox1.Size.Width \ 2, FormMain.PictureBox1.Size.Height \ 2)
Using DarkBlue As New SKPaint With {
.TextSize = 64.0F,
.IsAntialias = True,
.Color = New SKColor(0, 64, 255),
.Style = SKPaintStyle.Fill
}
Using BrightYellow As New SKPaint With {
.TextSize = 64.0F,
.IsAntialias = True,
.Color = New SKColor(255, 255, 64),
.Style = SKPaintStyle.Fill
}
For Each vec As Vector3D In allVectors
Dim rotatedVec As Vector3D = rotate_around_z_axis(rotate_around_x_axis(vec))
If rotatedVec.Y > Window_distance Then ' The object is not further back than the window (the window is not in the object). When false, don't draw!
Dim Angle_in_degrees As Double = Vector3D.AngleBetween(
rotatedVec,
New Vector3D(rotatedVec.X, 0.0, rotatedVec.Z))
If Double.IsNaN(Angle_in_degrees) Then
i += 1
Continue For
End If
' Opposite cathetus
Dim distance_to_plane As Double = oneSide * Math.Sin(Angle_in_degrees * Math.PI / 180.0)
Dim projected As New PointF(
CSng((Camera - Window_distance) / (Camera - distance_to_plane) * rotatedVec.X),
CSng(-(Camera - Window_distance) / (Camera - distance_to_plane) * rotatedVec.Z))
If Grid(i).X = 0.0 AndAlso Grid(i).Y = 0.0 AndAlso Grid(i).Z = 0.0 Then
' draw the mathematical plane
canvas.DrawPoint(projected.X, projected.Y, DarkBlue)
Else
' draw the grid (Gitternetz)
canvas.DrawPoint(projected.X, projected.Y, BrightYellow)
End If
i += 1
End If
Next
End Using
End Using
End Using
'–––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––
' get the data into ‘displayedBitmap’ because the PictureBox is only accepting an usual System.Drawing.Bitmap.
'–––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––
Using image As SKImage = surface.Snapshot()
Using data As SKData = image.Encode(SKEncodedImageFormat.Png, 100)
Using mStream As New IO.MemoryStream(data.ToArray())
displayedBitmap = New Bitmap(mStream, False)
End Using
End Using
End Using
End Using
Return True
End Function
'Koordinatenform
Public Function Cartesian_Equation() As String
Dim _N As Vector3D = Vector3D.CrossProduct(rotate_around_z_axis(New Vector3D(AB.x, AB.y, AB.z)), rotate_around_x_axis(New Vector3D(AC.x, AC.y, AC.z)))
Dim _xMinusA0 As String
Dim _yMinusA0 As String
Dim _zMinusA0 As String
If A0.x = 0.0 Then
_xMinusA0 = "x"
Else
_xMinusA0 = $"(x - {A0.x.ToString(FormMain.Deu)})"
End If
If A0.y = 0.0 Then
_yMinusA0 = "y"
Else
_yMinusA0 = $"(y - {A0.y.ToString(FormMain.Deu)})"
End If
If A0.z = 0.0 Then
_zMinusA0 = "z"
Else
_zMinusA0 = $"(z - {A0.z.ToString(FormMain.Deu)})"
End If
Return ($"{Math.Round(_N.X, 3).ToString(FormMain.Deu)} * {_xMinusA0} + {Math.Round(_N.Y, 3).ToString(FormMain.Deu)} * {_yMinusA0} + {Math.Round(_N.Z, 3).ToString(FormMain.Deu)} * {_zMinusA0}").ToString(FormMain.Deu)
End Function
End Class
For the sake of completeness, if someone wants to recreate it, here is FormNewPlane.vb to create a new plane, as shown in the first picture.
Imports Microsoft.VisualBasic.ControlChars
Public NotInheritable Class FormCreateNewPlane
Public A0x, A0y, A0z, ABx, ABy, ABz, ACx, ACy, ACz, Enlargement As Double
Private Sub FormCreateNewPlane_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.BackColor = Color.FromArgb(184, 176, 143)
For Each but As Button In Me.Controls.OfType(Of Button)
but.BackColor = Color.FromArgb(201, 200, 193)
Next
If System.IO.File.Exists(Application.StartupPath & "\Preview.png") Then
PictureBox1.Image = Image.FromFile(Application.StartupPath & "\Preview.png")
End If
'Since this is a plane that lies in the xz plane, only the text box contents that display a 1 should be changed.
Label5.Text = $"Da es hier um eine Ebene geht, die{NewLine}in der xz-Ebene liegt, sollen nur die{NewLine}Textbox-Inhalte verändert werden,{NewLine}die eine 1 anzeigen."
End Sub
Private Sub FormCreateNewPlane_FormClosing(sender As Object, e As FormClosingEventArgs) Handles MyBase.FormClosing
If PictureBox1.Image IsNot Nothing Then PictureBox1.Image.Dispose()
End Sub
Private Sub ButtonOK_Click(sender As Object, e As EventArgs) Handles ButtonOK.Click
Me.DialogResult = DialogResult.OK
End Sub
Private Sub TextBoxA0x_TextChanged(sender As Object, e As EventArgs) Handles TextBoxA0x.TextChanged
If Double.TryParse(TextBoxA0x.Text, A0x) Then
TextBoxA0x.ForeColor = Color.FromArgb(0, 125, 0)
Else
TextBoxA0x.ForeColor = Color.Red
End If
End Sub
Private Sub TextBoxA0y_TextChanged(sender As Object, e As EventArgs) Handles TextBoxA0y.TextChanged
If Double.TryParse(TextBoxA0y.Text, A0y) Then
TextBoxA0y.ForeColor = Color.FromArgb(0, 125, 0)
Else
TextBoxA0y.ForeColor = Color.Red
End If
End Sub
Private Sub TextBoxA0z_TextChanged(sender As Object, e As EventArgs) Handles TextBoxA0z.TextChanged
If Double.TryParse(TextBoxA0z.Text, A0z) Then
TextBoxA0z.ForeColor = Color.FromArgb(0, 125, 0)
Else
TextBoxA0z.ForeColor = Color.Red
End If
End Sub
Private Sub TextBoxABx_TextChanged(sender As Object, e As EventArgs) Handles TextBoxABx.TextChanged
If Double.TryParse(TextBoxABx.Text, ABx) Then
TextBoxABx.ForeColor = Color.FromArgb(0, 125, 0)
Else
TextBoxABx.ForeColor = Color.Red
End If
End Sub
Private Sub TextBoxABy_TextChanged(sender As Object, e As EventArgs) Handles TextBoxABy.TextChanged
If Double.TryParse(TextBoxABy.Text, ABy) Then
TextBoxABy.ForeColor = Color.FromArgb(0, 125, 0)
Else
TextBoxABy.ForeColor = Color.Red
End If
End Sub
Private Sub TextBoxABz_TextChanged(sender As Object, e As EventArgs) Handles TextBoxABz.TextChanged
If Double.TryParse(TextBoxABz.Text, ABz) Then
TextBoxABz.ForeColor = Color.FromArgb(0, 125, 0)
Else
TextBoxABz.ForeColor = Color.Red
End If
End Sub
Private Sub TextBoxACx_TextChanged(sender As Object, e As EventArgs) Handles TextBoxACx.TextChanged
If Double.TryParse(TextBoxACx.Text, ACx) Then
TextBoxACx.ForeColor = Color.FromArgb(0, 125, 0)
Else
TextBoxACx.ForeColor = Color.Red
End If
End Sub
Private Sub TextBoxACy_TextChanged(sender As Object, e As EventArgs) Handles TextBoxACy.TextChanged
If Double.TryParse(TextBoxACy.Text, ACy) Then
TextBoxACy.ForeColor = Color.FromArgb(0, 125, 0)
Else
TextBoxACy.ForeColor = Color.Red
End If
End Sub
Private Sub TextBoxACz_TextChanged(sender As Object, e As EventArgs) Handles TextBoxACz.TextChanged
If Double.TryParse(TextBoxACz.Text, ACz) Then
TextBoxACz.ForeColor = Color.FromArgb(0, 125, 0)
Else
TextBoxACz.ForeColor = Color.Red
End If
End Sub
Private Sub TextBox_Enlarg_TextChanged(sender As Object, e As EventArgs) Handles TextBox_Enlarg.TextChanged
If Double.TryParse(TextBox_Enlarg.Text, Enlargement) Then
TextBox_Enlarg.ForeColor = Color.FromArgb(0, 125, 0)
Else
TextBox_Enlarg.ForeColor = Color.Red
End If
End Sub
Private Sub TextBox_Enlarg_KeyDown(sender As Object, e As KeyEventArgs) Handles TextBox_Enlarg.KeyDown
If e.KeyCode = Keys.Enter Then
If Double.TryParse(TextBox_Enlarg.Text, Enlargement) Then
TextBox_Enlarg.ForeColor = Color.FromArgb(0, 125, 0)
Else
TextBox_Enlarg.ForeColor = Color.Red
End If
Me.DialogResult = DialogResult.OK
End If
End Sub
Private Sub TextBox_Enlarg_KeyPress(sender As Object, e As KeyPressEventArgs) Handles TextBox_Enlarg.KeyPress
If e.KeyChar = Convert.ToChar(13) Then e.Handled = True ' This suppresses the ‘ding’ sound.
End Sub
End Class
If you'd like to apply perspective projection to the points, the projected point should be something like this;
Dim projected As New PointF(
CSng((Camera - Window_distance) / (Camera - rotatedVec.Y) * rotatedVec.X),
CSng(-(Camera - Window_distance) / (Camera - rotatedVec.Y) * rotatedVec.Z))
' In short, distance_to_plane = rotatedVec.Y

How to use a timer to change the contents of a picture box every 3 seconds

I am trying to make a fancy home screen which alternates between three pictures, every 3 seconds. How will i do this and, if possible, is it possible to make them fade in and out to look a bit better?
Here is my code:
Private Sub frmLoadUp_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim images As New List(Of Image)()
images.Add(Image.FromFile("C:\Users\lukem\Desktop\TO COPY TO ONEDRIVE\PCs\home pc.png"))
images.Add(Image.FromFile("C:\Users\lukem\Desktop\TO COPY TO ONEDRIVE\PCs\mid range pc.png"))
images.Add(Image.FromFile("C:\Users\lukem\Desktop\TO COPY TO ONEDRIVE\PCs\high end pc.png"))
Dim pictureChangeTimer As New Timer()
AddHandler pictureChangeTimer.Tick, AddressOf pictureChangeTimer_tick
pictureChangeTimer.Interval = 3000
pictureChangeTimer.Start()
End Sub
Private Sub pictureChangeTimer_tick(sender As Object, e As EventArgs)
Index = (Index + 1) Mod images.Count()
PictureBox1.Image = images(Index)
PictureBox1.Image = Image.FromFile("C:\Users\lukem\Desktop\TO COPY TO ONEDRIVE\PCs\home pc.png")
PictureBox1.Image = Image.FromFile("C:\Users\lukem\Desktop\TO COPY TO ONEDRIVE\PCs\mid range pc.png")
PictureBox1.Image = Image.FromFile("C:\Users\lukem\Desktop\TO COPY TO ONEDRIVE\PCs\high end pc.png")
End Sub
Fill your list in the Form.Load but makes the list a Form level (class level) variable so you can see it from any method in the form. You can add the Timer in the designer and set its properties there. The image will start out at index 0; Integer initializes to zero.
When your timer ticks we increment Index (which is also a Form level variable; it will hold its value between calls to the method). Next we check if we have come to the end of the list and reset to zero if we have.
Private Index As Integer
Private images As New List(Of Image)()
Private Sub frmLoadUp_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Images.Add(Image.FromFile("C:\Users\lukem\Desktop\TO COPY TO ONEDRIVE\PCs\home pc.png"))
images.Add(Image.FromFile("C:\Users\lukem\Desktop\TO COPY TO ONEDRIVE\PCs\mid range pc.png"))
images.Add(Image.FromFile("C:\Users\lukem\Desktop\TO COPY TO ONEDRIVE\PCs\high end pc.png"))
Dim pictureChangeTimer As New Timer()
AddHandler pictureChangeTimer.Tick, AddressOf pictureChangeTimer_tick
pictureChangeTimer.Interval = 3000
PictureBox1.Image = images(Index)
pictureChangeTimer.Start()
End Sub
Private Sub pictureChangeTimer_tick(sender As Object, e As EventArgs)
Index += 1
If Index > 2 Then 'There is no Index 3 so we start from the beginning again
Index = 0
End If
PictureBox1.Image = Images(Index)
End Sub
You need a few changes:
(1) Declare Images at the class level
(2) Change your picture timer to set the image by index and reset the index
Dim Images As New List(Of Image)()
Dim Index as Integer
Private Sub frmLoadUp_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Images.Add(Image.FromFile("C:\Users\lukem\Desktop\TO COPY TO ONEDRIVE\PCs\home pc.png"))
Images.Add(Image.FromFile("C:\Users\lukem\Desktop\TO COPY TO ONEDRIVE\PCs\mid range pc.png"))
Images.Add(Image.FromFile("C:\Users\lukem\Desktop\TO COPY TO ONEDRIVE\PCs\high end pc.png"))
Index = -1;
Dim pictureChangeTimer As New Timer()
AddHandler pictureChangeTimer.Tick, AddressOf pictureChangeTimer_tick
pictureChangeTimer.Interval = 3000
pictureChangeTimer.Start()
End Sub
Private Sub pictureChangeTimer_tick(sender As Object, e As EventArgs)
Index = If(Index = 2, 0, Index + 1)
PictureBox1.Image = Images(Index)
End Sub
Consider using a ColorMatrix to blend images.
First of all, create custom picture box.(code from another question)
Imports System.Drawing.Imaging
Public Class CustomPictureBox
Inherits PictureBox
Private mImg1 As Image
Private mImg2 As Image
Private mBlend As Single
Public Sub New()
SetStyle(ControlStyles.AllPaintingInWmPaint Or ControlStyles.UserPaint Or ControlStyles.OptimizedDoubleBuffer, True)
End Sub
Public Property Image1 As Image
Get
Return mImg1
End Get
Set(ByVal value As Image)
mImg1 = value
Invalidate()
End Set
End Property
Public Property Image2 As Image
Get
Return mImg2
End Get
Set(ByVal value As Image)
mImg2 = value
Invalidate()
End Set
End Property
Public Property Blend As Single
Get
Return mBlend
End Get
Set(ByVal value As Single)
mBlend = value
Invalidate()
End Set
End Property
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
If mImg1 Is Nothing OrElse mImg2 Is Nothing Then
e.Graphics.FillRectangle(New SolidBrush(Me.BackColor), New Rectangle(0, 0, Me.Width, Me.Height))
Else
Dim rc As Rectangle = New Rectangle(0, 0, Me.Width, Me.Height)
Dim cm As ColorMatrix = New ColorMatrix()
Dim ia As ImageAttributes = New ImageAttributes()
cm.Matrix33 = mBlend
ia.SetColorMatrix(cm)
e.Graphics.DrawImage(mImg2, rc, 0, 0, mImg2.Width, mImg2.Height, GraphicsUnit.Pixel, ia)
cm.Matrix33 = 1.0F - mBlend
ia.SetColorMatrix(cm)
e.Graphics.DrawImage(mImg1, rc, 0, 0, mImg1.Width, mImg1.Height, GraphicsUnit.Pixel, ia)
End If
MyBase.OnPaint(e)
End Sub
End Class
Then drag 'CustomPictureBox' and 'Timer' from Toolbox to the form.
Finally, you can refer to the following code to change the contents of a picture box every 3 seconds.
Private mBlend As Single
Private mDir As Integer = 1
Public index As Integer = 0
Public Images As List(Of Image) = New List(Of Image)()
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Images.Add(New Bitmap("path of picture1"))
Images.Add(New Bitmap("path of picture2"))
Images.Add(New Bitmap("path of picture3"))
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Timer1.Interval = 60
CustomPictureBox1.Image1 = Images(index)
index += 1
CustomPictureBox1.Image2 = Images(index)
Timer1.Enabled = True
End Sub
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
mBlend += mDir * 0.02F
If mBlend > 1 Then
mBlend = 0.0F
If (index + 1) < Images.Count Then
CustomPictureBox1.Image1 = Images(index)
index += 1
CustomPictureBox1.Image2 = Images(index)
Else
CustomPictureBox1.Image1 = Images(index)
CustomPictureBox1.Image2 = Images(0)
index = 0
End If
End If
CustomPictureBox1.Blend = mBlend
End Sub
Result of my test.

Scrolling a Picturebox inside a Panel with a static label over

I have a PictureBox inside a Panel, to get automatic scrollbars when the picture is big, a Label with the photo title.
If I place the Label over the PictureBox, the "transparent" backcolor shows correctly but the Label remains at the top of the PictureBox and gets out of the screen if I scroll up-down or side-side the Panel's scrollbar!
Instead, if I put the Label outside the Panel (over the Form), the Label remains static on top of the screen, as I want, but the transparent backcolor doesn't show correctly becomes opaque.
Then if I set the Label's Parent property to the PictureBox, the transparent backcolor works fine again, but the static position of the Label is not respected anymore and joins PictureBox again!
How can I get a static Label with transparent backcolor over a PictureBox when using the scrollbars of the Panel?
I've tested the Overlay Form. It seems to work pretty well in your context.
Source Code in PasteBin
Uploaded the modified Project in OneDrive
(I don't have FW 4.5.2, tested with FW 4.5.1 and FW 4.7.1)
An Overlay can be an interesting feature, but, as I already said, this can also be done with TextRender.DrawText() or Graphics.DrawString(), backed by the simple math needed to offset the painted text when the picture container is scrolled.
In your Project, I've eliminated Label1 and all references to it.
Then, I've set this class field:
Private OverlayShown As Boolean = False
In frmPho_Load()
Overlay.Size = New Size(200, 50)
Overlay.OverlayPosition = Overlay.Alignment.Center
Overlay.Reposition(Me.Location, Me.Size)
OverlayShown = True
Overlay.Visible = False
Overlay.Show(Me)
In frmPho_Deactivate():
If OverlayShown = False Then
antip.Width = Me.Width
antip.Height = Me.Height
antip.Visible = True
End If
OverlayShown = False
These are all the changes made to the hosting Form (Form4), the form that uses the Overlay.
Public Class frmPho
Private Overlay As New OverlayForm
Private Sub frmPho_Load(sender As Object, e As EventArgs) Handles Me.Load
Overlay.Size = New Size(200, 50)
Overlay.OverlayPosition = Overlay.Alignment.Center
Overlay.Reposition(Me.Location, Me.Size)
OverlayShown = True
Overlay.Visible = False
Overlay.Show(Me)
'(...)
Overlay.Text = IO.Path.GetFileNameWithoutExtension(_ImageFileNames(_CurrentImage))
End Sub
Private Sub CheckBox1_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox1.CheckedChanged
If CheckBox1.CheckState = False Then
Overlay.Visible = False
Else
OverlayShown = True
Overlay.Visible = True
End If
End Sub
Private Sub ShowPrevImage()
'(...)
OverlayShown = True
Overlay.Text = IO.Path.GetFileNameWithoutExtension(_ImageFileNames(_CurrentImage))
End Sub
Private Sub ShowNextImage()
'(...)
OverlayShown = True
Overlay.Text = IO.Path.GetFileNameWithoutExtension(_ImageFileNames(_CurrentImage))
End Sub
Private Sub frmPho_Deactivate(sender As Object, e As EventArgs) Handles Me.Deactivate
If OverlayShown = False Then
antip.Width = Me.Width
antip.Height = Me.Height
antip.Visible = True
End If
OverlayShown = False
End Sub
Private Sub frmPho_Move(sender As Object, e As EventArgs) Handles Me.Move
Overlay.Reposition(Me.Location, Me.Size)
End Sub
Private Sub frmPho_Resize(sender As Object, e As EventArgs) Handles Me.Resize
Overlay.Reposition(Me.Location, Me.Size)
End Sub
Private Sub frmPho_Shown(sender As Object, e As EventArgs) Handles Me.Shown
ShowOverlay(300)
End Sub
Private Async Sub ShowOverlay(Delay As Integer)
Await Task.Delay(Delay)
Overlay.Visible = True
Me.Focus()
End Sub
And this is the complete OverlayForm:
All Borders/Control Boxes to None (It's a borderless Form)
.StartPosition = Manual
.TransparncyKey = WhiteSmoke <= Depends on the font color (mod. when needed)
.BackColor = WhiteSmoke <= Depends on the font color (mod. when needed)
.ShowInTaskbar = False
Public Class OverlayForm
Private _Text As String
Private TextPosition As Point
Private _Brush As SolidBrush = New SolidBrush(Color.White)
Private _Flags As StringFormatFlags = StringFormatFlags.NoWrap
Public Enum Alignment
Left = 0
Right = 1
Center = 2
End Enum
Public Sub New()
InitializeComponent()
End Sub
Public Overrides Property Text() As String
Get
Return Me._Text
End Get
Set(ByVal value As String)
_Text = value
Me.Invalidate()
End Set
End Property
Public Property OverlayPosition As Alignment
Private Sub OverlayForm_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
e.Graphics.TextRenderingHint = Drawing.Text.TextRenderingHint.SingleBitPerPixelGridFit
e.Graphics.TextContrast = 12
Dim _Size As SizeF = e.Graphics.MeasureString(Me._Text, Me.Font,
New SizeF(Me.Width, Me.Height),
New StringFormat(Me._Flags))
e.Graphics.DrawString(Me._Text, Me.Font, Me._Brush, New RectangleF(TextAlign(_Size.Width), _Size))
End Sub
Private Sub OverlayForm_ForeColorChanged(sender As Object, e As EventArgs) Handles Me.ForeColorChanged
Me._Brush = New SolidBrush(Me.ForeColor)
Me.Invalidate()
End Sub
Public Sub Reposition(ParentPosition As Point, ParentSize As Size)
Select OverlayPosition
Case Alignment.Left
Me.Location = New Point(ParentPosition.X + 20, ParentPosition.Y + 40)
Case Alignment.Right
Me.Location = New Point(ParentSize.Width - Me.Width - 20, ParentPosition.Y + 40)
Case Alignment.Center
Me.Location = New Point(ParentPosition.X + 20 + (ParentSize.Width \ 2) - (Me.Width \ 2), ParentPosition.Y + 40)
End Select
End Sub
Private Function TextAlign(TextWidth As Single) As PointF
Select Case OverlayPosition
Case Alignment.Left
Return New PointF(1, 1)
Case Alignment.Right
Return New PointF((Me.Width - TextWidth) - 1, 1)
Case Alignment.Center
If TextWidth > Me.Width Then TextWidth = Me.Width - 2
Return New PointF(CSng((Me.Width - TextWidth) / 4) - 1, 1)
End Select
End Function
End Class

Picturebox - Get image inside drawn rectangle and show in another Picturebox

I made a search and successfully found a solution to draw a rectangle inside my Picturebox while mousemoving using a class named Rectangulo:
Public Class Form1
Dim SelectionBoxObj As New Rectangulo()
Dim IsMouseDown As Boolean = False
Public SelectedObjPoint As Point
Private Sub PictureBox1_MouseDown(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
If e.Button = Windows.Forms.MouseButtons.Left Then
IsMouseDown = True
SelectedObjPoint = New Point(e.X, e.Y)
End If
End Sub
Private Sub PictureBox1_MouseMove(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
If IsMouseDown = True Then
If e.X < SelectionBoxObj.X Then
SelectionBoxObj.X = e.X
SelectionBoxObj.Width = SelectedObjPoint.X - e.X
Else
SelectionBoxObj.X = SelectedObjPoint.X
SelectionBoxObj.Width = e.X - SelectedObjPoint.X
End If
If e.Y < SelectedObjPoint.Y Then
SelectionBoxObj.Y = e.Y
SelectionBoxObj.Height = SelectedObjPoint.Y - e.Y
Else
SelectionBoxObj.Y = SelectedObjPoint.Y
SelectionBoxObj.Height = e.Y - SelectedObjPoint.Y
End If
Me.Refresh()
End If
End Sub
Private Sub PictureBox1_MouseUp(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseUp
IsMouseDown = False
End Sub
Private Sub PictureBox1_Paint(sender As Object, e As System.Windows.Forms.PaintEventArgs) Handles PictureBox1.Paint
If SelectionBoxObj.Width > 0 And SelectionBoxObj.Height > 0 Then
Dim oGradientBrush As Brush = New Drawing.Drawing2D.LinearGradientBrush(SelectionBoxObj.RectangleF, SelectionBoxObj.FillColor, SelectionBoxObj.FillColor, Drawing.Drawing2D.LinearGradientMode.Vertical)
e.Graphics.FillRectangle(oGradientBrush, SelectionBoxObj.RectangleF)
Dim TempPen = New Pen(SelectionBoxObj.BorderLineColor, SelectionBoxObj.BorderLineWidth)
TempPen.DashStyle = SelectionBoxObj.BorderLineType
e.Graphics.DrawRectangle(TempPen, SelectionBoxObj.RectangleF.X, SelectionBoxObj.RectangleF.Y, SelectionBoxObj.RectangleF.Width, SelectionBoxObj.RectangleF.Height)
End If
End Sub
End Class
And the Rectangle Class code:
Public Class Rectangulo
Private m_BorderLineColor As Color = Drawing.Color.FromArgb(255, 51, 153, 255)
Private m_FillColor As Color = Drawing.Color.FromArgb(40, 51, 153, 255)
Private m_BorderLineType As Drawing2D.DashStyle = Drawing2D.DashStyle.Solid
Private m_BorderLineWidth As Integer = 1
Private m_X As Single
Private m_Y As Single
Private m_Width As Single
Private m_Height As Single
Private m_RectangleF As RectangleF
Public Property BorderLineWidth() As Integer
Get
Return m_BorderLineWidth
End Get
Set(ByVal value As Integer)
m_BorderLineWidth = value
End Set
End Property
Public Property BorderLineType() As Drawing2D.DashStyle
Get
Return m_BorderLineType
End Get
Set(ByVal value As Drawing2D.DashStyle)
m_BorderLineType = value
End Set
End Property
Public Property BorderLineColor() As Color
Get
Return m_BorderLineColor
End Get
Set(ByVal value As Color)
m_BorderLineColor = value
End Set
End Property
Public Property FillColor() As Color
Get
Return m_FillColor
End Get
Set(ByVal value As Color)
m_FillColor = value
End Set
End Property
Public Property X() As Single
Get
Return m_RectangleF.X
End Get
Set(ByVal value As Single)
m_RectangleF.X = value
End Set
End Property
Public Property Y() As Single
Get
Return m_RectangleF.Y
End Get
Set(ByVal value As Single)
m_RectangleF.Y = value
End Set
End Property
Public Property Width() As Single
Get
Return m_RectangleF.Width
End Get
Set(ByVal value As Single)
m_RectangleF.Width = value
End Set
End Property
Public Property Height() As Single
Get
Return m_RectangleF.Height
End Get
Set(ByVal value As Single)
m_RectangleF.Height = value
End Set
End Property
Public Property RectangleF() As RectangleF
Get
Return m_RectangleF
End Get
Set(ByVal value As RectangleF)
m_RectangleF = value
End Set
End Property
End Class
So far I found this article and adjusted with my code in mousemove event like this:
Dim top As Integer = Integer.Parse(SelectionBoxObj.Y)
Dim left As Integer = Integer.Parse(SelectionBoxObj.X)
Dim width As Integer = Integer.Parse(SelectionBoxObj.Width)
Dim height As Integer = Integer.Parse(SelectionBoxObj.Height)
' Make a Bitmap to hold the result.
If width > 0 And height > 0 Then
Dim bm As New Bitmap(width, height)
' Associate a Graphics object with the Bitmap
Using gr As Graphics = Graphics.FromImage(bm)
' Define source and destination rectangles.
Dim src_rect As New Rectangle(left, top, width, _
height)
Dim dst_rect As New Rectangle(0, 0, width, height)
' Copy that part of the image.
gr.DrawImage(PictureBox1.Image, dst_rect, src_rect, _
GraphicsUnit.Pixel)
End Using
' Display the result.
PictureBox2.Image = bm
And It's almost done! But the only problem now is the points are incorrect, the image displayed is always from the middle of selection to right and not his full size of selection
Thanks in advance