想做个DLL插件获取硬盘内bmp指定点颜色

Question

想做个DLL插件获取硬盘内bmp指定点颜色 供按键精灵调用 不知道错在哪
新建类模块 添加代码.
Public Function GetBmpColor(ByVal sPath As String, ByVal sX As Integer, ByVal sY As Integer)
Dim BMPWidth As Long
Dim BMPHeight As Long
Dim LineWidth As Long
Dim ArrByte(0 To 3) As Byte
Dim R As Integer
Dim G As Integer
Dim B As Integer
    Open CStr(sPath) For Binary As #1    Get #1, 19, ArrByte
    BMPWidth = ArrByte(3) * 256 ^ 3 + ArrByte(2) * 256 ^ 2 + ArrByte(1) * 256 + ArrByte(0)
    Get #1, 23, ArrByte
    BMPHeight = ArrByte(3) * 256 ^ 3 + ArrByte(2) * 256 ^ 2 + ArrByte(1) * 256 + ArrByte(0)    'BMP图要求每行字节数为4的倍数,不够则填充1-3个无用字节
    Select Case (BMPWidth * 3) Mod 4
    Case 0
        LineWidth = BMPWidth * 3
    Case 1
        LineWidth = BMPWidth * 3 + 3
    Case 2
        LineWidth = BMPWidth * 3 + 2
    Case 3
        LineWidth = BMPWidth * 3 + 1
    End Select    Get #1, FindByte(LineWidth, BMPHeight, CLng(sX), CLng(sY)), ArrByte
    R = ArrByte(2)
    G = ArrByte(1)
    B = ArrByte(0)
    Close #1
    GetBmpColor = Right("000000" & Hex(RGB(R, G, B)), 6)
End Function
Private Function FindByte(ByVal LineWidth As Long, ByVal LineCount As Long, ByVal X As Long, ByVal Y As Long) As Long    FindByte = 55 + (LineCount - Y - 1) * LineWidth + 3 * XEnd Function 另还有个问题 像Byte修改颜色怎么弄？

Answer 1

bmp有很多种格式，自己处理起来比较麻烦，可弄一个隐藏的窗体，放一个picturebox,把图片读到picturebox中,然后使用API函数getpixel就可以很方便得读取了

Answer 2

Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" _
(ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) _
As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, _
ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As LongPrivate Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End TypePrivate Sub Command1_Click()
    Dim hBitmap As Long
    Dim res As Long
    Dim bmp As BITMAP
    Dim byteAry() As Byte
    Dim totbyte As Long, i As Long, j As Long, Alpha As Long, Tmp As Long
'    Picture1.Line (0, 0)-(Picture1.ScaleWidth, Picture1.ScaleHeight), vbBlack
    hBitmap = Picture1.Picture.Handle
    
    res = GetObject(hBitmap, Len(bmp), bmp) '注释：取得BitMap的结构
    
    totbyte = bmp.bmWidthBytes * bmp.bmHeight '注释：总共要多少个Byte来存图
    
    ReDim byteAry(totbyte - 1)
    '注释: 将该图全放进ByteAry中
    res = GetBitmapBits(hBitmap, totbyte, byteAry(0))
    
    Debug.Print "全部数据长度：Total Bytes Copied :"; res
    Debug.Print "图总位数：bmp.bmBits "; bmp.bmBits
    Debug.Print "调色版数：bmp.bmPlanes "; bmp.bmPlanes
    Debug.Print "图类型：bmp.bmType "; bmp.bmType
    Debug.Print "点位：bmp.bmBitsPixel "; bmp.bmBitsPixel '注释: 每个Pixel需多少Bits来表现
    Debug.Print "图高：bmp.bmHeight "; bmp.bmHeight '注释: bitmap图的高是多少Pixels
    Debug.Print "图宽：bmp.bmWidth "; bmp.bmWidth '注释: BitMap图宽为多少pixels
    Debug.Print "扫描线长度：bmp.bmWidthBytes "; bmp.bmWidthBytes '注释: 每条扫描线需多少Byte来存
    Alpha = 100
    AddV Alpha, byteAry, bmp
    SetBitmapBits hBitmap, totbyte, byteAry(0)
    Picture1.Refresh
End SubPrivate Sub AddV(Alpha As Long, byteAry() As Byte, bmp As BITMAP)
    '增加图片亮度
    Dim i As Long, j As Long, Tmp As Long, x As Long, ColorNum As Long
    ColorNum = bmp.bmBitsPixel / 8
    For i = 0 To bmp.bmHeight - 1
        For j = 0 To bmp.bmWidth - 1
            For x = 0 To ColorNum - 1
                Tmp = byteAry(j * 3 + x + i * bmp.bmWidthBytes) * (Alpha / 100)
                byteAry(j * 3 + x + i * bmp.bmWidthBytes) = IIf(Tmp > 255, 255, Tmp)
            Next
        Next
    NextEnd Sub