我使用以下代码（在VB.Net 2105中）来选取图片框上光标点处像素的颜色，该图片框上已绘制了一个矩形，边界为白色，并用红色填充。
Private Sub PictureBox1_mosevnt(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseMove
Dim bmp_dumy As Bitmap = New Bitmap(1, 1)
'For x_pix As Integer = 0 To Me.Width - 1
' For y_pix As Integer = 0 To Me.Height - 1
' Next
'Next
Using gr_new = Graphics.FromImage(bmp_dumy)
gr_new.CopyFromScreen(Me.Cursor.Position, New Point(0, 0), New Size(1, 1))
End Using
Dim pixel As Drawing.Color = bmp_dumy.GetPixel(0, 0)
If pixel.A.ToString = 255 And pixel.R.ToString = 255 And pixel.G.ToString = 255 And pixel.B.ToString = 255 Then
MsgBox("White color pixel is detected" & pixel.ToString(), MessageBoxButtons.OK)
PictureBox1.BackColor = pixel
Label1.Text$ = bmp_dumy.GetPixel(0, 0).ToString
Dim p As New Point
p.X = (Me.Width / 2) - (Label1.Width / 2)
p.Y = Label1.Top
Label1.Location = p
Me.Invalidate()
End if
End sub
问题：
然而，当我想放置两个
for--nextMe.Cursor.Positionnew point(x_pix,y_pixPrivate Sub PictureBox1_mosevnt(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseClick
Dim bmp_dumy As Bitmap = New Bitmap(1, 1)
For x_pix As Integer = 0 To Me.Width - 1
For y_pix As Integer = 0 To Me.Height - 1
Using gr_new = Graphics.FromImage(bmp_dumy)
gr_new.CopyFromScreen(new point(x_pix,y_pix), New Point(0, 0), New Size(1, 1))
End Using
Dim pixel As Drawing.Color = bmp_dumy.GetPixel(0, 0)
If pixel.A.ToString = 255 And pixel.R.ToString = 255 And pixel.G.ToString = 255 And pixel.B.ToString = 255 Then
MsgBox("White color pixel is detected" & pixel.ToString(), MessageBoxButtons.OK)
PictureBox1.BackColor = pixel
Label1.Text$ = bmp_dumy.GetPixel(0, 0).ToString
Dim p As New Point
p.X = (Me.Width / 2) - (Label1.Width / 2)
p.Y = Label1.Top
Label1.Location = p
Me.Invalidate()
Next
Next
End if
End sub
我希望我正确理解了你的目标。我已经为您编写了一个程序，您可以在其中选择图像并在 PictureBox 上绘制一个矩形。此外，还会保存原始图像的副本，其中矩形位于相应位置。该矩形内的颜色存储在颜色列表 (
allColors重点是，您需要考虑图像尺寸和几何形状。例如，图像可能是 2700×1800 像素。如果以原始尺寸显示它，它会超出 1920×1080 显示器的屏幕边缘。所以我的 PictureBox 显示缩小的图像（仍然保持纵横比，因此没有边变形）。当鼠标指针悬停在 PictureBox 中的某个像素上时，必须使用比例计算（三法则）来确定原始图像上的真实坐标。
我构建了一个新的 PictureBox 并稍微修改了它，这样它就不会触发太多事件。构建项目，保存，然后您需要使用工具栏将其放置在 GUI 上。
Imports System.Windows.Forms
Public Class PictureBoxEx : Inherits PictureBox
Public Sub New()
SetStyle(ControlStyles.Selectable Or ControlStyles.UserMouse, True)
End Sub
End Class
顺便说一句，我把我的一个旧项目剥离了（变成一个新项目）；它原本有更多的功能。我希望你对此没意见。
Option Strict On
Imports System
Imports System.Drawing
Imports System.Windows.Forms
Imports System.Collections.Generic
Public NotInheritable Class FormMain
Private loadedImage As Bitmap
Private mouseStartPointForRectangle As Point
Private mouseUpMustFollow As Boolean
Private mouseEndPointForRectangle As Point
Private allowedToDrawUsersRectangle As Boolean
Private drawnRectangle As Rectangle
Private imageRect As RectangleF = RectangleF.Empty
Private currentZoomFactor As Double = 1.0
Private imageIsMoved As Boolean = False
Private saveImage As Boolean = False
Private Sub ButtonLoadImage_Click(sender As Object, e As EventArgs) Handles ButtonLoadImage.Click
Using openFileDialog As New OpenFileDialog()
openFileDialog.Filter = "images|*.bmp;*.jpeg;*.jpg;*.png"
openFileDialog.Multiselect = False
If openFileDialog.ShowDialog() = DialogResult.OK Then
If PictureBoxEx1.Image IsNot Nothing Then
PictureBoxEx1.Image.Dispose()
PictureBoxEx1.Image = Nothing
loadedImage = Nothing
End If
loadedImage = New Bitmap(openFileDialog.FileName)
Dim size As Size = GetImageSize(openFileDialog.FileName)
ResizePictureBox(size)
PictureBoxEx1.Image = loadedImage
currentZoomFactor = 1.0
imageRect = RectangleF.Empty
imageRect.Location = New PointF(PictureBoxEx1.Location.X, PictureBoxEx1.Location.Y)
End If
End Using
End Sub
Private Shared Function GetImageSize(path As String) As Size
Using bmp As New Bitmap(path)
Return bmp.Size
End Using
End Function
Private Sub ResizePictureBox(imageSize As Size)
Dim currentWidth As Integer = imageSize.Width
Dim currentHeight As Integer = imageSize.Height
Dim maxPossibleWidth As Integer = 925
Dim maxPossibleHeight As Integer = 925
If currentWidth > maxPossibleWidth OrElse currentHeight > maxPossibleHeight Then
PictureBoxEx1.SizeMode = PictureBoxSizeMode.StretchImage
PictureBoxEx1.Size = If(
currentWidth * maxPossibleHeight / currentHeight > maxPossibleWidth,
New Size(maxPossibleWidth, CInt(currentHeight * maxPossibleWidth / currentWidth)),
New Size(CInt(currentWidth * maxPossibleHeight / currentHeight), maxPossibleHeight)
)
Else
PictureBoxEx1.SizeMode = PictureBoxSizeMode.Normal
PictureBoxEx1.Size = imageSize
End If
End Sub
Private Sub PictureBoxEx1_MouseDown(sender As Object, e As MouseEventArgs) Handles PictureBoxEx1.MouseDown
If loadedImage Is Nothing Then
Return
End If
Select Case e.Button
Case MouseButtons.Left
mouseStartPointForRectangle = e.Location
mouseUpMustFollow = True
allowedToDrawUsersRectangle = True
PictureBoxEx1.Invalidate()
Exit Select
Case MouseButtons.Right
drawnRectangle = PointsToRectangle(New Point(0, 0), New Point(0, 0))
PictureBoxEx1.Invalidate()
Exit Select
End Select
End Sub
Private Sub PictureBoxEx1_MouseMove(sender As Object, e As MouseEventArgs) Handles PictureBoxEx1.MouseMove
If loadedImage Is Nothing Then
Return
End If
If e.Button = MouseButtons.Left AndAlso mouseUpMustFollow Then
mouseEndPointForRectangle = e.Location
allowedToDrawUsersRectangle = True
drawnRectangle = PointsToRectangle(mouseStartPointForRectangle, mouseEndPointForRectangle)
PictureBoxEx1.Invalidate()
End If
End Sub
Private Sub PictureBoxEx1_MouseUp(sender As Object, e As MouseEventArgs) Handles PictureBoxEx1.MouseUp
If loadedImage Is Nothing Then
Return
End If
If e.Button = MouseButtons.Left AndAlso mouseUpMustFollow Then
mouseEndPointForRectangle = e.Location
allowedToDrawUsersRectangle = True
drawnRectangle = PointsToRectangle(mouseStartPointForRectangle, mouseEndPointForRectangle)
saveImage = True
PictureBoxEx1.Invalidate()
mouseUpMustFollow = False
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 allowedToDrawUsersRectangle Then
Dim rectanglePictureBox As RectangleF = CalculateZoomedAndOrMovedRect()
DrawRectangleOnScreen(e.Graphics, rectanglePictureBox)
If saveImage Then
Dim drawnRectangleOnOriginalImage As Rectangle = BuildBigRectangle(rectanglePictureBox)
DrawRectangleOnOriginalImage(e.Graphics,
drawnRectangleOnOriginalImage)
saveImage = False
End If
End If
End Sub
Private Sub DrawRectangleOnScreen(g As Graphics, rectanglePictureBox As RectangleF)
If g Is Nothing Then
Return
End If
g.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
g.CompositingQuality = Drawing2D.CompositingQuality.HighQuality
g.PixelOffsetMode = Drawing2D.PixelOffsetMode.HighQuality
g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBilinear
Using penBlue As New Pen(Color.FromArgb(0, 200, 255), 1.0F)
g.DrawImage(loadedImage, rectanglePictureBox)
g.DrawRectangle(penBlue, drawnRectangle)
End Using
End Sub
Private Function BuildBigRectangle(rectanglePictureBox As RectangleF) As Rectangle
Dim x1 As Double = (drawnRectangle.X - rectanglePictureBox.X) / rectanglePictureBox.Width * loadedImage.Width
Dim y1 As Double = (drawnRectangle.Y - rectanglePictureBox.Y) / rectanglePictureBox.Height * loadedImage.Height
Dim x2 As Double = ((drawnRectangle.X + drawnRectangle.Width) - rectanglePictureBox.X) / rectanglePictureBox.Width * loadedImage.Width
Dim y2 As Double = ((drawnRectangle.Y + drawnRectangle.Height) - rectanglePictureBox.Y) / rectanglePictureBox.Height * loadedImage.Height
Dim rect As New Rectangle(CInt(Math.Round(x1, 0)),
CInt(Math.Round(y1, 0)),
CInt(Math.Round(x2 - x1, 0)),
CInt(Math.Round(y2 - y1, 0)))
Dim allColors As New List(Of Color)
For x As Integer = CInt(Math.Round(x1, 0)) To CInt(Math.Round(x2, 0)) Step 1
For y As Integer = CInt(Math.Round(y1, 0)) To CInt(Math.Round(y2, 0)) Step 1
allColors.Add(loadedImage.GetPixel(x, y))
Next
Next
Return rect
End Function
Private Function CalculateZoomedAndOrMovedRect() As RectangleF
imageRect.Width = PictureBoxEx1.Width
imageRect.Height = PictureBoxEx1.Height
Dim newLocation As PointF
If imageIsMoved Then
newLocation = imageRect.Location
Else
newLocation = New PointF(
(PictureBoxEx1.Size.Width / 2.0F) - imageRect.Width * CSng(currentZoomFactor) / 2.0F,
(PictureBoxEx1.Size.Height / 2.0F) - imageRect.Height * CSng(currentZoomFactor) / 2.0F)
End If
Diagnostics.Debug.WriteLine("x = " & Math.Round(newLocation.X, 1).ToString() & "; y = " & Math.Round(newLocation.Y, 1).ToString())
Return New RectangleF(
newLocation,
New SizeF(imageRect.Width * CSng(currentZoomFactor), imageRect.Height * CSng(currentZoomFactor)))
End Function
Private Shared Function PointsToRectangle(p1 As Point, p2 As Point) As Rectangle
Return New Rectangle With {
.Width = Math.Abs(p1.X - p2.X),
.Height = Math.Abs(p1.Y - p2.Y),
.X = Math.Min(p1.X, p2.X),
.Y = Math.Min(p1.Y, p2.Y)
}
End Function
Private Sub DrawRectangleOnOriginalImage(g As Drawing.Graphics, r As Drawing.Rectangle)
If g Is Nothing Then
Return
End If
If r.Width > 0 Then
Using penOrange As New Pen(Color.FromArgb(255, 170, 0), 2.0F)
Using bmp As New Bitmap(loadedImage)
Using gr As Graphics = Graphics.FromImage(bmp)
gr.DrawRectangle(penOrange, r)
bmp.Save(Environment.GetFolderPath(Environment.SpecialFolder.Desktop) & $"\{Date.Now.ToString("G", New Globalization.CultureInfo("de-DE")).Replace(":"c, "."c)}.png", Imaging.ImageFormat.Png)
End Using
End Using
End Using
End If
End Sub
End Class