如何用API将一个ICO转换成BMP

Question

有这方面的例子烦大家发[email protected]或回复于此。1、如何用API将一个ICO转换成BMP
2、或者
　例如窗口有2个image(pictureBox)，image1的picture属性设为一个ICO图标，这时image1.type为vbPicTypeIcon，要求用API实现：image2显示的图片和image1的一样，但是由image1的picture转换来，最重要的一点是image1.type为vbPicTypeBitmap。
3、给大家一些参考：从ICO到Picture的方法。下面代码放一窗口中：在其上放一Command和pictureBox
Option ExplicitPrivate Declare Function LoadImage Lib "user32" Alias "LoadImageA" _
    (ByVal hInst As Long, ByVal lpsz As String, _
    ByVal iType As Long, _
    ByVal cx As Long, ByVal cy As Long, _
    ByVal fOptions As Long) As Long
' iType options:
Private Const IMAGE_BITMAP = 0
Private Const IMAGE_ICON = 1
Private Const IMAGE_CURSOR = 2
' fOptions flags:
Private Const LR_LOADMAP3DCOLORS = &H1000
Private Const LR_LOADFROMFILE = &H10
Private Const LR_LOADTRANSPARENT = &H20
Private Sub Command1_Click()
Dim hIcon As Long
    ' Load an icon called Test.Ico from the directory:
    
    ' If the icon contains more than one size of image,
    ' set cx and cy to the width and height to load
    ' the appropriate image in:
    hIcon = LoadImage(App.hInstance, App.Path & "\FundICO.ICO", IMAGE_ICON, 0, 0, LR_LOADFROMFILE Or LR_LOADMAP3DCOLORS)
    ' Set the picture to this icon:
    Set Picture1.Picture = IconToPicture(hIcon)
End Sub下面代码放一模块中：
Option ExplicitPrivate Type PictDesc
    cbSizeofStruct As Long
    picType As Long
    hImage As Long
    xExt As Long
    yExt As Long
End Type
Private Type Guid
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (lpPictDesc As PictDesc, riid As Guid, ByVal fPictureOwnsHandle As Long, ipic As IPicture) As LongPublic Function IconToPicture(ByVal hIcon As Long) As IPicture
    
    If hIcon = 0 Then Exit Function
        
    
    Dim oNewPic As Picture
    Dim tPicConv As PictDesc
    Dim IGuid As Guid
    
    With tPicConv
    .cbSizeofStruct = Len(tPicConv)
    .picType = vbPicTypeIcon
    .hImage = hIcon
    End With
    
    ' Fill in magic IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
    With IGuid
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With
    OleCreatePictureIndirect tPicConv, IGuid, True, oNewPic
    
    Set IconToPicture = oNewPic
    
End Function

Answer 1

不用API不行么？
你可以用Picture box控件加载该ICON图片
然后再用savePicture保存为bmp不可以么？

Answer 2

' 刚出炉的一个 module：ico2bmp。直接调用 IconToBitmap 函数就可以了Option Explicit
Private Type BITMAP
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
End Type
Private Type ICONINFO
        fIcon As Long
        xHotspot As Long
        yHotspot As Long
        hbmMask As Long
        hbmColor As Long
End Type
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Private Type GUID
        Data1 As Long
        Data2 As Integer
        Data3 As Integer
        Data4(7) As Byte
End Type
Private Type PICTDESC
        cbSizeOfStruct As Long
        picType As Long
        handle As Long
        val1 As Long
        val2 As Long
End Type
Private Declare Function GetIconInfo Lib "user32" (ByVal hIcon As Long, piconinfo As ICONINFO) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) 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 CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As Long, ByVal lpOutput As Long, ByVal lpInitData As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32" (pPicDesc As PICTDESC, riid As GUID, fOwn As Long, ByVal ppvObj As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function GetSysColorBrush Lib "user32" (ByVal nIndex As Long) As Long
Public Function IconToBitmap(picIcon As IPictureDisp, Optional ByVal backColor As OLE_COLOR = vbButtonFace) As IPictureDisp
  Dim ii As ICONINFO, bmp As BITMAP, cdc As Long, _
     cbm As Long, ibm As Long, picdesc As PICTDESC, iid As GUID, disp_dc As Long
  Dim data() As Byte, newbmp As IPictureDisp, cdcx As Long, cdcy As Long, rct As RECT, brsh As Long
  If picIcon.type = vbPicTypeIcon Then
    If GetIconInfo(picIcon.handle, ii) Then
      ibm = IIf(ii.hbmColor = 0&, ii.hbmMask, ii.hbmColor)
      If GetObject(ibm, LenB(bmp), bmp) Then
        disp_dc = CreateDC("DISPLAY", 0&, 0&, 0&)
        cdc = CreateCompatibleDC(disp_dc)
        cdcx = CreateCompatibleDC(disp_dc)
        cdcy = CreateCompatibleDC(disp_dc)
        If cdc Then
          cbm = CreateCompatibleBitmap(disp_dc, bmp.bmWidth, bmp.bmHeight)
          If cbm Then
            SelectObject cdc, cbm
            SelectObject cdcx, ii.hbmColor
            SelectObject cdcy, ii.hbmMask
            With rct
              .Right = bmp.bmWidth
              .Bottom = bmp.bmHeight
            End With
            If backColor And &H80000000 Then
              brsh = GetSysColorBrush(backColor And &H7FFFFFFF)
            Else
              brsh = CreateSolidBrush(backColor And &HFFFFFF)
            End If
            If brsh Then
              FillRect cdc, rct, brsh
              BitBlt cdc, 0&, 0&, bmp.bmWidth, bmp.bmHeight, cdcy, 0&, 0&, vbSrcAnd
              BitBlt cdc, 0&, 0&, bmp.bmWidth, bmp.bmHeight, cdcx, 0&, 0&, vbSrcInvert
              With picdesc
                .cbSizeOfStruct = LenB(picdesc)
                .picType = vbPicTypeBitmap
                .handle = cbm
                .val1 = 0
              End With
              iid = MakeGUID(&H7BF80981, &HBF32, &H101A, _
                &H8B, &HBB, &H0, &HAA, &H0, &H30, &HC, &HAB)
              If OleCreatePictureIndirect(picdesc, iid, 1&, VarPtr(newbmp)) >= 0 Then
                Set IconToBitmap = newbmp
              End If
              If backColor And &H80000000 = 0& Then DeleteObject brsh
            End If
            DeleteObject cbm
          End If
          Erase data
          DeleteDC cdcy
          DeleteDC cdcx
          DeleteDC cdc
          DeleteDC disp_dc
        End If
      End If
    End If
  End If
End Function
Private Function MakeGUID(d1 As Long, d2 As Integer, d3 As Integer, ParamArray d4()) As GUID
  Dim i As Long
  With MakeGUID
    .Data1 = d1
    .Data2 = d2
    .Data3 = d3
    For i = 0& To 7&
      .Data4(i) = CByte(d4(i))
    Next
  End With
End Function

Answer 3

顶一下
呵呵，我关注的正好相反（把bmp转为ico，背景透明）。

Answer 4

关于此问题的详细描述见：http://5ivb.net/club/dispbbs.asp?boardID=1&ID=17952如何用API将image控件图片类型为vbPicTypeIcon的转换成vbPicTypeBitmap
而不是那类将ICO文件转换成BMP文件或BMP转换成ICO文件的例子，这类例子有。在窗口上放2个image。Image1中的Picture是放的一个ICO图片，所以其Tpye为vbPicTypeIcon，要求使用API函数实现Image2的图片与image1显示的一样，但是image2的Type为vbPicTypeBitmap。