图个有趣，VBA也玩PS图片特效

dongdonggege

老师，你的作品被评为精华，可喜可贺。就不要藏着掖着了，能否每一楼都传给程序，让我等学习一下。

aman1516

dongdonggege 发表于 2025-4-7 14:17
老师，你的作品被评为精华，可喜可贺。就不要藏着掖着了，能否每一楼都传给程序，让我等学习一下。

本贴为“讨论”，也没人参与，纯自娱自乐的研究下怎么“玩”罢了，承蒙版主加精，受宠若惊，贻笑大方。
若要用这些功能，放着PS、各种应用的神器不用，用这些胡乱拼凑破铁锤子去重复造轮子，实没必要。
楼层里面有代码模板、有核心算法代码（大部分都是往模板里套就行了）、有参考资料、有其他贴子老师们的例子与完整代码，最主要现时还有DeepSeeK......
好奇害死猫，一个数学问题引出更多的问题来，有兴趣就玩下，没兴趣，全是对作无用的东西

aman1516

继续 VBA学PS  扭曲系列之  弧形效果+卷轴
图像处理大致可以分为以下几类:
●独立像素点运算 —— 包括亮度、对比、饱和度、色调、灰色化等
●多个像素点运算 —— 一般是进行卷积变换，求均值，求中值，插值等，包括边缘检测、浮雕化、模糊、锐化
●几何变化 —— 矩阵变换。包括缩放、旋转、倾斜、扭曲、液化等
●多图像合成 —— 多张图像的处理，包括添加水印，贴纸，美妆等。
所以，弧形、卷轴等，基本还是数学上的事 —— 将直线影射到对应的曲线上
原图：

影射为一段圆弧，弧形：


连续圆弧或波浪曲线：

aman1516

直线影射为一个圆，卷轴：


算法套入模板：

1. Sub ArcImg()    '卷轴效果
   
2.     Dim Img, Img1 'As ImageFile
   
3.     Dim IP 'As ImageProcess
   
4.     Dim v, v1 'As Vector
   
5.     Dim f, f1, w As Long, h As Long, w1 As Long, w2 As Long, h1 As Long, h2 As Long, Z, ps As Integer
   
6.     Dim i As Long, j As Long, k As Long, k1 As Long, ii As Long, jj As Long, R As Long
   
7.     Const pi = 3.1415926
   
8.     ''1弧度=57.3度, 1度=0.0174533弧度
   
9.     'On Error Resume Next
   
10.     Set Img = CreateObject("WIA.ImageFile")
    
11.     Set Img1 = CreateObject("WIA.ImageFile")
    
12.     Set IP = CreateObject("WIA.ImageProcess")
    
13.     f1 = ThisWorkbook.Path & "\dt.bmp"
    
14.     Img1.LoadFile f1
    
15.     w1 = Img1.width
    
16.     h1 = Img1.height
    
17.     Set v1 = Img1.ARGBData
    
18.     w = w1
    
19.     R = w1 / (2 * pi)
    
20.     h = h1 + R * (1 - Cos(w1 / (2 * R)))
    
21.     Set v = CreateObject("WIA.Vector")
    
22.     For Z = 1 To w * h
    
23.         v.Add &HFFFFFFFF
    
24.     Next
    
25.     For i = 1 To h1
    
26.         For j = 1 To w1
    
27.             k1 = (i - 1) * w1 + j
    
28.                     If j < w1 / 2 Then
    
29.                         jj = w1 / 2 - R * Sin((w1 / 2 - j) / R)
    
30.                         ii = R - R * Cos((w1 / 2 - j) / R) + i
    
31.                     Else
    
32.                         jj = w1 / 2 + R * Sin((j - w1 / 2) / R)
    
33.                         ii = R - R * Cos((j - w1 / 2) / R) + i
    
34.                     End If
    
35.             k = (ii - 1) * w1 + jj
    
36.             v(k) = v1(k1)
    
37.        Next
    
38.     Next
    
39.     Set Img = v.ImageFile(w, h)
    
40.     f = ThisWorkbook.Path & "\Arcpy.jpg"
    
41.     If Dir(f) <> "" Then Kill f
    
42.     Img.SaveFile f
    
43.     MsgBox "ok!"
    
44. End Sub

复制代码

aman1516

圆形似乎不符合视觉效果，椭圆好像更适合
PS未完待续......

shenjianrong163

aman1516 发表于 2025-3-8 15:21
能否用VBA实现对两图进行布尔运算
https://club.excelhome.net/thread-1670687-1-1.html

老师，能否分享下用VBA实现对两图进行布尔运算？

aman1516

关于椭圆影射的问题：

求椭圆长半轴OA的弄出来了

1. Function Tycz(zcL As Double, dbz As Double) As Double
   
2.     Dim a As Long, pi, k, t, c, d, cbz
   
3.     k = 1000000    ' <span style="background-color: rgb(255, 255, 255);">精度0.000001</span>
   
4.     pi = 3.1415926
   
5.     t = Int((zcL - 2 * pi * dbz + 4 * dbz) / 4)
   
6.     c = dbz * k
   
7.     For a = (t - 10) * k To (t + 10) * k
   
8.         d = Abs(pi * (3 * (a + dbz * k) - Sqr((3 * a + dbz * k) * (a + 3 * dbz * k))) - zcL * k)
   
9.         If d < c Then
   
10.            c = d
    
11.            cbz = a / k
    
12.         End If
    
13.     Next
    
14.     Tycz = cbz
    
15. End Function
    
16. 
    
17. Sub tt()
    
18. Dim L As Double, b As Double
    
19. Debug.Print Tycz(400, 40)    '  83.468024
    
20. End Sub
    

复制代码

直线影射到椭圆这步，DeepSeek用椭圆E点起顺时针，弧长等于直线长度（0~400）的算法，太复杂搞不懂，那位数学大咖可指点一下

aman1516

shenjianrong163 发表于 2025-4-12 11:22
老师，能否分享下用VBA实现对两图进行布尔运算？

我是破电脑一直用Office 2007没升级没办法才瞎折腾，
用2010以上版本菜单功能里面就有布尔运算处理

shenjianrong163

aman1516 发表于 2025-4-12 11:55
我是破电脑一直用Office 2007没升级没办法才瞎折腾，
用2010以上版本菜单功能里面就有布尔运算处理

老师，我用Office2010也没有布尔运算。

aman1516

初步椭圆形卷轴效果：





椭圆形看上去顺眼多了，不足之处，起始位置是椭圆最右边端点开始，如果是从椭圆最下端处开始，图片就“居中”了，
或起始位置设置成椭圆指定角度上的点，可选项，
还有个顺时针、逆时针方向也是设置成可选择项，就完美了，仍需琢磨，
PS未完待续......