module3.bas

一个用C语言编写的求混沌序列的源程序,挺好的!

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()），望高手指教: [e-mail]
                
        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()），望高手指教: [e-mail]
    '其实可以向屏幕绘制一个指定颜色，然后返回实际绘制的颜色值来判断颜色编码方式。
    '这里留给读者解决
    HGetPixelFormat = 565
    
End Function

'=======================================================