VB 实现photoshop魔棒工具 代码

Question

VB 实现photoshop魔棒工具，建立选区并读出选区的像素数？

Answer 1

种子填充算法。下面代码仅供参考。Const STACK_SIZE = 1000000
Dim stackX(0 To STACK_SIZE) As Integer
Dim stackY(0 To STACK_SIZE) As Integer
Dim stackI As LongPrivate Function seedfill(ByVal sx As Integer, ByVal sy As Integer, ByVal cc As Long, ByVal fc As Long, ByVal mc As Long, ByVal bc As Long) As Boolean
Dim min_cd2 As Long
Dim cd As Long
Dim cd1 As Long
On Error Resume Next
    min_cd2 = ColorDistance(fc, bc) '前景与背景色差
    stackI = 0
    x1 = 32767: x2 = -1: y1 = 32767: y2 = -1
    push sx, sy
    Do
        pop
        If XX = -1 And YY = -1 Then Exit Do
        c = Pic.Point(XX, YY)
        cd = ColorDistance(c, fc)
        If c <> cc And cd < min_cd2 * seeddis Then
            Pic.PSet (XX, YY), cc
            If XX < x1 Then x1 = XX
            If XX > x2 Then x2 = XX
            If YY < y1 Then y1 = YY
            If YY > y2 Then y2 = YY
            If YY - 1 >= 0 And sy - MAX_XYD <= YY - 1 And YY - 1 < sy + MAX_XYD Then
                push XX, YY - 1
                If stackI = 0 Then
                    Pic.Cls
                    seedfill = False
                    Exit Function
                End If
            End If
            If YY + 1 < BVIH And sy - MAX_XYD <= YY + 1 And YY + 1 < sy + MAX_XYD Then
                push XX, YY + 1
                If stackI = 0 Then
                    Pic.Cls
                    seedfill = False
                    Exit Function
                End If
            End If
            If XX - 1 >= 0 And sx - MAX_XYD <= XX - 1 And XX - 1 < sx + MAX_XYD Then
                push XX - 1, YY
                If stackI = 0 Then
                    Pic.Cls
                    seedfill = False
                    Exit Function
                End If
            End If
            If XX + 1 < BVIW And sx - MAX_XYD <= XX + 1 And XX + 1 < sx + MAX_XYD Then
                push XX + 1, YY
                If stackI = 0 Then
                    Pic.Cls
                    seedfill = False
                    Exit Function
                End If
            End If
        End If
    Loop
'   Pic.Line (x1, y1)-(x2, y2), &HFFFF&, B
    If x2 = -1 Or y2 = -1 Then
        seedfill = False
    Else
        seedfill = True
    End If
End Function
Private Sub push(ByVal px As Integer, ByVal py As Integer)
On Error Resume Next
    stackX(stackI) = px
    stackY(stackI) = py
    If stackI < STACK_SIZE Then
        stackI = stackI + 1
    Else
        MsgBox "堆栈溢出!"
        stackI = 0
    End If
End Sub
Private Sub pop()
On Error Resume Next
    If stackI <= 0 Then
        XX = -1
        YY = -1
        Exit Sub
    End If
    stackI = stackI - 1
    XX = stackX(stackI)
    YY = stackY(stackI)
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 FunctionPrivate 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

Answer 2

有些东西是没有现成可以拿到的，不过下面这个可以参考一下。
http://www.pscode.com/vb/scripts/ShowZip.asp?lngWId=1&lngCodeId=71241&strZipAccessCode=tp%2FF712417101

Answer 3

论坛有位做vb版的Photoshop的好像发过代码