1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
| Option Explicit
Private Declare Function PrivateExtractIcons Lib "user32" _ Alias "PrivateExtractIconsA" (ByVal sFile As String, ByVal nIconIndex As Long, _ ByVal cxIcon As Long, ByVal cyIcon As Long, ByVal phicon As Long, piconid As Long, _ ByVal nIcons As Long, ByVal flags As Long) As Long
'精华!这个函数一般是找不到的!有了这个,不用使用 LoadIcon、ExtractIcon、ExtractIconEx 了 Public Declare Function DrawIconEx Lib "user32" (ByVal hDC As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long Public Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long Public Declare Function GetIconInfo Lib "user32" (ByVal hIcon As Long, piconinfo As ICONINFO) As Long
Public Type ICONINFO fIcon As Long xHotspot As Long yHotspot As Long hbmMask As Long hbmColor As Long End Type
Public Const DI_NORMAL = &H3& Public Const LR_DEFAULTCOLOR = &H0& Public Const LR_DEFAULTSIZE = &H40
'封装之后的函数 Public Sub DrawIconToDC(ByVal PE_Icon As String, ByVal IconIndex As Long, ByVal hDC As Long, cX As Long, cY As Long, X As Long, Y As Long) 'PE_Icon 是 PE 文件(*.exe;*.dll;*.ocx;*.vxd;*.cpl 等等)或图标文件的文件名 'IconIndex 是图标的索引,以绝对值为准(如 0=0,-1=1) 'hDC 是目标 DC(Device Context,设备上下文)。可以使用 GetDC(hWindow) 获取一个窗口的 DC。 'cX 是欲加载的图标宽度 'cY 是欲加载的图标高度 'X 是绘制在目标上的 X 坐标(模式由 hDC 所指的设备所决定) 'Y 是绘制在目标上的 Y 坐标(模式由 hDC 所指的设备所决定) Dim lRet As Long Dim phicon As Long Dim picon As Long 'Dim cX As Long '欲加载的图标宽度 'Dim cY As Long '欲加载的图标高度 'Windows 会自动根据 cX 和 cY 的值决定加载哪个图标(若有多种格式) '如,存在 48×48、32×32 图标时,cX=36, cY=32 将加载 48×48 的图标, '并按照 36×32 的大小输出
'MsgBox PrivateExtractIcons("C:\Windows\System32\imageres.dll", -1, 0, 0, 0, picon, 1, 0) lRet = PrivateExtractIcons(PE_Icon, 2, cX, cY, VarPtr(phicon), picon, 1, LR_DEFAULTCOLOR) 'Or LR_DEFAULTSIZE) 'MsgBox "Return val:" & lRet, vbInformation 'Dim pII As ICONINFO 'GetIconInfo phicon, pII DrawIconEx Me.hDC, X, Y, phicon, 0, 0, 0, 0, DI_NORMAL 'Print "cX:" & pII.xHotspot * 2 & vbCrLf & "cY:" & pII.yHotspot * 2 'MsgBox picon '必须销毁图标,因为 Windows 不会帮你 DestroyIcon phicon End Sub
|