PictureBox 不应自行触发事件
PictureBox shouldn't fire events on its own
我正在编写一个 WinForms 应用程序 (.NET 4.8)，您可以使用它把图片加载到 PictureBox 中，移动它，缩放它，最后在它上面绘图。
计划是先把图搬走，再画在上面。因此，图片只有在勾选了相关的radio button后才会赋值给PictureBox。不幸的是，图像的分配一次又一次地引发 paint event。触发一次就会死循环。我怎样才能防止这种情况发生？我已经尝试从 PictureBox 继承并设置不同的设置。
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
这是有问题的程序。↑
如果您需要更多信息，我会将源代码放在这里。
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
我现在已经解决了这个问题。你们都是对的——在绘画事件处理程序中将图片分配给 Picturebox 是不明智的，特别是因为我还想在缩放的矩形上绘制。我以为我必须先解决问题，但后来发现实际上是这个问题。
我现在已经做到了。我可以在缩放和移动的矩形上绘图。
我创建了第二个表单，显示鼠标和矩形的当前值。在不久的将来，我将测试在缩放和移动的图像上绘制 GraphicsPath 时计算坐标在原始图像上的位置。
我将整个代码放到网上，因为我重建了很多。欢迎您提出改进建议。
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
我正在编写一个 WinForms 应用程序 (.NET 4.8)，您可以使用它把图片加载到 PictureBox 中，移动它，缩放它，最后在它上面绘图。
计划是先把图搬走，再画在上面。因此，图片只有在勾选了相关的radio button后才会赋值给PictureBox。不幸的是，图像的分配一次又一次地引发 paint event。触发一次就会死循环。我怎样才能防止这种情况发生？我已经尝试从 PictureBox 继承并设置不同的设置。
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
这是有问题的程序。↑
如果您需要更多信息，我会将源代码放在这里。
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
我现在已经解决了这个问题。你们都是对的——在绘画事件处理程序中将图片分配给 Picturebox 是不明智的，特别是因为我还想在缩放的矩形上绘制。我以为我必须先解决问题，但后来发现实际上是这个问题。
我现在已经做到了。我可以在缩放和移动的矩形上绘图。
我创建了第二个表单，显示鼠标和矩形的当前值。在不久的将来，我将测试在缩放和移动的图像上绘制 GraphicsPath 时计算坐标在原始图像上的位置。
我将整个代码放到网上，因为我重建了很多。欢迎您提出改进建议。
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