调整图片色相、饱和度、亮度

小fisher · 发表于 2022-2-3 22:58

本帖最后由小fisher 于 2022-2-4 19:25 编辑

hsl(v1.1).rar (55.17 KB, 下载次数: 45)
2022-2-3更新：
1. 增加了两个HSL缓冲数组，从RGB转成HSL的工作只需在加载图片时进行一次；
2. H、S、L三个分量分别调节，在生成图片前一次性转成RGB，减少不必要运算。
原来3000*2000像素图片调节一次HSL耗时约30-40秒，现在只需2-3秒，当然距离PS实时预览的用户体验还差十万八千里。
3. 修复了代码运行期间Excel失去响应或崩溃的问题。
4. 修改算法，优化调整后图片的颜色顺滑度。

aman1516 · 发表于 2022-2-4 10:45

小fisher 发表于 2022-2-3 22:58
2022-2-3更新：
1. 增加了两个HSL缓冲数组，从RGB转成HSL的工作只需在加载图片时进行一次；
2. H、S、L ...

支持原创，感谢分享！

aman1516 · 发表于 2022-3-14 08:32

小fisher 发表于 2022-2-3 22:58
2022-2-3更新：
1. 增加了两个HSL缓冲数组，从RGB转成HSL的工作只需在加载图片时进行一次；
2. H、S、L ...

老师你好，图片处理后，代码中已建立了 “Picture对象”，
除了装载到Image显示效果外，如何将对象导出为图片呢（即将处理后的Image图片导出，到工作表或本地文件夹）
你的另一个例子：简单图片处理
https://club.excelhome.net/thread-400986-2-1.html
也是同样，能否加个导出调整后的图片的代码

blackttea1 · 发表于 2022-3-14 10:24

谢谢分享。保存备用

小fisher · 发表于 2022-3-14 10:44

aman1516 发表于 2022-3-14 08:32
老师你好，图片处理后，代码中已建立了 “Picture对象”，
除了装载到Image显示效果外，如何将对象导出 ...

在窗体上加个按钮CommandButton2，加入以下代码：
Private Sub CommandButton2_Click()
If Not Image2.Picture Is Nothing Then
SavePicture Image2.Picture, "d:\test.bmp"
End If
End Sub
注意这个代码只能保存为bmp格式图片，即使文件名后缀取为.jpg，保存完的图片本质上仍是bmp格式，保存成其他格式文件可以参考https://club.excelhome.net/thread-1565669-1-1.html

aman1516 · 发表于 2022-3-14 12:36

小fisher 发表于 2022-3-14 10:44
在窗体上加个按钮CommandButton2，加入以下代码：
Private Sub CommandButton2_Click()
If Not Ima ...

找到一个VB的调整色温的计算公式，我改成了函数，
但不知如何应用到类似老师的案例中去（两个案例哪个都成）
请老师帮忙完善：

Public Function PicTemperature(tmpKelvin As Long) ''色温 1000k - 40000K
Dim tmpCalc As Double
Dim R As Integer, G As Integer, B As Integer
'Temperature must fall between 1000 and 40000 degrees
If tmpKelvin < 1000 Then tmpKelvin = 1000
If tmpKelvin > 40000 Then tmpKelvin = 40000
'All calculations require tmpKelvin \ 100, so only do the conversion once
tmpKelvin = tmpKelvin \ 100
'Calculate each color in turn
'First: red
If tmpKelvin <= 66 Then
R = 255
Else
'Note: the R-squared value for this approximation is .988
tmpCalc = tmpKelvin - 60
tmpCalc = 329.698727446 * (tmpCalc ^ -0.1332047592)
R = tmpCalc
If R < 0 Then R = 0
If R > 255 Then R = 255
End If
'Second: green
If tmpKelvin <= 66 Then
'Note: the R-squared value for this approximation is .996
tmpCalc = tmpKelvin
tmpCalc = 99.4708025861 * Log(tmpCalc) - 161.1195681661
G = tmpCalc
If G < 0 Then G = 0
If G > 255 Then G = 255
Else
'Note: the R-squared value for this approximation is .987
tmpCalc = tmpKelvin - 60
tmpCalc = 288.1221695283 * (tmpCalc ^ -0.0755148492)
G = tmpCalc
If G < 0 Then G = 0
If G > 255 Then G = 255
End If
'Third: blue
If tmpKelvin >= 66 Then
B = 255
ElseIf tmpKelvin <= 19 Then
B = 0
Else
'Note: the R-squared value for this approximation is .998
tmpCalc = tmpKelvin - 10
tmpCalc = 138.5177312231 * Log(tmpCalc) - 305.0447927307
B = tmpCalc
If B < 0 Then B = 0
If B > 255 Then B = 255
End If
MsgBox R & "-" & G & "-" & B
MsgBox RGB(R, G, B)
End Function
Sub kkkk()
Call PicTemperature(1500) '1500,6500,15000; 1000,6500,40000 ''白光 6500K
''调色温一个简单方式，对 RGB 的 B 进行处理：
'' bits(2, ix, iy) = bits(2, ix, iy) * 1.2
'' bits(2, ix, iy) = bits(2, ix, iy) * 0.8
End Sub

复制代码

aman1516 · 发表于 2022-3-14 12:41

VBA如何处理图片的色温

aman1516 · 发表于 2022-3-14 23:27

小fisher 发表于 2022-3-14 10:44
在窗体上加个按钮CommandButton2，加入以下代码：
Private Sub CommandButton2_Click()
If Not Ima ...

再追加个问题：如何将 “Picture对象” 复制到剪切板上

小fisher · 发表于 2022-3-14 23:41

本帖最后由小fisher 于 2022-3-16 21:19 编辑

aman1516 发表于 2022-3-14 12:41
VBA如何处理图片的色温

学习了半晚上Tanner Helland大神的PhotoDemon源代码（https://github.com/tannerhelland/PhotoDemon，顺便说一句，真是个各种图像处理算法的宝库，而且源码是VB6写的，强烈推荐！）
代码没来得及注释，先简单概括一下原理：1）根据指定的色温计算出一个对应的颜色值rgbTemp；
2）遍历每个像素，取得该像素的初始亮度值L（即R、G、B三色最大、最小值的平均数）；
3）用每个像素的颜色值与rgbTemp分别混合【本质上是三原色分别加权平均，原像素颜色和rgbTemp的权重分别为(1-strength/100)和strength/100】，算出来一个新的颜色值rgbNew；
4）计算rgbNew对应的色相、饱和度、亮度，用rgbNew 的色相、饱和度和初始亮度L换算出最终的rgb值赋给对应的像素点
这样即可显示出色温效果，同时保持每个像素点的原始亮度。
连抄带拼凑，效果还算可以，源码奉上：

调整照片色温.rar (67.48 KB, 下载次数: 16)

=====
3月16日更新

调整照片色温1.rar (76.48 KB, 下载次数: 17)
修正几处不合理代码：
1. 将类似Dim h, s, l as Single修改为Dim h as Single, s as Single, l as Single，纯属低级错误
2. 原来代码中两层循环中嵌套复杂运算，修改为在循环之前进行尽量少次数的复杂运算，在两次循环内查表，将复杂浮点运算的次数由x（图片宽度） * y（图片高度）次减少为256 *3=768次。
修改前代码：
For x = 1 To lWidth
      For y = 1 To lHeight
         l = getLightness(arrRGB(x, y).rgbRed, arrRGB(x, y).rgbGreen, arrRGB(x, y).rgbBlue)
         r = arrRGB(x, y).rgbRed * (1 - strength / 100) + rgbTemp.Red * strength / 100
         g = arrRGB(x, y).rgbGreen * (1 - strength / 100) + rgbTemp.Green * strength / 100
         b = arrRGB(x, y).rgbBlue * (1 - strength / 100) + rgbTemp.Blue * strength / 100

   ……
修改后代码：
Dim arrR(0 To 255) As Integer
Dim arrG(0 To 255) As Integer
Dim arrB(0 To 255) As Integer

rgbTemp = RGBfromTemperature(temperature)

For i = 0 To 255
      arrR(i) = i * (1 - strength / 100) + rgbTemp.rgbRed * strength / 100
      arrG(i) = i * (1 - strength / 100) + rgbTemp.rgbGreen * strength / 100
      arrB(i) = i * (1 - strength / 100) + rgbTemp.rgbBlue * strength / 100
Next

For x = 1 To lWidth
      For y = 1 To lHeight
         l = getLightness(arrRGB(x, y).rgbRed, arrRGB(x, y).rgbGreen, arrRGB(x, y).rgbBlue)
         r = arrR(arrRGB(x, y).rgbRed)
         g = arrG(arrRGB(x, y).rgbGreen)
         b = arrB(arrRGB(x, y).rgbBlue)

……
3. 借鉴https://club.excelhome.net/forum.php?mod=viewthread&tid=1615549帖子中的技巧，将clsImage的创建方式修改为更简洁和舒服的：
Set oImage = clsImage.CreateFromPicture( [Picture对象] )
或Set oImage = clsImage.CreateFromFile( [图片文件路径] )

aman1516 · 发表于 2022-3-15 08:17

太给力了，但测试时发现了个特例，请老师用下图确认下：

tu.rar (86.03 KB, 下载次数: 9)

调整后图片出现了横向的“栅格”，不知原因

		自动登录	找回密码
密码			免费注册

[原创] 调整图片色相、饱和度、亮度

评分

评分