按键精灵图形数字脚本源码

运行环境：分辨率：1024x768 色深：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