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