运行环境：分辨率：1024×768 色深：16位 操作系统：Microsoft Windows XP 按键精灵版本：8.11.7459

@xxchuchu2011/1/14

raGrayLevel = 200   const RedOfRGB   = 1   const GreenOfRGB = 2   const BlueOfRGB  = 3   Dim   GraphicArray( 1000, 1000 )    Dim   GrayArray( 1000, 1000 )   //图片特征数组: GraphicArray放的颜色串字符;    //             GrayArray 放的二值化数字   //定义图形矩形左上角和右下角坐标   Dim   RectangleBegin, RectangleEnd   RectangleBegin = "315,108"   RectangleEnd   = "430,132"   Dim MyArray, x1, y1, x2, y2   MyArray = split( RectangleBegin, "," )   x1 = CInt( MyArray(0) )   y1 = CInt( MyArray(1) )   MyArray = split( RectangleEnd, "," )   x2 = CInt( MyArray(0) )   y2 = CInt( MyArray(1) )      Call GetGraphic( RectangleBegin, RectangleEnd, ParaGrayLevel )   Dim Str   Str = ""   For y = y1 to y2       For x = x1 to x2           Str = Str & GrayArray( x, y )       Next        Str = Str & vbCrlf   Next    MessageBox Str                Sub GetGraphic( RectangleBegin, RectangleEnd, GrayLevel )   //制作人员:xxchuchu   //制作时间:2011.01.10   //功能说明:返回指定矩形[左上角和右下角坐标定义此矩形]范围的颜色字符数组   //这里直接对全局数组变量GraphicArray进行赋值   //参数说明:   //GetGraphic     返回值, 格式:nnn 数字型   //RectangleBegin 矩形左上角坐标, 格式:X,Y  字符型   //RectangleEnd   矩形右下角坐标, 格式:X,Y  字符型   Dim MyArray, x1, y1, x2, y2       MyArray = split( RectangleBegin, "," )       x1 = CInt( MyArray(0) )       y1 = CInt( MyArray(1) )       MyArray = split( RectangleEnd, "," )       x2 = CInt( MyArray(0) )       y2 = CInt( MyArray(1) )       For y = y1 to y2           For x = x1 to x2               GraphicArray( x, y ) = GetPixelColor(x,y)               GrayArray( x, y ) = PartNumOfRGB( GraphicArray( x, y ), RedOfRGB )                GrayArray( x, y ) = Binarization( GrayArray( x, y ), ParaGrayLevel )            Next        Next    End Sub      Function ConvertGraphicToNum      End Function      Function Binarization( ParaNum, GrayLevel )   //制作人员:xxchuchu   //制作时间:2011.01.10   //功能说明:二值化,返回输入数字 ParaNum 的 经过灰色计算后的值0或1   //参数说明:   //Binarization  返回值, 格式:n 数字型, n = 0,1   //ParaNum       10进制数字, 格式:nnnnn  数字型   //GrayLevel     灰度,格式:nnn 数字型,n = 0-999       If ParaNum < GrayLevel Then            Binarization = 1       Else             Binarization = 0       End If       Rem EndOfFunc    End Function      Function PartNumOfRGB( sColor, PartOfRGB )    //制作人员:xxchuchu   //制作时间:2011.01.10   //功能说明:返回颜色字符串 sColor 的 PartOfRGB 部分RGB( Red, Green, Blue )   //参数说明:   //PartNumOfRGB  返回值, 格式:nnn 数字型   //sColor        16进制6位数颜色字符串, 格式:xxxxxx  字符型,x=0-9,A-F   //PartOfRGB     颜色串中需要取值的部分,格式:n 数字型,n = 1,2,3       Dim MyByte       Dim i, NumOfPart              //先将16进制数转换成10进制数       NumOfPart = 0       For i = 1 to 6           MyByte = Mid( sColor, i, 1 )           Select Case MyByte           Case "A"               NumOfPart = ( NumOfPart + 10 ) * 16            Case "B"               NumOfPart = ( NumOfPart + 11 ) * 16            Case "C"               NumOfPart = ( NumOfPart + 12 ) * 16                        Case "D"               NumOfPart = ( NumOfPart + 13 ) * 16            Case "E"               NumOfPart = ( NumOfPart + 14 ) * 16            Case "F"               NumOfPart = ( NumOfPart + 15 ) * 16            Case Else               NumOfPart = ( NumOfPart + CInt( MyByte ) ) * 16            End Select       Next       //上面多乘了16，要去掉       NumOfPart = NumOfPart / 16       // Red + Green*256 + Blue*65536       Select Case PartOfRGB           Case 1               NumOfPart = NumOfPart - 65536 * Fix( NumOfPart/65536 )               //去掉Blue色               NumOfPart = NumOfPart - 256 * Fix( NumOfPart/256 )               //去掉Green色           Case 2               NumOfPart = NumOfPart - 65536 * Fix( NumOfPart/65536 )               //去掉Blue色               NumOfPart = Fix( NumOfPart/256 )               //得到Green色           Case Else               NumOfPart = Fix( NumOfPart/65536 )               //得到Blue色       End Select       PartNumOfRGB = NumOfPart       Rem EndOfGetRedOfRGB   End Function