TabIndex        =   1
      Top             =   1140
      Width           =   2250
   End
   Begin VB.Image Image1 
      Height          =   345
      Left            =   7410
      Top             =   3120
      Visible         =   0   'False
      Width           =   345
   End
   Begin VB.Menu mnuBar 
      Caption         =   "文件(&F)"
      Index           =   0
      Begin VB.Menu mnuFile 
         Caption         =   "閱讀說明(&O)"
         Index           =   0
         Shortcut        =   ^O
      End
      Begin VB.Menu mnuFile 
         Caption         =   "-"
         Index           =   2
      End
      Begin VB.Menu mnuFile 
         Caption         =   "退出(&X)"
         Index           =   3
      End
   End
   Begin VB.Menu mnuBar 
      Caption         =   "幫助(&H)"
      Index           =   1
      Begin VB.Menu mnuHelp 
         Caption         =   "關于(&A)..."
      End
   End
End
Attribute VB_Name = "frmEnumRes"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人為我，我為人人
'枕善居漢化收藏整理
'發布日期：05/05/18
'描  述：在VB中使用32位色資源圖標文件(使用 Alpha 通道)
'網  站：http://www.mndsoft.com/
'e-mail：mnd@mndsoft.com
'OICQ  : 88382850
'****************************************************************************
'---------------------------------------------------------------------------------------
' 模塊      : frmEnumRes.frm
' 日期      : 03/04/2004 16.09
' 作者      : Giorgio Brausi (vbcorner@vbcorner.net)
' 工程      : EnumResource.vbp
' 標題      : 使用EXE/DLL中的圖表庫
' 描述      : 本程序示例了怎樣在WinXP下使用32位色深的圖標，以及使用可執行文件及DLL文件資源中的圖標
' 注釋      : 當我們看到很多漂亮的圖標，想在VB中的圖形控件中使用時，VB確返回一個錯誤"無效的圖像",
'             這才知道這些漂亮的圖標是帶有Alpha 通道透明的圖標，看到這么漂亮的圖標,不用豈不可惜，那
'             么，好，就讓我們來學習怎樣使用吧。
'             這個代碼支持如下格式及色深的圖標：
'               16x16 4bpp      16x16 16bpp     16x16 32bpp
'               32x32 4bpp      32x32 16bpp     32x32 32bpp
'               48x48 4bpp      48x48 16bpp     48x48 32bpp
'             在我們使用一個包含9個格式的圖標文件時，我們無法獲得錯誤，因為VB選擇了自身定義的32x32
'             16位色的格式，如果想使用真彩色，需要依賴系統。
'             所有，我們只有使用更多的API函數來解決這個問題。
'             注意：這個程序在WindowsXP下可以很好的顯示，但Win2K下不太理想
'
'---------------------------------------------------------------------------------------
Option Explicit

Dim sLibraryFile As String  '/ 圖標庫文件的路徑和文件名

Private Sub chkAllSizeFormat_Click()
    gbAllSizeFormat = chkAllSizeFormat.Value
    
    Dim i As Integer
    
    If gbAllSizeFormat Then
        For i = 0 To 3
            optSize(i).Value = False
            optType(i).Value = False
        Next i
    End If
    
End Sub

Private Sub cmdClose_Click()
    Unload Me
End Sub

Private Sub cmdLoadIcons_Click()

    If sLibraryFile = "" Then
        MsgBox "請從列表中選擇一個圖標庫文件!", vbInformation, "提示"
        Exit Sub
    End If
    
    If Not gbAllSizeFormat And Not IsOptionChecked() Then
        MsgBox "請首先選擇選擇一種尺寸和色深的圖標, 或者全部尺寸和格式的圖標!", vbExclamation, "提示"
        Exit Sub
    End If
    
    Msg "圖標加載中. 請稍候..."
    GetIconsFromLibrary sLibraryFile
    Msg "圖標加載完畢."
    Me.SetFocus
End Sub

Private Sub Form_Load()
    
    ' 缺省, 使用全部尺寸和格式的圖標
    chkAllSizeFormat.Value = 1
    
    ' 添加圖標庫文件路徑...
    List1.AddItem "XP_icons_16.dll"
    List1.AddItem "XP_icons_24.dll"
    List1.AddItem "XP_icons_48.dll"
    List1.AddItem "XP_icons_all.dll"
    
    ' 添加你系統中帶的包含有圖標的DLL和EXE
    List1.AddItem "C:\Windows\Explorer.exe"
    List1.AddItem "C:\Windows\System32\shell32.dll"
    List1.AddItem "C:\Windows\System32\moricons.dll"
    
    Msg "請從列表中選擇一個圖標庫文件, 然后單擊載入圖標按鈕."
End Sub

'處理列表框中圖標庫文件
Private Sub List1_Click()
Dim sPath As String

    If List1.ListIndex < 4 Then
        sPath = App.Path & "\DLL\" & List1.Text
    Else
        sPath = List1.Text
    End If
    
    ' 判斷是否存在
    If Dir(sPath) = "" Then
        MsgBox "加載的文件不存在!", vbCritical, "提示"
        On Error Resume Next
        List1.Selected(List1.Text) = False
        Exit Sub
    End If

    ' 返回文件路徑和名稱
    sLibraryFile = sPath
    Msg sPath
    
    cmdLoadIcons.Enabled = True
    
End Sub

Private Sub mnuFile_Click(Index As Integer)
Const FILE_OPEN = 0
Const FILE_SHOW = 1
Const FILE_EXIT = 3
    Select Case Index
        Case FILE_OPEN   '打開說明文件
            Shell "Notepad.exe " & App.Path & "\README.TXT", vbNormalFocus
        Case FILE_SHOW   '示例說明
            'frmSample.Show , Me
        Case FILE_EXIT
            Unload Me
    End Select
End Sub

'幫助菜單
Private Sub mnuHelp_Click()
    Dim s As String
        s = "在VB中使用32位色資源圖標文件(使用 Alpha 通道)" & vbCrLf
        s = s & "作者:Giorgio Brausi (aka GIBRA)" & vbCrLf & vbCrLf
        s = s & "枕善居漢化整理" & vbCrLf
        s = s & "http://www.Mndsoft.com" & vbCrLf & vbCrLf
        s = s & "假如發現錯誤或您做出更好的功能，請到枕善居留言!"
        s = s & "謝謝!"
        MsgBox s, vbInformation
        
End Sub

'圖標尺寸選擇
Private Sub optSize_Click(Index As Integer)
    
    Select Case Index
        Case 0
            giSize = 16
        Case 1
            giSize = 24
        Case 2
            giSize = 32
        Case 3
            giSize = 48
    End Select
    
    chkAllSizeFormat.Value = 0
    
End Sub

'圖標類型選擇
Private Sub optType_Click(Index As Integer)
    Select Case Index
        Case 0
            giColorDepth = 4
        Case 1
            giColorDepth = 16
        Case 2
            giColorDepth = 24
        Case 3
            giColorDepth = 32
    End Select
    
    chkAllSizeFormat.Value = 0
    
End Sub

'---------------------------------------------------------------------------------------
' 過程   : GetIconsFromLibrary
' 日期   : 04/04/2004 17.40
' 作者   : Giorgio Brausi
' 用途   : 從選擇的圖標庫文件中提取圖標, 并加載圖形下拉列表框(ImageCombo1)中
'---------------------------------------------------------------------------------------

Public Sub GetIconsFromLibrary(ByVal sLibraryFilePath As String)
    Dim i As Integer
    Dim tRes As ResType, iCount As Integer
        
    ghmodule = LoadLibraryEx(sLibraryFilePath, 0, DONT_RESOLVE_DLL_REFERENCES)

    If ghmodule = 0 Then
        MsgBox "無效的圖標庫文件.", vbCritical, "錯誤"
        Exit Sub
    End If
    
    ' 清空
    ImageCombo1.ImageList = Nothing
    ImageCombo1.ComboItems.Clear
    Toolbar1.ImageList = Nothing
    ImageList1.ListImages.Clear
    List2.Clear
    StatusBar1.Panels(2).Text = ""
    
    ' 提取圖標可能會需要一些時間
    Screen.MousePointer = vbHourglass
    For tRes = RT_FIRST To RT_LAST
        DoEvents
        EnumResourceNames ghmodule, tRes, AddressOf EnumResNameProc, 0
    Next
    FreeLibrary ghmodule
    
    Screen.MousePointer = vbNormal
    
    If ImageList1.ListImages.Count = 0 Then
        StatusBar1.Panels(2).Text = "沒有圖標"
        Exit Sub
    End If
    
    ' 加載圖形下拉列表框(ImageCombo1)中
    ImageCombo1.ImageList = ImageList1
    For i = 1 To ImageList1.ListImages.Count
        ImageCombo1.ComboItems.Add , , "icon " & ImageList1.ListImages(i).Key, ImageList1.ListImages(i).Index
    Next i
      
    ' ... 加載到 Toolbar1
    Toolbar1.ImageList = ImageList1
    ' 獲取圖標最大編號
    iCount = IIf(Toolbar1.Buttons.Count > ImageList1.ListImages.Count, ImageList1.ListImages.Count, Toolbar1.Buttons.Count)

    For i = 1 To iCount
        Toolbar1.Buttons(i).Image = ImageList1.ListImages(i).Index
    Next i
    
    ' 顯示圖標庫圖標個數
    StatusBar1.Panels(2).Text = ImageList1.ListImages.Count & " 個圖標."
    
  
End Sub

'---------------------------------------------------------------------------------------
' 過程   : Msg
' 日期   : 04/04/2004 17.44
' 作者   : Giorgio Brausi
' 用途   : 在狀態欄中顯示信息
'---------------------------------------------------------------------------------------
Public Sub Msg(ByVal s As String)
    StatusBar1.Panels(1).Text = s
End Sub

'---------------------------------------------------------------------------------------
' 過程   : IsOptionChecked
' 日期   : 04/04/2004 11.09
' 作者   : Giorgio Brausi
' 用途   : 檢查尺寸和色深是否選擇
' 描述   : 如果開始提取圖標的詳細尺寸和色深，需要這個值
' 注釋   :
'---------------------------------------------------------------------------------------

Public Function IsOptionChecked() As Boolean
Dim i As Integer, bSize As Boolean, bType As Boolean

    For i = 0 To 3
        If optSize(i) Then
            bSize = True
            Exit For
        End If
    Next i
    
    For i = 0 To 3
        If optType(i) Then
            bType = True
            Exit For
        End If
    Next i
    IsOptionChecked = bSize And bType
    
End Function