我的读图程序哪里错了呢?
--------------------编程问答-------------------- Picture1.Point(x, y) < 592138 满足该条件,有很大一部分不是黑色,纯绿,纯红色,大黄色的颜色值都比592138小 --------------------编程问答--------------------图片用肉眼看过去都是黑色和白色,这样做基本没问题,另外,输出的结果都是-1
很郁闷啊 --------------------编程问答--------------------
这个是图片 --------------------编程问答-------------------- 我这里似乎没问题,有1632行,部分示例:
97 96 131586
97 98 131586
97 102 263172
98 104 131586
98 106 197379
98 108 65793
99 83 65793
99 110 197379
99 112 65793
。。。。。。 --------------------编程问答-------------------- 说一下自己的理解,也许没有理解楼主的意思:
像你这样比颜色应该是不对的
对颜色的比较应该是将其拆分为RGB颜色,然后分别对比每个分量,最后和设定的阀值比较而得出结果,打一个比方,对某一点,他的颜色是:&H584575,转换为RGB就是:RGB(&H75,&H45,&H58),和你要比较的标准颜色(假设是:RGB(&H76,&H48,&H57)),比较,那么这两个颜色的之差就是
((&H75-&H76)^2+(&H45-&H48)^2+(&H58-&H57)^2)^0.5=11^0.2≈3.32
你再用这个3.32和你事先约定好的阀值(也就是偏差判定)比较,如果在其内,那么就代表两点颜色相似,如果不在,那么就代表两点不相似。 --------------------编程问答--------------------
--------------------编程问答--------------------
Option Explicit
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Sub Command1_Click()
Dim x As Single
Dim y As Single
Dim flag As Boolean
Dim ss As String
Dim ll As Integer
Dim strPointColor As String
Dim R As Byte
Dim G As Byte
Dim B As Byte
Picture1.ScaleMode = 3 '让picture1用像素作为单位
Picture1.AutoRedraw = True
For x = 1 To 511
For y = 1 To 511
strPointColor = Format(Hex(GetPixel(Picture1.hdc, x, y)), "000000")
R = CByte("&H" & Mid(strPointColor, 5, 2))
G = CByte("&H" & Mid(strPointColor, 3, 2))
B = CByte("&H" & Mid(strPointColor, 1, 2))
'假设阀值是592138和0的色差值:(100+81+81)^0.5≈16.19
'计算获取的点的颜色和黑色的色差是否超过了592138和黑色的色差,如果没有超过,那么符合标准
If ((R - 0) ^ 2 + (G - 0) ^ 2 + (B - 0) ^ 2) ^ 0.5 <= 16.19 Then
Open "C:\zuobiao4.csv" For Append As #1
Print #1, x, ",", y, ",", Picture1.Point(x, y)
Close #1
End If
Next y
Next x
End Sub
Private Function ColorDistance(ByVal c1 As Long, ByVal c2 As Long) As Long
Dim cd As Long
Dim h1, s1, b1, h2, s2, b2 As Single
On Error Resume Next
If c1 = -1 Or c2 = -1 Then
ColorDistance = 1000000
Exit Function
End If
c2hsb (c1)
h1 = hsbH / 360
s1 = hsbS
b1 = hsbB
c2hsb (c2)
h2 = hsbH / 360
s2 = hsbS
b2 = hsbB
cd = Abs(h1 - h2)
cd = cd + Abs(s1 - s2)
cd = cd + Abs(b1 - b2)
ColorDistance = cd
End Function
Private Function Minimum(ParamArray Vals())
Dim n As Integer, MinVal
On Error Resume Next
MinVal = Vals(0)
For n = 1 To UBound(Vals)
If Vals(n) < MinVal Then MinVal = Vals(n)
Next n
Minimum = MinVal
End Function
Private Function Maximum(ParamArray Vals())
Dim n As Integer, MaxVal
On Error Resume Next
MaxVal = Vals(0)
For n = 1 To UBound(Vals)
If Vals(n) > MaxVal Then MaxVal = Vals(n)
Next n
Maximum = MaxVal
End Function
Private Sub c2hsb(ByVal clr As Long)
Dim MyR As Single, MyG As Single, MyB As Single
Dim Max As Single, Min As Single
Dim MyS As Single
Dim Delta As Single, MyVal As Single
Dim cc As String * 6
Dim r1, g1, b1 As Byte
On Error Resume Next
cc = Right("000000" + Hex$(clr), 6)
b1 = Val("&H" + Left(cc, 2))
g1 = Val("&H" + Mid(cc, 3, 2))
r1 = Val("&H" + Right(cc, 2))
MyR = r1 / 255: MyG = g1 / 255: MyB = b1 / 255
Max = Maximum(MyR, MyG, MyB)
Min = Minimum(MyR, MyG, MyB)
hsbB = Int(Max * 100)
If Max <> 0 Then
MyS = (Max - Min) / Max * 100
Else
MyS = 0
End If
hsbS = MyS
If hsbS = 0 Then
hsbH = 0
Else
Delta = Max - Min
Select Case Max
Case MyR
MyVal = (MyG - MyB) / Delta
Case MyG
MyVal = 2 + (MyB - MyR) / Delta
Case MyB
MyVal = 4 + (MyR - MyG) / Delta
End Select
MyVal = MyVal * 60
If MyVal < 0 Then MyVal = MyVal + 360
hsbH = MyVal
End If
' Debug.Print "hsb="; hsbH; " "; hsbS; " "; hsbB
End Sub
补充:VB , 基础类