如何在excel中使用VBA计算和分类jpeg中的像素



我希望使用excel来分析图像中的像素数,而不是为它购买软件包。我在RGB光谱上有三个范围,我将使用它们对每个像素进行分类。我希望我的程序读取每个像素,看看它属于什么类别,并将其输出到一个单元格或消息框。我只是不熟悉这背后的语法,因为算法相当简单,只需要一个for循环。

很多年前我也尝试过类似的方法。我现在看着代码,并没有真正理解它,也没有时间把它简化到最基本的部分。不管怎样,它可能会帮助你开始。粘贴以下代码,在该工作表中粘贴一个图像,并将宏Picture1_Click分配给该图像。然后点击图片,你会得到该点的RGB。

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (ByRef lpPoint As POINT) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
    Dim C As Long
    Dim R As Long
    Dim G As Long
    Dim B As Long
    Dim la As Integer

Private Type POINT
    x As Long
    y As Long
End Type
Sub Picture1_Click()
    Dim pLocation As POINT
    Dim lColour, lDC As Long
    la = la + 1
    lDC = GetWindowDC(0)
    Call GetCursorPos(pLocation)
    Rprom = 0
    For i = -5 To 5
    For j = -5 To 5
    lColour = GetPixel(lDC, pLocation.x + i, pLocation.y + j)
    C = lColour
    R = C Mod 256
    G = C  256 Mod 256
    B = C  65536 Mod 256
    Rprom = Rprom + R
    Next j
    Next i
    Rprom = Rprom / 121
    getRGB2 = "R=" & R & ", G=" & G & ", B=" & B
    Range("a" & la + 1).Value = la
    Range("b" & la + 1).Value = R
    Range("c" & la + 1).Value = G
    Range("d" & la + 1).Value = B
    Range("e" & la + 1).Value = Rprom
    Range("f" & la + 1).Value = pLocation.x
    Range("g" & la + 1).Value = pLocation.y
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, pLocation.x, pLocation.y, 10, 10). _
        Select
    'ActiveSheet.Shapes.AddShape(msoShapeRectangle, 20, 20, 10, 10). _
        Select
    Selection.ShapeRange.Fill.Visible = msoTrue
    Selection.ShapeRange.Fill.Solid
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
    Selection.ShapeRange.Fill.Transparency = 0.5
    Selection.ShapeRange.Line.Weight = 0.75
    Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoTrue
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 10
    Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
    Selection.Characters.Text = la
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Normal"
        .Size = 6
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Selection.ShapeRange.TextFrame.MarginLeft = 0#
    Selection.ShapeRange.TextFrame.MarginRight = 0#
    Selection.ShapeRange.TextFrame.MarginTop = 0#
    Selection.ShapeRange.TextFrame.MarginBottom = 0#
End Sub

最新更新