如何使用Excel中的VBA对jpeg中的像素进行计数和分类?

时间:2016-10-04 17:52:41

标签: excel vba excel-vba

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

1 个答案:

答案 0 :(得分:0)

很多年前我尝试过类似的东西。我现在看看代码,并且真的不理解它,并且没有时间将它减少到它们的基本要素。无论如何,它可能会帮助你开始。粘贴以下代码,将图像粘贴到该工作表中,并将宏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