浏览器

开发平台：

Visual Basic

ExtraIcon.bas：源码内容

							Attribute VB_Name = "mExtraIcon"
'---------------------------------------------------------------------------------------
' Module    : mExtraIcon
' DateTime  : 2005-3-16 00:23
' Author    : Lingll
' Purpose   : 导出icon
'---------------------------------------------------------------------------------------
Option Explicit
'Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Declare Function ExtractIconEx Lib "shell32.dll" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Long, phiconLarge As Long, phiconSmall As Long, ByVal nIcons As Long) As Long
'Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
'Private 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
'Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
'Private Const DI_NORMAL As Long = &H3
'Private Type ICONINFO
'    fIcon As Long
'    xHotspot As Long
'    yHotspot As Long
'    hbmMask As Long
'    hbmColor 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 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 Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Function ExtraIconVb(vFile$, vIndex&, Optional vIsSmall As Boolean = True) As Long
Dim tIcon&
If vIsSmall Then
    Call ExtractIconEx(vFile, vIndex, ByVal 0&, tIcon, 1)
Else
    Call ExtractIconEx(vFile, vIndex, tIcon, ByVal 0&, 1)
End If
ExtraIconVb = tIcon
End Function

						