能否对指定范围内的颜色设置透明

lss001

aman1516 发表于 2024-8-8 22:47
继续依葫芦画瓢：

Sub 指定透明颜色范围()
    Dim img As Object, v As Object, argbs As Object
    Dim a%, r%, g%, b%, i&, j&, k&, w&, h&
   
    f = "d:\1.jpg"
    Set img = CreateObject("Wia.ImageFile")
    Set v = CreateObject("Wia.Vector")
    img.loadfile f
    w = img.Width
    h = img.Height
    Set argbs = img.ARGBData
    For i = 1 To h
        For j = 1 To w
            k = k + 1
            argb = Hex(argbs(k))
            'a = CInt("&H" & Mid(argb, 1, 2))
            r = CInt("&H" & Mid(argb, 3, 2))
            g = CInt("&H" & Mid(argb, 5, 2))
            b = CInt("&H" & Mid(argb, 7, 2))
               
            If r > 200 And r < 255 Then
                If g > 200 And g < 255 Then
                    If b > 200 And b < 255 Then
                         r = 255: g = 255: b = 255
                    End If
                End If
            End If
            
            '注意：rgb填写顺序从右往左←
            v.Add RGB(b, g, r)
        Next
    Next
    Set img = v.ImageFile(w, h)
    img.SaveFile "d:\m1.jpg"
End Sub

aman1516

lss001 发表于 2024-8-12 18:04
Sub 指定透明颜色范围()
    Dim img As Object, v As Object, argbs As Object
    Dim a%, r%, g%, ...

VBA中用像素RGB作算法，要多一步转换，代码可能会多些，但是个人觉得易于理解，易于设置公式
油画特效那个，区域内取随机点颜色的效果并不是很好，觉得还是取区域内灰度级别最多的像素的平均值好些，但计算数量与速度上会慢很多
原图：


区域内随机颜色算法（更像毛玻璃效果）：

灰度分级最多像素的平均值算法：

aman1516

知其然知其所以然后，就一通百通了，复杂的特效，就是更加复杂的算法
谢谢各位老师的指导！
再来一个简单的  “霓虹效果 ”：

lss001

aman1516 发表于 2024-8-13 18:44
VBA中用像素RGB作算法，要多一步转换，代码可能会多些，但是个人觉得易于理解，易于设置公式
油画特效那 ...

要效果平均值算法效果比较好
随机数算法一般都是临时使用