如何释放资源文件里的ICO图标资源到指定目录

Question

如何释放资源文件里的ICO图标资源到指定目录?我已经将ICO图标添加到资源文件里了.但我希望点击按钮可以将ICO资源释放到指定目录,代码要怎么写?

Answer 1

找到一段代码，应该可行
http://hi.baidu.com/ljl88900/blog/item/30920a513a53d4858d543065.html

Answer 2

注意：用VB资源编辑器的添加自定义资源...装入ICO图片（不要用添加图标...载入ICO文件,否则无法实现）。
Private Sub Command1_Click()
   Dim b() As Byte
   
   b = LoadResData(101, "CUSTOM")
   Open "c:\1.ico" For Binary As #1
   Put #1, 1, b
   Close #1
   MsgBox "OK,c:\1.ico"
End Sub

Answer 3

以前用VC写过释放资源中的位图（支持ICO），你参考一下：VC如何将资源中包含的位图释放成文件

Answer 4

谢谢3楼的,我知道可以在自定义资源里释放,我现在没找出方法前也是用这样的方法的,
但是我的图像框要直接调用ICO资源里的图标的,所以我要放一份到ICO资源里,但是如果
要释放的话,那我还不是要在自定义资源里再放一份?这样不是重复了,增加资源的大小,
或能不能图像框直接用代码打开并显示自定义资源里的图标呢?

Answer 5

Private Declare Function FindResource Lib "kernel32" Alias "FindResourceA" (ByVal hInstance As Long, ByVal lpName As Long, ByVal lpType As Long) As Long
Private Declare Function LoadResource Lib "kernel32" (ByVal hInstance As Long, ByVal hResInfo As Long) As Long
Private Declare Function SizeofResource Lib "kernel32" (ByVal hInstance As Long, ByVal hResInfo As Long) As Long
Private Declare Function LockResource Lib "kernel32" (ByVal hResData 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 FreeResource Lib "kernel32" (ByVal hResData As Long) As Long
Private Const RT_ICON = 3&i = FindResource(App.hInstance, ResID, RT_ICON)          '搜索资源
If i > 0 Then 
iResInfo = LoadResource(App.hInstance, i)               '找到了,读取他
msgbox "这个资源的长度: " & SizeofResource(App.hInstance, i) & "字节"   '获取已找到的资源长度
AddressofRes = LockResource(iResInfo)                   '锁定这个资源,已便使用ReDim GetData(ResourceSize)                           
CopyMemory GetData(0), ByVal AddressofRes, ResourceSize '复制数据到数组 getdata
open 磁盘文件 for binary as #1
 put #1,,getdata
closeFreeResource AddressofRes                               '释放被锁定的资源
end if

Answer 6

这代码有错，不是 RT_ICON， 是 RT_GROUP_ICON ＝ 14得到的最终是一个图标组信息，然后再读才行，还比较麻烦lz加分吧，加到100吧  然后我考虑下，接分

Answer 7

能。显示自定义资源，代码如下：Option ExplicitPrivate Type GUID
    dwData1   As Long
    wData2   As Integer
    wData3   As Integer
    abData4(7)   As Byte
End TypePrivate Enum CBoolean
    CFalse = 0
    CTrue = 1
End EnumPrivate Const S_OK = 0
Private Const GMEM_MOVEABLE = &H2
Private Const sIID_IPicture = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
Private Declare Function GlobalAlloc Lib "kernel32 " (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32 " (ByVal hMem As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32 " Alias "RtlMoveMemory" (pDest As Any, _
                pSource As Any, ByVal dwLength As Long)
Private Declare Function GlobalUnlock Lib "kernel32 " (ByVal hMem As Long) As Long
Private Declare Function CreateStreamOnHGlobal Lib "ole32 " (ByVal hGlobal As Long, _
                ByVal fDeleteOnRelease As CBoolean, ppstm As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32 " (ByVal lpsz As Any, pclsid As GUID) As Long
Private Declare Function OleLoadPicture Lib "olepro32 " (pStream As Any, ByVal lSize As Long, _
                ByVal fRunmode As CBoolean, riid As GUID, ppvObj As Any) As LongPrivate Sub Form_Load()
   Image1.Picture = PictureFromBits(LoadResData(101, "CUSTOM"))
End SubPrivate Sub Command1_Click()
   Dim b() As Byte
   Dim PBag As New PropertyBag
   
   b = LoadResData(101, "CUSTOM")
   
   Open "c:\1.ico" For Binary As #1
   Put #1, 1, b
   Close #1
   MsgBox "OK,c:\1.ico"
    
End SubPublic Function PictureFromBits(abPic() As Byte) As IPicture
    Dim nLow         As Long
    Dim cbMem        As Long
    Dim hMem         As Long
    Dim lpMem        As Long
    Dim IID_IPicture As GUID
    Dim istm         As stdole.IUnknown
    Dim ipic         As IPicture
   
    On Error GoTo Out
    nLow = LBound(abPic)
    On Error GoTo 0
    cbMem = (UBound(abPic) - nLow) + 1
   
    hMem = GlobalAlloc(GMEM_MOVEABLE, cbMem)
    If hMem Then
        lpMem = GlobalLock(hMem)
        If lpMem Then
            MoveMemory ByVal lpMem, abPic(nLow), cbMem
            Call GlobalUnlock(hMem)
            If (CreateStreamOnHGlobal(hMem, CTrue, istm) = S_OK) Then
                If (CLSIDFromString(StrPtr(sIID_IPicture), IID_IPicture) = S_OK) Then
                    Call OleLoadPicture(ByVal ObjPtr(istm), cbMem, CFalse, IID_IPicture, PictureFromBits)
                   
                End If
            End If
        End If
    End If
           
Out:
End Function

Answer 8

Dim PBag As New PropertyBag 这句没用请删除。

Answer 9

非常感谢 chinaboyzyq 问题终于解决了.