www.pudn.com > 牛顿法解方程之混沌情况1.32源代码.zip > Module3.bas
Attribute VB_Name = "Module3"
Option Explicit
'======================================================================
'图像数据RGB调整的基本函数 和 一些变量定义
'======================================================================
Public PicDataOld() As Byte '实现RGB调整时用来保存原图像的数据
Public PicDataNew() As Byte '实现RGB调整时用来保存调整后的图像的数据
Public PicLeng As Long '实现RGB调整时用来保存图像数据的长度（字节）
Public PicBit As Long '实现RGB调整时用来保存图像的颜色位数
Public RGBTime As Double
'++++++++++++更改图像RGB数据++++++++++++++
Public Sub EditRGB(RGBData0() As Byte, RGBData1() As Byte, dLeng As Long, PicBit As Long, dR As Long, dG As Long, dB As Long, RGBTimeNow As Double)
'更改图像RGB数据（不考虑256色和16色）
Dim i As Long
Dim temp As Long
Dim tempR As Long
Dim tempG As Long
Dim tempB As Long
Dim tempColor As Long
'如果把图片的颜色位数一早定为24位，则程序将变得很好处理，而且还有很多其他好处...
Select Case PicBit
Case 32 '32位色深
For i = 0 To dLeng - 1
Select Case (i Mod 4)
Case 0
temp = RGBData0(i) + dB
Case 1
temp = RGBData0(i) + dG
Case 2
temp = RGBData0(i) + dR
Case 3
temp = RGBData0(i) '透明度，一般给0就可以了
End Select
If temp > 255 Then
temp = 255
ElseIf temp < 0 Then
temp = 0
End If
RGBData1(i) = temp
If i Mod 50 = 0 Then
DoEvents
If RGBTimeNow <> RGBTime Then
Exit Sub
End If
End If
Next i
Case 24 '24位色深
For i = 0 To dLeng - 1
Select Case (i Mod 3)
Case 0
temp = RGBData0(i) + dB
Case 1
temp = RGBData0(i) + dG
Case 2
temp = RGBData0(i) + dR
End Select
If temp > 255 Then
temp = 255
ElseIf temp < 0 Then
temp = 0
End If
RGBData1(i) = temp
If i Mod 50 = 0 Then
DoEvents
If RGBTimeNow <> RGBTime Then
Exit Sub
End If
End If
Next i
Case 16 '16位色深在某些机子上可能有问题,因为16位色编码方式是由硬件厂商决定的:
'大部分机子采用的编码方式：R:9-13,G:14-16,1-3,B:4-8 (5,6,5)
'某些机子上可能为 R:10-14,G:15-16,1-3,B:4-8,空（或作为是否透明标志）:9 (5,5,5,1)
'还有的机子为：R:9-14,G:15-16,1-3,B:4-8 (6,5,5)
'由于没有查到相关资料（API函数：GetPixelFormat()和SetPixelFormat()），望高手指教: HouSisong@263.net
tempColor = HGetPixelFormat(frmMain.Picture1) '自己编的替代函数，16位色时返回具体编码方式。
If tempColor = 565 Then '默认方式 R:9-13,G:14-16,1-3,B:4-8
For i = 0 To dLeng \ 2 - 1
tempB = RGBData0(2 * i) Mod 32
tempG = RGBData0(2 * i) \ 32 + (RGBData0(2 * i + 1) Mod 8) * 8
tempR = RGBData0(2 * i + 1) \ 8
tempB = tempB + dB * 5 \ 8
tempG = tempG + dG * 5 \ 8
tempR = tempR + dR * 5 \ 8
If tempB > 31 Then
tempB = 31
ElseIf tempB < 0 Then
tempB = 0
End If
If tempG > 63 Then
tempG = 63
ElseIf tempG < 0 Then
tempG = 0
End If
If tempR > 31 Then
tempR = 31
ElseIf tempR < 0 Then
tempR = 0
End If
RGBData1(2 * i) = tempB + 32 * (tempG Mod 8)
RGBData1(2 * i + 1) = tempG \ 8 + tempR * 8
If i Mod 50 = 0 Then
DoEvents
If RGBTimeNow <> RGBTime Then
Exit Sub
End If
End If
Next i
ElseIf tempColor = 5551 Then ' R:10-14,G:15-16,1-3,B:4-8,空:9
For i = 0 To dLeng \ 2 - 1
temp = RGBData0(2 * i + 1) \ 128
tempB = RGBData0(2 * i) Mod 32
tempG = RGBData0(2 * i) \ 32 + (RGBData0(2 * i + 1) Mod 4) * 8
tempR = (RGBData0(2 * i + 1) Mod 128) \ 4
tempB = tempB + dB * 5 \ 8
tempG = tempG + dG * 5 \ 8
tempR = tempR + dR * 5 \ 8
If tempB > 31 Then
tempB = 31
ElseIf tempB < 0 Then
tempB = 0
End If
If tempG > 31 Then
tempG = 31
ElseIf tempG < 0 Then
tempG = 0
End If
If tempR > 31 Then
tempR = 31
ElseIf tempR < 0 Then
tempR = 0
End If
RGBData1(2 * i) = tempB + 32 * (tempG Mod 8)
RGBData1(2 * i + 1) = tempG \ 8 + tempR * 4 + temp * 128
If i Mod 50 = 0 Then
DoEvents
If RGBTimeNow <> RGBTime Then
Exit Sub
End If
End If
Next i
ElseIf tempColor = 655 Then 'R:6,G:5,B:5
'没有处理代码
'我在几台电脑上只测到了上面两种情况，这里留给读者解决
End If
End Select
End Sub
'16位色时返回图片具体编码方式
Public Function HGetPixelFormat(Pic As PictureBox) As Long
'由于没有查到相关资料（GetPixelFormat()和SetPixelFormat()），望高手指教: HouSisong@263.net
'其实可以向屏幕绘制一个指定颜色，然后返回实际绘制的颜色值来判断颜色编码方式。
'这里留给读者解决
HGetPixelFormat = 565
End Function
'=======================================================