学步园

计算机发展到今天，已经完全进入了图形化的时代，哪个程序不用图片呢？在程序中，图像不只是用来美化我们的界面，我们还能用程序来处理图像并且实现一些很特别的效果。当然，这需要一些计算机图形学的基本知识，为了看到有趣的效果，您就要先学习一些理论知识。

1 BMP位图文件的存储格式

要想处理图像文件就必须知道这些图像文件的构成方式。在常用的图像格式中，以24位真彩色的BMP位图格式比较常用，而且构成比较简单，所以我们就以它作为讲解的对象。

首先我们找一幅 24 位真彩色的位图用 16 进制编辑器将其打开，查看方式切换到以 HEX 方式查看的话，你们就可以看到类似下面这样的数据了。这其实就是 BMP 文件中的图像数据。这些数据就代表着我们平常看到的图像。

24 位真彩色的 BMP 图文件是由三个部分组成的：位图文件头、位图信息头、位图阵列三个部分组成的。

1.1 位图文件头

位图文件头就是用来标志这个位图文件一些信息比如：大小、类型等等。共有 14 个字节的信息。下面我们就分别对这 14 个字节的信息分别说明一下它们所代表的意义。

42 4D 为位图的标志。如果转换成 ASCII 码的话就是 BM。
96 61 02 00 这个双字信息代表着位图文件的总字切数，如果把它转换面十进制的话就是（ 00026196 ） H= （ 156054 ） D ，也就是这位图文件的大小是 156054 个字节。
00 00 00 00 为保留字。
36 00 00 00 表示位图阵列的起始位置，（ 00000036 ） H= （ 54 ） D ，也就是从第 54 个字节起就是这幅图的位图阵列了。

1.2 位图信息头

位图信息头记录着一些关于这幅图的一些基本信息，比如：高度、宽度、分辨率等信息。共占 40 个字节。

28 00 00 00 表示着位图信息头的长度，（ 00000028 ） H= （ 40 ） D ，即位图信息头的长度占 40 个字节。
04 01 00 00 表示位图的宽度，（ 00000104 ） H= （ 260 ） D 表示位图的宽度为 260 个像素。
C8 00 00 00 表示位图的高度，（ 000000C8 ） H= （ 200 ） D 表示位图的高度为 200 个像素。
01 00 表示位图设备级别。
18 00 位图的色彩级别，（ 0018 ） H= （ 24 ） D ，即表示 24 位真彩色。
00 00 00 00 表示压缩类型，零表示不压缩。
00 00 00 00 位图阵列表字节数。
00 00 00 00 表示水平分辨率。
00 00 00 00 表示垂直分辨率。
00 00 00 00 表示位图实际使用的颜色表中的颜色变址。
00 00 00 00 表示位图显示过程中被认为重要颜色变址数。

1.3 位图阵列

这部分就是这幅图像的主体部分了。其实每幅图像都是由一个一个的点组成的。在位图阵列里就存放着每一个点的颜色信息。每个像素点是由 3 个字节的数据组成的。也就是我们常用到的 RGB 色彩空间每种颜色占一个字节。每个点的颜色都是由蓝色、绿色、红色这个顺序存储的。点的存储顺序是从左到右从下到上，也就是说第一个点是这幅图的第一列的最后一个点（左下角的那个点），之后是它上面的那个点，就这样由下至上直到第一列的第一个点（左上角的那个点），然后是第二列也是从下至上的顺序。直到写完所有的点。

2. RGB 和 YCrCb 的转换

“颜色空间”的问题我们在后面讲解的一个效果中要用到所以我们在这里简单的讲解一下。

2.1 RGB

对一种颜色进行编码的方法统称为“颜色空间”或“色域”。用最简单的话说，世界上任何一种颜色的“颜色空间”都可定义成一个固定的数字或变量。 RGB （红、绿、蓝）只是众多颜色空间的一种。采用这种编码方法，每种颜色都可用三个变量来表示：红色、绿色以及蓝色的强度。记录及显示彩色图像时， RGB 是最常见的一种方案。

2.2 YUV（变称 YCrCb）

YUV （亦称 YCrCb ）是被欧洲电视系统所采用的一种颜色编码方法（属于 PAL）。 YUV 主要用于优化彩色视频信号的传输。其中“ Y ”表示明亮度（ Luminance 或 Luma ），也就是灰阶值；而“ U ”和“ V ”表示的则是色度（ Chrominance 或 Chroma ），作用是描述影像色彩及饱和度，用于指定像素的颜色。“亮度”是通过 RGB 输入信号来创建的，方法是将 RGB 信号的特定部分叠加到一起。“色度”则定义了颜色的两个方面—色调与饱和度，分别用 Cr 和 CB 来表示。其中， Cr 反映了 RGB 输入信号红色部分与 RGB 信号亮度值之间的差异。而 CB 反映的是 RGB 输入信号蓝色部分与 RGB 信号亮度值之同的差异。

2.3 RGB 与 YcrCb 之间的转换

在上面我们已经给大家简单的描述了一下 RGB 和 YcrCb ，下面我们就要讲解一下它们的转换过程。

YcrCb 转换到 RGB，注意到 0.299 + 0.587 + 0.114=1.0 三原色的系数之所以不同是因为人的眼睛对不同波长的颜色有着不同的敏感度：

Y = 0.299*R + 0.587*G + 0.114*B
Cb =-0.1687*R - 0.3313*G + 0.5*B
Cr =0.5*R - 0.4187*G - 0.0813*B

RGB 转换回 YcrCb ：

R = Y+1.402*Cr
G = Y-0.34414*Cb-0.71414*Cr
B = Y+1.772*Cb

3 效果

前面讲了这么多的理论知识你是不是都认真看了呢？现在我们就要书归正传了，开始讲一讲我们前面的说到的“效果”。我们一共要讲解 6 种效果，在讲解效果之前先要把这些效果所共用到的基本程序先给大家。比如：图像的读入与写入函数，一些关于图像文件的类型定义什么的东西。所谓 6 种效果其实是 6 个自定义的过程，你想用哪个就把哪个加入到基本程序中就可以了！

先新建一个标准 EXE 文件。

在这个文件中新建一个“模块”，在其中写入如下代码：

Option Explicit


Public Type BmpFileHeard
    '位图文件头
    BmpType As String * 2         '位图标志
    BmpFileSize As Long           '位图文件的总字节数
    BmpReserved As Long           '保留字节
    BmpOffBits As Long            '位图阵列的起始位置
End Type


Public Type BmpPictureHeard
    '位图信息头
    BmpFileHeardLong As Long      '信息头的长度
    BmpWidth As Long              '宽(像素)
    BmpHeight As Long             '高(像素)
    BmpPlanes As Integer          '位图设备级别
    BmpBitCount As Integer        '颜色数
    BmpCompression As Long        '压缩类型(0表示不压缩)
    BmpSizeImage As Long          '位图阵列表字节数
    BmpXPlesPerMeter As Long      '水平分辨率
    BmpYPlesPerMeter As Long      '垂直分辨率
    BmpClrUsed As Long            '位图实际使用的颜色表中的颜色变址数
    BmpClrImportant As Long       '位图显示过程中被认为重要颜色变址数
End Type


Public Type BmpRGB
    '图像阵列颜色点
    Blue As Byte                  '蓝
    Green As Byte                 '绿
    Red As Byte                   '红
    '图像阵列是由下至上，由左至右
End Type


Public Type BmpFile
    '位图文件总信息
    Bmp_BmpFileHeard As BmpFileHeard
    Bmp_BmpPictureHeard As BmpPictureHeard
    Bmp_Bmp() As BmpRGB
End Type


Public Sub GetBmpFile(Bmp_BmpFileName As String, Bmp_BmpFile As BmpFile)
    '读取BMP文件
    Dim Bmp_RD As Integer
    
    Bmp_RD = FreeFile
    Open Bmp_BmpFileName For Binary As #Bmp_RD
    
    Get #Bmp_RD, 1, Bmp_BmpFile.Bmp_BmpFileHeard      '读取位图文件头
    Get #Bmp_RD, 15, Bmp_BmpFile.Bmp_BmpPictureHeard  '读取信息头
    
    '根据图像的高度与宽度初始化图像阵列的下标
    ReDim Bmp_BmpFile.Bmp_Bmp(1 To Bmp_BmpFile.Bmp_BmpPictureHeard.BmpWidth, _
        1 To Bmp_BmpFile.Bmp_BmpPictureHeard.BmpHeight)
    '读取图像阵列
    Get #Bmp_RD, Bmp_BmpFile.Bmp_BmpFileHeard.BmpOffBits + 1, _
        Bmp_BmpFile.Bmp_Bmp
    'Bmp_BmpFile.Bmp_BmpFileHeard.BmpOffBits + 1是因为
    'Bmp_BmpFile.Bmp_BmpFileHeard.BmpOffBits记录的数据是
    '以0为开始而本程序是以1为开始的所以要加1
    
    Close #Bmp_RD
End Sub


Public Sub PutBmpFile(Bmp_BmpFileName As String, Bmp_BmpFile As BmpFile)
    '写BMP文件
    Dim Bmp_WR As Integer
    
    Bmp_WR = FreeFile
    Open Bmp_BmpFileName For Binary As #Bmp_WR
    
    Put #Bmp_WR, 1, Bmp_BmpFile.Bmp_BmpFileHeard      '写位图文件头
    Put #Bmp_WR, 15, Bmp_BmpFile.Bmp_BmpPictureHeard  '写信息头
    Put #Bmp_WR, Bmp_BmpFile.Bmp_BmpFileHeard.BmpOffBits + 1, _
        Bmp_BmpFile.Bmp_Bmp   '写图像阵列
    'Bmp_BmpFile.Bmp_BmpFileHeard.BmpOffBits + 1是因为
    'Bmp_BmpFile.Bmp_BmpFileHeard.BmpOffBits记录的数据
    '是以0为开始而本程序是以1为开始的所以要加1
    
    Close #Bmp_WR
End Sub
                        

在这些代码中 GetBmpFile 是用来读取 BMP 文件的， PutBmpFile 用用来写入 BMP 文件的。其它的大家看程序中的注释就应该已经理解了。

大家看到这里是不是已经有些心急了，现在就来说说这些“效果”！

3.1 魔术效果

没错是魔术，这种效果生成的图像文件在网页中确实可以产生魔术般的效果。因为是魔术，所以我先把代码告诉大家，再简单的描述一下它的效果！

先把下面的代码加入模块中：

Public Sub MoShu(Bmp_SBmpFileName As BmpFile, Bmp_DBmpFileName As BmpFile)
    '图像魔术
    Dim i As Integer, j As Integer
    Dim R As Integer, G As Integer, B As Integer
    Dim Y As Long, Cr As Long, Cb As Long
    Bmp_DBmpFileName = Bmp_SBmpFileName
    For i = 1 To Bmp_DBmpFileName.Bmp_BmpPictureHeard.BmpWidth
        For j = 1 To Bmp_DBmpFileName.Bmp_BmpPictureHeard.BmpHeight
            If (i + (Bmp_DBmpFileName.Bmp_BmpPictureHeard.BmpHeight - j + _
                1)) Mod 2 = 0 Then
                '因为行的读取是由下至上的，所以在数组中的第一行其实是最后一行
                'Bmp_DBmpFileName.Bmp_BmpPictureHeard.BmpHeight - j + 1是
                '求出这一行所对应的真实的行号
                
                R = Bmp_DBmpFileName.Bmp_Bmp(i, j).Red
                G = Bmp_DBmpFileName.Bmp_Bmp(i, j).Green
                B = Bmp_DBmpFileName.Bmp_Bmp(i, j).Blue
                
                Y = 0.299 * R + 0.587 * G + 0.114 * B
                Cb = -0.1687 * R - 0.3313 * G + 0.5 * B
                Cr = 0.5 * R - 0.4187 * G - 0.0813 * B
                
                Cb = -Cb
                Cr = -Cr
                
                R = Y + 1.402 * Cr
                G = Y - 0.34414 * Cb - 0.71414 * Cr
                B = Y + 1.772 * Cb
                
                If R > 255 Then R = 255
                If G > 255 Then G = 255
                If B > 255 Then B = 255
                
                If R < 0 Then R = 0
                If G < 0 Then G = 0
                If B < 0 Then B = 0
                
                Bmp_DBmpFileName.Bmp_Bmp(i, j).Red = R
                Bmp_DBmpFileName.Bmp_Bmp(i, j).Green = G
                Bmp_DBmpFileName.Bmp_Bmp(i, j).Blue = B
                
            End If
        Next j
    Next i
End Sub

在窗体中加入一个按钮（ MoShuCommamd ）。代码如下：

Private Sub MoShuCommand_Click()
    Dim BD As BmpFile, BS As BmpFile
    GetBmpFile App.Path & "/原.bmp", BS
    MoShu BS, BD
    PutBmpFile App.Path & "/魔术效果.bmp", BD
End Sub
                        

代码就这么多了，现在描述一下魔术的效果，先选一幅 BMP 图像（色彩鲜艳一点风景图片最佳，而且最好小一点，一般宽和高都不超过 400 ，做为原图），也就是程序中的“原.bmp ”用这段程序生成“魔术效果.bmp”之后用 IE 打开生成后的图像，看看是不是变得有点像灰度图了。下面我们就要开始变这个魔术了。按一下 Ctrl+A 也就是全选，是不是颜色又回来了。在这里我们可是没有用到任何脚本语言，只是运用了图像本身给大家产生了一些颜色方面的错觉。

现在讲一讲基本的原理。就是在 IE 全选的时候其实是用一种蓝色将图像的单数行的单数列和偶数行的偶数列覆盖，以产生了种被选中的效果，所以我们把它没有覆盖的像素点在原图像中的颜色保留下来，我们在全选这幅图之后就和没处理过的图像一样了，至于被覆盖的像素点我们将其变成补色但亮度还要保持不变（在变化的过程中我们就用到了上面讲到的 YcrCb 颜色空间）。这样就会给人的眼睛产生一种错觉。

至于为什么要让图像小一点，是因为如果图像太大 IE 就会对图像缩小，这样像素点的位置就会产生变化，全选之后的效果也就没有了。

3.2 隐藏效果

所谓隐藏就是把一些文字信息隐藏进一幅图像中，也就是大家在电影中见过的“隐形墨水”的效果。

电脑现在慢慢地变成了人们体现自己个性的工具，每个人的电脑中多少隐藏着一些秘密文档，如果你把这些文档加上一个秘号的话，就像告诉别人这是秘密。但是如果你把它放在在幅图像中，就算把这幅图片做成背景，我想你的秘密也不会被别人发现的。

说一说隐藏的原理：其实一般人的眼睛对颜色都不是很敏感，也就是说 RGB 中的（ 255 ， 0 ， 0 ）和（ 254 ， 0 ， 0 ）一般人的眼睛是分不出来的。所以我们把 RGB 这三个字节的每个字节的最后 1 位都拿出来存储我们要隐藏的数据，在图像上产生微小的变化，一般人是觉查不到的。所以就是说在一幅片是我们可以存储（长 * 宽） *3/8 个字符的数据。

如果你感觉这个数字太小的话，我们还是可以加大存储数据的能力的。你还记不记得这个公式 Y = 0.299*R + 0.587*G + 0.114*B 这是一个换算每种颜色亮度的公式。注意到 0.299 + 0.587 + 0.114=1.0 三原色的系数之所以不同是因为人的眼睛对不同波长的颜色有着不同的敏感度。根据这个公式所描述的人们对绿色最敏感，其次是红色，最次是蓝色。我们可以用 R 的最后 2 位， G 的最后 1 位， B 的最后 3 位来存储数据，

这样我们就可以存储（长 * 宽） * （ 2+1+3 ） /8 个数据了，这样我们可以存储的数据就是刚才的一倍了。最后把数据文件的大小保存在 BMP 文件的文件头中就可以了。

在模块中加入如下代码：

Public Sub GetFile(File_FileName As String, File_File() As Byte)
    '读取文件
    Dim File_RD As Integer

    File_RD = FreeFile
    Open File_FileName For Binary As #File_RD

    ReDim File_File(1 To LOF(File_RD))
    Get #File_RD, 1, File_File

    Close #File_RD
End Sub

Public Sub PutFile(File_FileName As String, File_File() As Byte)
    '写入文件
    Dim File_WR As Integer

    File_WR = FreeFile
    Open File_FileName For Binary As #File_WR

    Put #File_WR, 1, File_File

    Close #File_WR
End Sub

Public Sub YYMS(Bmp_SBmpFileName As BmpFile, Bmp_DBmpFileName As BmpFile, _
    File_File() As Byte)
    '隐型
    Dim i As Long, j As Long, z As Integer, a As Integer, k As Long
    Dim RMask As Byte, GMask As Byte, BMask As Byte
    Dim File_Bin() As Byte
    ReDim File_Bin(1 To UBound(File_File) * 8) As Byte
    
    RMask = 2: GMask = 1: BMask = 3
    
    Bmp_DBmpFileName = Bmp_SBmpFileName
      
    For i = 1 To UBound(File_File)
        For j = 1 To 8
            a = 2 ^ (8 - j)
            
            If (File_File(i) And a) <> 0 Then
                File_Bin((i - 1) * 8 + j) = 1
            Else
                File_Bin((i - 1) * 8 + j) = 0
            End If
        Next j
    Next i
    
    k = 1
    For i = 1 To Bmp_DBmpFileName.Bmp_BmpPictureHeard.BmpWidth
        For j = 1 To Bmp_DBmpFileName.Bmp_BmpPictureHeard.BmpHeight
            YXMS_Mask Bmp_DBmpFileName.Bmp_Bmp(i, j).Red, RMask, File_Bin, k
            YXMS_Mask Bmp_DBmpFileName.Bmp_Bmp(i, j).Green, GMask, File_Bin, k
            YXMS_Mask Bmp_DBmpFileName.Bmp_Bmp(i, j).Blue, BMask, File_Bin, k
        Next j
    Next i
    'Debug.Print
    Bmp_DBmpFileName.Bmp_BmpFileHeard.BmpReserved = UBound(File_File)
End Sub

Private Sub YXMS_Mask(Bmp_Color As Byte, Mask As Byte, File_Bin() _
    As Byte, k As Long)
    '隐型的数据部分
    Dim z As Integer, a As Byte
    For z = 1 To Mask
        If k <= UBound(File_Bin) Then
            a = 2 ^ (Mask - z)
            If File_Bin(k) = 1 Then
                Bmp_Color = (Bmp_Color Or a)
            Else
                Bmp_Color = (Bmp_Color And (a Xor &HFF))
            End If
            k = k + 1
        End If
    Next z
End Sub

Public Sub XXMS(Bmp_SBmpFileName As BmpFile, File_File() As Byte)
    '显型
    Dim i As Long, j As Long, z As Integer, a As Integer, k As Long
    Dim RMask As Byte, GMask As Byte, BMask As Byte
    Dim File_Bin() As Byte
    
    ReDim File_File(1 To Bmp_SBmpFileName.Bmp_BmpFileHeard.BmpReserved) _
        As Byte
    ReDim File_Bin(1 To UBound(File_File) * 8) As Byte
    
    RMask = 2: GMask = 1: BMask = 3
    
    k = 1
    For i = 1 To Bmp_SBmpFileName.Bmp_BmpPictureHeard.BmpWidth
        For j = 1 To Bmp_SBmpFileName.Bmp_BmpPictureHeard.BmpHeight
            XXMS_Mask Bmp_SBmpFileName.Bmp_Bmp(i, j).Red, RMask, File_Bin, k
            XXMS_Mask Bmp_SBmpFileName.Bmp_Bmp(i, j).Green, GMask, File_Bin, k
            XXMS_Mask Bmp_SBmpFileName.Bmp_Bmp(i, j).Blue, BMask, File_Bin, k
        Next j
    Next i
    
    For i = 1 To UBound(File_File)
        For j = 1 To 8
            a = 2 ^ (8 - j)
            
            If File_Bin((i - 1) * 8 + j) = 1 Then
                File_File(i) = (File_File(i) Or a)
            Else
                File_File(i) = (File_File(i) And (a Xor &HFF))
            End If
        Next j
    Next i
End Sub

Private Sub XXMS_Mask(Bmp_Color As Byte, Mask As Byte, File_Bin() _
    As Byte, k As Long)
    '显型的数据部分
    Dim z As Integer, a As Byte
    For z = 1 To Mask
        If k <= UBound(File_Bin) Then
            a = 2 ^ (Mask - z)
            If (Bmp_Color And a) = 0 Then
                File_Bin(k) = 0
            Else
                File_Bin(k) = 1
            End If
            k = k + 1
        End If
    Next z
End Sub
                        

在窗体加入两个按钮隐形（ YXCommand ），显形 （XXCommand） 两个按钮代码如下：

Private Sub XXCommand_Click()
    Dim BS As BmpFile
    Dim Fx1() As Byte
  
    GetBmpFile App.Path & "/隐形效果.bmp", BS
  
    XXMS BS, Fx1
    PutFile App.Path & "/文字解.txt", Fx1
End Sub

Private Sub YXCommand_Click()
    Dim BD As BmpFile, BS As BmpFile
    Dim Fx1() As Byte
  
    GetBmpFile App.Path & "/原.bmp", BS
    GetFile App.Path & "/文字.txt", Fx1
    YYMS BS, BD, Fx1
    PutBmpFile App.Path & "/隐形效果.bmp", BD
End Sub

3.3 灯光效果

这是一种滤镜效果，就是在图像内取一点作为光源，从光线未端开始向光源点逐渐加亮。用到的公式是：

点(x,y) = 点 (x,y)+m*{1-[sqrt((x-a)^2+(y-b)^2)+n]/b}

条件是

sqrt((x-a)^2+(y-b)^2)-b<0

a,b 为光源点的坐标值， m,n 为调节灯光的参数。

在模块加入：

Public Sub DengGuang(Bmp_SBmpFileName As BmpFile, Bmp_DBmpFileName As _
    BmpFile, x As Long, Y As Long, m As Long, n As Long)
    '灯光效果
    Dim i As Long, j As Long, R As Long, G As Long, B As Long
    Bmp_DBmpFileName = Bmp_SBmpFileName
    For i = 1 To Bmp_DBmpFileName.Bmp_BmpPictureHeard.BmpWidth - 1
        For j = 1 To Bmp_DBmpFileName.Bmp_BmpPictureHeard.BmpHeight - 1
            If Sqr((i - x) ^ 2 + (j - Y) ^ 2) - 60 < 0 Then
                R = Bmp_DBmpFileName.Bmp_Bmp(i, j).Red + (m * (1 - _
                    (Sqr((i - x) ^ 2 + (j - Y) ^ 2) + n) / Y))
                G = Bmp_DBmpFileName.Bmp_Bmp(i, j).Green + (m * (1 _
                    - (Sqr((i - x) ^ 2 + (j - Y) ^ 2) + n) / Y))
                B = Bmp_DBmpFileName.Bmp_Bmp(i, j).Blue + (m * (1 - _
                    (Sqr((i - x) ^ 2 + (j - Y) ^ 2) + n) / Y))
                
                If R < 0 Then R = 0
                If R > 255 Then R = 255
                
                If G < 0 Then G = 0
                If G > 255 Then G = 255
                
                If B < 0 Then B = 0
                If B > 255 Then B = 255
                
                Bmp_DBmpFileName.Bmp_Bmp(i, j).Red = R
                Bmp_DBmpFileName.Bmp_Bmp(i, j).Green = G
                Bmp_DBmpFileName.Bmp_Bmp(i, j).Blue = B
              
            End If
        Next j
    Next i
End Sub

在窗体中加入灯光 (DengGuangCommand) 按钮：

Private Sub DengGuangCommand_Click()
    Dim BD As BmpFile, BS As BmpFile
    GetBmpFile App.Path & "/原.bmp", BS
    DengGuang BS, BD, 100, 100, 200, 60
    PutBmpFile App.Path & "/灯光效果.bmp", BD
End Sub
                        

在这个程序中我最的光源点是（ 100 ， 100 ），两个参数分别为 200 和 60 。

3.4 木刻效果

算法很简单就是，如果 RGB 的平均值大于 128 就把这个点变为黑色，否则就变为白色。

在模块中加入如下代码：

Public Sub MuKe(Bmp_SBmpFileName As BmpFile, Bmp_DBmpFileName As BmpFile)
    '木刻效果
    Dim i As Integer, j As Integer
    Bmp_DBmpFileName = Bmp_SBmpFileName
    For i = 1 To Bmp_DBmpFileName.Bmp_BmpPictureHeard.BmpWidth
        For j = 1 To Bmp_DBmpFileName.Bmp_BmpPictureHeard.BmpHeight
            If (CLng(Bmp_DBmpFileName.Bmp_Bmp(i, j).Red) + _
                CLng(Bmp_DBmpFileName.Bmp_Bmp(i, j).Green) + _
                CLng(Bmp_DBmpFileName.Bmp_Bmp(i, j).Blue)) / 3 > 128 Then
                Bmp_DBmpFileName.Bmp_Bmp(i, j).Red = 0
                Bmp_DBmpFileName.Bmp_Bmp(i, j).Green = 0
                Bmp_DBmpFileName.Bmp_Bmp(i, j).Blue = 0
            Else
                Bmp_DBmpFileName.Bmp_Bmp(i, j).Red = &HFF
                Bmp_DBmpFileName.Bmp_Bmp(i, j).Green = &HFF
                Bmp_DBmpFileName.Bmp_Bmp(i, j).Blue = &HFF
            End If
        Next j
    Next i
End Sub

在窗体中加入木刻（ MuKeCommand ）按钮：

Private Sub MuKeCommand_Click()
    Dim BD As BmpFile, BS As BmpFile
    GetBmpFile App.Path & "/原.bmp", BS
    MuKe BS, BD
    PutBmpFile App.Path & "/木刻效果.bmp", BD
End Sub
                        

3.5 浮雕效果

就是用当前点的 RGB 颜色减去相邻点的 RGB 颜色再加上一个常数就可以了。

在模块中加入代码：

Public Sub FuDiao(Bmp_SBmpFileName As BmpFile, Bmp_DBmpFileName As BmpFile)
    '浮雕效果
    Dim i As Long, j As Long
    Bmp_DBmpFileName = Bmp_SBmpFileName
    For i = 1 To Bmp_DBmpFileName.Bmp_BmpPictureHeard.BmpWidth - 1
        For j = 1 To Bmp_DBmpFileName.Bmp_BmpPictureHeard.BmpHeight - 1
            Bmp_DBmpFileName.Bmp_Bmp(i, j).Red = _
                IIf((CLng(Bmp_DBmpFileName.Bmp_Bmp(i, j).Red) - _
                CLng(Bmp_DBmpFileName.Bmp_Bmp(i + 1, j + 1).Red) + 128) _
                > 255, 255, IIf((CLng(Bmp_DBmpFileName.Bmp_Bmp(i, j).Red) _
                - CLng(Bmp_DBmpFileName.Bmp_Bmp(i + 1, j + 1).Red) + 128) _
                < 0, 0, (CLng(Bmp_DBmpFileName.Bmp_Bmp(i, j).Red) - _
                CLng(Bmp_DBmpFileName.Bmp_Bmp(i + 1, j + 1).Red) + 128)))
            Bmp_DBmpFileName.Bmp_Bmp(i, j).Green = _
                IIf((CLng(Bmp_DBmpFileName.Bmp_Bmp(i, j).Green) - _
                CLng(Bmp_DBmpFileName.Bmp_Bmp(i + 1, j + 1).Green) + 128) _
                > 255, 255, IIf((CLng(Bmp_DBmpFileName.Bmp_Bmp(i, j).Green) _
                - CLng(Bmp_DBmpFileName.Bmp_Bmp(i + 1, j + 1).Green) + 128) _
                < 0, 0, (CLng(Bmp_DBmpFileName.Bmp_Bmp(i, j).Green) - _
                CLng(Bmp_DBmpFileName.Bmp_Bmp(i + 1, j + 1).Green) + 128)))
            Bmp_DBmpFileName.Bmp_Bmp(i, j).Blue = _
                IIf((CLng(Bmp_DBmpFileName.Bmp_Bmp(i, j).Blue) - _
                CLng(Bmp_DBmpFileName.Bmp_Bmp(i + 1, j + 1).Blue) + 128) _
                > 255, 255, IIf((CLng(Bmp_DBmpFileName.Bmp_Bmp(i, j).Blue) _
                - CLng(Bmp_DBmpFileName.Bmp_Bmp(i + 1, j + 1).Blue) + 128) _
                < 0, 0, (CLng(Bmp_DBmpFileName.Bmp_Bmp(i, j).Blue) - _
                CLng(Bmp_DBmpFileName.Bmp_Bmp(i + 1, j + 1).Blue) + 128)))
        Next j
    Next i
  
    Bmp_DBmpFileName.Bmp_BmpPictureHeard.BmpHeight = _
        Bmp_DBmpFileName.Bmp_BmpPictureHeard.BmpHeight - 1
    Bmp_DBmpFileName.Bmp_BmpPictureHeard.BmpWidth = _
        Bmp_DBmpFileName.Bmp_BmpPictureHeard.BmpWidth - 1
End Sub

在窗体中加入浮雕 (FuDiaoCommand) 按钮，代码如下；

Private Sub FuDiaoCommand_Click()
    Dim BD As BmpFile, BS As BmpFile
    GetBmpFile App.Path & "/原.bmp", BS
    FuDiao BS, BD
    PutBmpFile App.Path & "/浮雕效果.bmp", BD
End Sub
                        

3.6 油画

用当前像素四周一定范围内任的任意一点的颜色代替当前点的颜色即可：

在模块中加入如下代码：

Public Sub YouHua(Bmp_SBmpFileName As BmpFile, Bmp_DBmpFileName As _
    BmpFile, Bmp_BmpSize As Integer)
    '油画效果
    Dim i As Integer, j As Integer, a As Integer, B As Integer
    Bmp_DBmpFileName = Bmp_SBmpFileName
    For i = 1 To Bmp_DBmpFileName.Bmp_BmpPictureHeard.BmpWidth - Bmp_BmpSize
        For j = 1 To Bmp_DBmpFileName.Bmp_BmpPictureHeard.BmpHeight - _
            Bmp_BmpSize
            a = Rnd() * (Bmp_BmpSize - 1) + 1
            B = Rnd() * (Bmp_BmpSize - 1) + 1
            Bmp_DBmpFileName.Bmp_Bmp(i, j).Red = _
                Bmp_DBmpFileName.Bmp_Bmp(i + a, j + B).Red
            Bmp_DBmpFileName.Bmp_Bmp(i, j).Green = _
                Bmp_DBmpFileName.Bmp_Bmp(i + a, j + B).Green
            Bmp_DBmpFileName.Bmp_Bmp(i, j).Blue = _
                Bmp_DBmpFileName.Bmp_Bmp(i + a, j + B).Blue
        Next j
    Next i
End Sub

在窗体中加入油画（ YouHuaCommand ）按钮，代码如下：

Private Sub YouHuaCommand_Click()
    Dim BD As BmpFile, BS As BmpFile
    GetBmpFile App.Path & "/原.bmp", BS
    YouHua BS, BD, 5
    PutBmpFile App.Path & "/油画效果.bmp", BD
End Sub

在代码中的 5 为一个范围。