首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

在VB中运用真彩色图标

2012-12-30 
在VB中使用真彩色图标怎么在VB中使用真彩色图标呢,我使用时总是提示图片无效。[解决办法]PNG图片?看看这段

在VB中使用真彩色图标
怎么在VB中使用真彩色图标呢,我使用时总是提示图片无效。
[解决办法]
PNG图片?
看看这段代码:


'****************************************************************************
'人人为我,我为人人
'枕善居汉化收藏整理
'发布日期:05/04/18
'描  述:打开并显示PNG图片的源码
'网  站:http://www.mndsoft.com/blog/
'e-mail:mnd@mndsoft.com
'OICQ  : 88382850
'****************************************************************************

Option Explicit
Public Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

' 常数
Private Const SRCCOPY = &HCC0020
Private Const BI_RGB = 0&
Private Const CBM_INIT = &H4
Private Const DIB_RGB_COLORS = 0
' 类型
Public Type RGBTriple
    Red As Byte
    Green As Byte
    Blue As Byte
End Type

Private Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type

Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type

Private Type BITMAPINFO_1
bmiHeader As BITMAPINFOHEADER
bmiColors(1) As RGBQUAD
End Type
Private Type BITMAPINFO_2
bmiHeader As BITMAPINFOHEADER
bmiColors(3) As RGBQUAD
End Type
Private Type BITMAPINFO_4
bmiHeader As BITMAPINFOHEADER
bmiColors(15) As RGBQUAD
End Type
Private Type BITMAPINFO_8
bmiHeader As BITMAPINFOHEADER
bmiColors(255) As RGBQUAD
End Type
Private Type BITMAPINFO_16
    bmiHeader As BITMAPINFOHEADER
    bmiColors As RGBQUAD
End Type
Private Type BITMAPINFO_24
    bmiHeader As BITMAPINFOHEADER
    bmiColors As RGBQUAD
End Type
Private Type BITMAPINFO_24a
    bmiHeader As BITMAPINFOHEADER
    bmiColors As RGBTriple
End Type

' API函数
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long


Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateDIBitmap_1 Lib "gdi32" Alias "CreateDIBitmap" (ByVal hdc As Long, lpInfoHeader As BITMAPINFOHEADER, ByVal dwUsage As Long, lpInitBits As Any, lpInitInfo As BITMAPINFO_1, ByVal wUsage As Long) As Long
Private Declare Function CreateDIBitmap_2 Lib "gdi32" Alias "CreateDIBitmap" (ByVal hdc As Long, lpInfoHeader As BITMAPINFOHEADER, ByVal dwUsage As Long, lpInitBits As Any, lpInitInfo As BITMAPINFO_2, ByVal wUsage As Long) As Long
Private Declare Function CreateDIBitmap_4 Lib "gdi32" Alias "CreateDIBitmap" (ByVal hdc As Long, lpInfoHeader As BITMAPINFOHEADER, ByVal dwUsage As Long, lpInitBits As Any, lpInitInfo As BITMAPINFO_4, ByVal wUsage As Long) As Long
Private Declare Function CreateDIBitmap_8 Lib "gdi32" Alias "CreateDIBitmap" (ByVal hdc As Long, lpInfoHeader As BITMAPINFOHEADER, ByVal dwUsage As Long, lpInitBits As Any, lpInitInfo As BITMAPINFO_8, ByVal wUsage As Long) As Long
Private Declare Function CreateDIBitmap_16 Lib "gdi32" Alias "CreateDIBitmap" (ByVal hdc As Long, lpInfoHeader As BITMAPINFOHEADER, ByVal dwUsage As Long, lpInitBits As Any, lpInitInfo As BITMAPINFO_16, ByVal wUsage As Long) As Long
Private Declare Function CreateDIBitmap_24 Lib "gdi32" Alias "CreateDIBitmap" (ByVal hdc As Long, lpInfoHeader As BITMAPINFOHEADER, ByVal dwUsage As Long, lpInitBits As Any, lpInitInfo As BITMAPINFO_24, ByVal wUsage As Long) As Long
Private Declare Function CreateDIBitmap_24a Lib "gdi32" Alias "CreateDIBitmap" (ByVal hdc As Long, lpInfoHeader As BITMAPINFOHEADER, ByVal dwUsage As Long, lpInitBits As Any, lpInitInfo As BITMAPINFO_24a, ByVal wUsage As Long) As Long



'头信息
Private bm1 As BITMAPINFO_1
Private bm2 As BITMAPINFO_2
Private bm4 As BITMAPINFO_4
Private bm8 As BITMAPINFO_8
Private bm16 As BITMAPINFO_16
Private bm24 As BITMAPINFO_24
Private bm24a As BITMAPINFO_24a

'bitmap 句柄.
Private hBmp As Long

Private Type ScTw
Width As Long
Height As Long
End Type

Public Sub InitColorTable_1(Optional Sorting As Integer = 1)
    Dim Fb1 As Byte
    Dim Fb2 As Byte


    Select Case Sorting
        Case 0
            Fb1 = 255
            Fb2 = 0
        Case 1
            Fb1 = 0
            Fb2 = 255
    End Select
    bm1.bmiColors(0).rgbRed = Fb1
    bm1.bmiColors(0).rgbGreen = Fb1
    bm1.bmiColors(0).rgbBlue = Fb1
    bm1.bmiColors(0).rgbReserved = 0
    bm1.bmiColors(1).rgbRed = Fb2
    bm1.bmiColors(1).rgbGreen = Fb2
    bm1.bmiColors(1).rgbBlue = Fb2
    bm1.bmiColors(1).rgbReserved = 0

End Sub

Public Sub InitColorTable_1Palette(Palettenbyte() As Byte)
    If UBound(Palettenbyte) = 5 Then
        bm1.bmiColors(0).rgbRed = Palettenbyte(0)
        bm1.bmiColors(0).rgbGreen = Palettenbyte(1)
        bm1.bmiColors(0).rgbBlue = Palettenbyte(2)
        bm1.bmiColors(0).rgbReserved = 0
        bm1.bmiColors(1).rgbRed = Palettenbyte(3)
        bm1.bmiColors(1).rgbGreen = Palettenbyte(4)
        bm1.bmiColors(1).rgbBlue = Palettenbyte(5)
        bm1.bmiColors(1).rgbReserved = 0
    Else
        InitColorTable_1
    End If
End Sub

Public Sub InitColorTable_8(ByteArray() As Byte)
'定义调色板
'==================================================
    Dim Palette8() As RGBTriple
    ReDim Palette8(255)
    
    CopyMemory Palette8(0), ByteArray(0), UBound(ByteArray) + 1
    
    Dim nCount As Long
    On Error Resume Next
    '建立调色板
    For nCount = 0 To 255
        bm8.bmiColors(nCount).rgbBlue = Palette8(nCount).Blue
        bm8.bmiColors(nCount).rgbGreen = Palette8(nCount).Green
        bm8.bmiColors(nCount).rgbRed = Palette8(nCount).Red
        bm8.bmiColors(nCount).rgbReserved = 0
    Next nCount
End Sub

Public Sub InitColorTable_4(ByteArray() As Byte)
    Dim Palette4() As RGBTriple
    ReDim Palette4(15)
    CopyMemory Palette4(0), ByteArray(0), UBound(ByteArray) + 1

    Dim i As Integer
' 建立颜色表
    For i = 0 To 15


        bm4.bmiColors(i).rgbRed = Palette4(i).Red
        bm4.bmiColors(i).rgbGreen = Palette4(i).Green
        bm4.bmiColors(i).rgbBlue = Palette4(i).Blue
        bm4.bmiColors(i).rgbReserved = 0
    Next i
End Sub


Public Sub CreateBitmap_1(ByteArray() As Byte, BMPWidth As Long, BMPHeight As Long, Orientation As Integer, Optional Colorused As Long = 0)
' 建立一个 1bit 的Bitmap
    Dim hdc As Long
    With bm1.bmiHeader
        .biSize = Len(bm1.bmiHeader)
        .biWidth = BMPWidth
        If Orientation = 0 Then
            .biHeight = BMPHeight                    'Bitmap 高度, bitmap 置顶
        Else
            .biHeight = -BMPHeight
        End If
        .biPlanes = 1
        .biBitCount = 1
        .biCompression = BI_RGB
        .biSizeImage = 0
        .biXPelsPerMeter = 0
        .biYPelsPerMeter = 0
        .biClrUsed = Colorused
        .biClrImportant = 0
    End With
    ' 获取 DC.
    hdc = GetDC(0)
    hBmp = CreateDIBitmap_1(hdc, bm1.bmiHeader, CBM_INIT, ByteArray(0), bm1, DIB_RGB_COLORS)
End Sub


热点排行