【VB技巧】32*32的24位Bmp转换为24位Ico

函数功能：
32×32的24位bmp位图转换为24位Ico图标，不需任何控件和外部函数，输入bmp文件名和ico文件名就完成了。

转换原理:
32×32的24位Ico图标文件至少3262字节(记为第0~3261字节)，前44个字节(第0~43字节)是32×32的24位ico图标的标记，第44~61这18个字节不影响图标效果，第62~3133这3072个字节

(3072*8=32*32*24)每3个字节(24位)对应一个像素，记录着所有像素的颜色，第3134~3261这128字节(1024位，128*8=32*32)每位对应一个像素，记录着每个像素是否有特殊效果，如果某个像素在这128

字节中对应的那一位是1，表示该像素有特殊效果。（本文的特殊效果是指图标某像素与它挡住的像素的颜色值的“异或”组合）

Private Sub Bmptoico(BmpFile As String, IcoFile As String)
    'On Error GoTo err
    Dim Bmp(3125) As Byte, Ico(3261) As Byte, IcoHead
    Dim I, Y, X, B
    IcoHead = Array(0, 0, 1, 0, 1, 0, 32, 32, 0, 0, 1, 0, 24, 0, 168, 12, 0, 0, 22, 0, 0, 0, 40, 0, 0, 0, 32, 0, 0, 0, 64, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, 128, 12)
    Open BmpFile For Binary As #1
        Get #1, , Bmp
    Close #1
    If Bmp(18) <> 32 Or Bmp(22) <> 32 Or FileLen(BmpFile) <> 3126 Then GoTo Err
    For I = 0 To 43
        Ico(I) = IcoHead(I)
    Next I
    For I = 62 To 3133
        Ico(I) = Bmp(I - 8)
    Next I
    For Y = 31 To 0 Step -1
        For X = 0 To 31 Step 8
            For B = 0 To 7
                Ico(I) = Ico(I) + 2 ^ (7 - B) * (-(Point(X + B, Y) = RGB(255, 255, 255))) '透明色RGB(255,255,255)
            Next B
            I = I + 1
        Next X
    Next Y
    Open IcoFile For Binary As #1
        Put #1, , Ico
    Close #1
    MsgBox "转换完成!", vbInformation, "提示:"
Err:
End Sub

Private Sub Form_Load()
Bmptoico "c:\a.bmp", "c:\a.ico"
End Sub

文章目录