玩酷之家

 找回密码
 立即注册
查看: 109|回复: 0

vb 实现RGB、HSL互转及图片调整HSL

[复制链接]
发表于 2021-2-10 21:38:37 | 显示全部楼层 |阅读模式
该实例实现RGB转HSL及HSL转RGB,以及使用HSL对图片进行调色。

  1. 'Option Explicit
  2. 这个功能已经实现,需要大家复制代码,验证一下改编的HSL是否正确,如何改进。
  3. '控件:picture 1  装载源图片
  4. '            picture2   空,无图片
  5. '            picture3   显示色相0-360度
  6. '            HScroll1   min =0   max=360'色相
  7. '            HScroll2   min =0   max=100'饱和度
  8. '          HScroll3   min =0   max=100'亮度

  9. Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BitMapInfo, ByVal wUsage As Long) As Long
  10. Private Declare Function SetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BitMapInfo, ByVal wUsage As Long) As Long
  11. Private Type BitMapInfoHeader ''文件信息头——BITMAPINFOHEADER
  12. biSize As Long
  13. biWidth As Long
  14. biHeight As Long
  15. biPlanes As Integer
  16. biBitCount As Integer
  17. biCompression As Long
  18. biSizeImage As Long
  19. biXPelsPerMeter As Long
  20. biYPelsPerMeter As Long
  21. biClrUsed As Long
  22. biClrImportant As Long
  23. End Type

  24. Private Type RGBQuad
  25. rgbBlue As Byte
  26. rgbGreen As Byte
  27. rgbRed As Byte
  28. ''rgbReserved As Byte
  29. End Type

  30. Private Type BitMapInfo
  31. bmiHeader As BitMapInfoHeader
  32. bmiColors As RGBQuad
  33. End Type



  34. Private Sub Form_Load()
  35. Dim W As Long
  36. Dim H As Long
  37. Dim a As Long
  38. Dim i As Long
  39. Dim c As Long
  40. W = Picture3.Width  '宽度
  41. H = Picture3.Height '高度
  42. a = W / 6 '图像分六部分

  43. For i = 0 To a
  44.   c = i * 255 / a
  45.    Picture3.Line (i + a * 0, 0)-(i + a * 0, H), RGB(255, c, 0)
  46.   Picture3.Line (i + a * 1, 0)-(i + a * 1, H), RGB(255 - c, 255, 0)



  47.   Picture3.Line (i + a * 2, 0)-(i + a * 2, H), RGB(0, 255, c)
  48.    Picture3.Line (i + a * 3, 0)-(i + a * 3, H), RGB(0, 255 - c, 255)
  49.    Picture3.Line (i + a * 4, 0)-(i + a * 4, H), RGB(c, 0, 255)
  50.    Picture3.Line (i + a * 5, 0)-(i + a * 5, H), RGB(255, 0, 255 - c)
  51. Next i

  52. For i = 0 To 6
  53. If i <> 6 Then
  54. Picture3.CurrentX = i * a - TextWidth(i * 60) / 2

  55.   Else
  56.   Picture3.CurrentX = W - TextWidth("36000")
  57.   End If
  58.    Picture3.CurrentY = H / 2 - TextHeight(i)
  59.   
  60.   Picture3.Print i * 60
  61.   Next
  62. End Sub

  63. Public Sub RGBtoHSL(ByVal R As Byte, ByVal G As Byte, ByVal B As Byte, H As Single, S As Single, L As Single)
  64.                     
  65.   Dim Max As Single
  66.   Dim Min As Single
  67.   Dim delta As Single
  68.   Dim rR As Single, rG As Single, rB As Single

  69.     '-- Given:   RGB each in [0,1]
  70.     '-- Desired: H in [0,240] and S in [0,1], except if S = 0, then H = UNDEFINED
  71.     rR = R / 255: rG = G / 255: rB = B / 255
  72.    
  73.     Max = pvMaximum(rR, rG, rB)
  74.     Min = pvMinimum(rR, rG, rB)
  75.     L = (Max + Min) / 2
  76.    
  77.     '== Calculate saturation:
  78.    
  79.     '-- Achromatic case
  80.     If (Max = Min) Then
  81.         S = 0
  82.         H = 0
  83.       
  84.     '-- Chromatic case
  85.       Else
  86.         '-- First calculate the saturation
  87.         If (L <= 0.5) Then
  88.             S = (Max - Min) / (Max + Min)
  89.           Else
  90.             S = (Max - Min) / (2 - Max - Min)
  91.         End If
  92.         '-- Next calculate the hue
  93.         delta = Max - Min
  94.         If (rR = Max) Then
  95.             H = (rG - rB) / delta     ' Resulting color is between yellow and magenta
  96.           ElseIf (rG = Max) Then
  97.             H = 2 + (rB - rR) / delta ' Resulting color is between cyan and yellow
  98.           ElseIf (rB = Max) Then
  99.             H = 4 + (rR - rG) / delta ' Resulting color is between magenta and cyan
  100.         End If
  101.     End If
  102. End Sub

  103. Public Sub HSLtoRGB(ByVal H As Single, ByVal S As Single, ByVal L As Single, R As Byte, G As Byte, B As Byte)
  104.     On Error Resume Next
  105.   Dim rR As Single, rG As Single, rB As Single
  106.   Dim Min As Single, Max As Single

  107.     '-- Achromatic case:
  108.     If (S = 0) Then
  109.         rR = L: rG = L: rB = L
  110.         
  111.     '-- Chromatic case:
  112.       Else
  113.         If (L <= 0.5) Then
  114.             '-- S = (Max - Min) / (Max + Min)
  115.             Min = L * (1 - S)
  116.           Else
  117.             '-- S = (Max - Min) / (2 - Max - Min)
  118.             Min = L - S * (1 - L)
  119.         End If
  120.         Max = 2 * L - Min
  121.       
  122.         '-- Now depending on sector we can evaluate the H,L,S:
  123.         If (H < 1) Then
  124.             rR = Max
  125.             If (H < 0) Then
  126.                 rG = Min
  127.                 rB = rG - H * (Max - Min)
  128.               Else
  129.                 rB = Min
  130.                 rG = H * (Max - Min) + rB
  131.             End If
  132.           ElseIf (H < 3) Then
  133.             rG = Max
  134.             If (H < 2) Then
  135.                 rB = Min
  136.                 rR = rB - (H - 2) * (Max - Min)
  137.               Else
  138.                 rR = Min
  139.                 rB = (H - 2) * (Max - Min) + rR
  140.             End If
  141.           Else
  142.             rB = Max
  143.             If (H < 4) Then
  144.                 rR = Min
  145.                 rG = rR - (H - 4) * (Max - Min)
  146.               Else
  147.                 rG = Min
  148.                 rR = (H - 4) * (Max - Min) + rG
  149.             End If
  150.         End If
  151.    End If
  152.    R = rR * 255: G = rG * 255: B = rB * 255
  153.    If R > 255 Then R = 255
  154.     If G > 255 Then G = 255
  155.      If B > 255 Then B = 255
  156. End Sub

  157. Private Function pvMaximum(rR As Single, rG As Single, rB As Single) As Single
  158.     If (rR > rG) Then
  159.         If (rR > rB) Then pvMaximum = rR Else pvMaximum = rB
  160.       Else
  161.         If (rB > rG) Then pvMaximum = rB Else pvMaximum = rG
  162.     End If
  163. End Function

  164. Private Function pvMinimum(rR As Single, rG As Single, rB As Single) As Single
  165.     If (rR < rG) Then
  166.         If (rR < rB) Then pvMinimum = rR Else pvMinimum = rB
  167.       Else
  168.         If (rB < rG) Then pvMinimum = rB Else pvMinimum = rG
  169.     End If
  170. End Function

  171. Sub AdjustHSL()

  172.   Dim X As Long
  173.         Dim Y As Long
  174.         Dim Color As Long
  175.         Dim R As Byte, G As Byte, B As Byte
  176.         Dim H As Single, S As Single, L As Single
  177.         Dim pH As Single, DesH As Single, DesS As Single, DesL As Single
  178.         pH = HScroll1.Value / 30
  179.         DesS = HScroll2.Value
  180.         DesL = HScroll3.Value
  181.         
  182. Dim ix As Integer
  183. Dim iy As Integer
  184. Dim iWidth As Integer '以像素为单位的图形宽度
  185. Dim iHeight As Integer '以像素为单位的图形高度

  186. Dim bits() As Byte '三维数组,用于获取原彩色图像中各像素的RGB数值以及存放转化后的灰度值
  187. Dim bitsBW() As Byte '三维数组,用于存放转化为黑白图后各像素的值
  188. '获取图形的宽度和高度
  189. iWidth = Picture1.ScaleWidth / Screen.TwipsPerPixelX
  190. iHeight = Picture1.ScaleHeight / Screen.TwipsPerPixelY
  191. Picture1.Picture = Picture1.Image
  192. '创建并初始化一个bitMapInfo自定义类型
  193. Dim bi24BitInfo As BitMapInfo
  194. With bi24BitInfo.bmiHeader
  195. .biBitCount = 32
  196. .biCompression = 0&
  197. .biPlanes = 1
  198. .biSize = Len(bi24BitInfo.bmiHeader)
  199. .biWidth = iWidth
  200. .biHeight = Picture1.ScaleHeight / Screen.TwipsPerPixelY
  201. End With
  202. '重新定义数组大小
  203. ReDim bits(3, 0 To iWidth, 0 To iHeight) As Byte
  204. ReDim bitsBW(3, 0 To iWidth, 0 To iHeight) As Byte
  205. '使用GetDIBits方法一次性获取picture1中各点的rgb值,比point方法或getPixel函数逐像素获取像素rgb要快出一个数量级
  206. lrtn = GetDIBits(Picture1.hdc, Picture1.Picture.Handle, 0&, iHeight, bits(0, 0, 0), bi24BitInfo, 0&)
  207. '数组的三个维度分别代表像素的RGB分量、以图形左下角为原点的X和Y坐标。
  208. '具体说来,这时bits(0,2,3)代表从图形左下角数起横向第2个纵向第3个像素的Blue值,而bits(1,2,3)和bits(2,2,3)分别的Green值和Red值.

  209. For ix = 0 To iWidth
  210. For iy = 0 To iHeight

  211. R = bits(0, ix, iy)
  212.                         G = bits(1, ix, iy)
  213.                         B = bits(0, ix, iy)
  214.                         RGBtoHSL R, G, B, H, S, L
  215.                         DesH = H + pH
  216.                         If DesH < -1 Then DesH = DesH + 6 Else If DesH > 5 Then DesH = DesH - 6
  217.                         S = S + DesS / 100
  218.                         If S > 1 Then S = 1 Else If S < 0 Then S = 0
  219.                         L = L + DesL / 100
  220.                         If L > 1 Then L = 1 Else If L < 0 Then L = 0
  221.                         
  222.                         
  223.                         HSLtoRGB DesH, S, L, R, G, B
  224.    bitsBW(0, ix, iy) = B
  225. bitsBW(1, ix, iy) = G
  226. bitsBW(2, ix, iy) = R
  227. Next
  228. Next

  229. SetDIBits Picture2.hdc, Picture2.Picture.Handle, 0&, iHeight, bitsBW(0, 0, 0), bi24BitInfo, 0&
  230. Picture2.Picture = Picture2.Image
  231. Picture2.Refresh

  232. End Sub



  233. Private Sub HScroll1_Scroll()
  234. Call AdjustHSL
  235. End Sub


  236. Private Sub HScroll2_Scroll()
  237. Call AdjustHSL
  238. End Sub



  239. Private Sub HScroll3_Scroll()
  240. Call AdjustHSL
  241. End Sub
复制代码


回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|Archiver|手机版|小黑屋|玩酷之家 ( 鄂ICP备14012049号 )

GMT+8, 2021-4-22 11:25 , Processed in 1.092002 second(s), 17 queries .

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表