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