編集

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

なぜか  できません(TT)

ソースは下に記載しています。

'*****************************
'         Imports宣言
'*****************************

Imports System.IO
Imports System.Reflection
Imports System.Runtime.InteropServices

[Form1のクラス内に記載]

' アイコンの最大表示サイズ
    Private Const maxIconWidth As Integer = 32
    Private Const maxIconHeight As Integer = 32

' アイコン同士の表示間隔
    Private Const intervalIconX As Integer = 2
    Private Const intervalIconY As Integer = 2

'クラスファイルを参照する
    Dim cls As New EXE_and_DLL_Icon

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        ListBox1.Items.Clear()
        ListBox1.MultiColumn = True
        ListBox1.DrawMode = DrawMode.OwnerDrawFixed
        ListBox1.ColumnWidth = maxIconWidth + intervalIconX * 2
        ListBox1.ItemHeight = maxIconHeight + intervalIconY * 2

AddHandler ListBox1.DrawItem, AddressOf listBox1_DrawItem

PictureBox1.Width = maxIconWidth
        PictureBox1.Height = maxIconHeight
    End Sub

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim dialog As OpenFileDialog
        Dim file As String
        'Iconを格納する
        Dim icon As Icon

dialog = New OpenFileDialog

dialog.Filter = "*.exe|*.exe|*.dll|*.dll|*.ico|*.ico|*.*|*.*"
        dialog.FilterIndex = 0
        dialog.Multiselect = False

If dialog.ShowDialog(Me) = DialogResult.OK Then

' 以前のアイテムを削除
            For Each Icon In ListBox1.Items

Icon.Dispose()

ListBox1.BeginUpdate()
            Label1.Text = "ファイル: " + dialog.FileName

' アイコンを列挙する
            cls.EnumIcons(dialog.FileName, icon)
            ListBox1.Items.Add(icon)

ListBox1.EndUpdate()

End If
    End Sub

' リストボックスのアイテム描画イベント
    Private Sub listBox1_DrawItem(ByVal sender As Object, ByVal e As DrawItemEventArgs)

Dim icon As Icon = Nothing
        Dim listBox As ListBox = DirectCast(sender, ListBox)

' インデックスから描画対象のアイコンを取得
        If 0 <= e.Index Then icon = DirectCast(listBox.Items(e.Index), Icon)

' 背景を描画
        e.DrawBackground()

' アイコンを描画
        If Not icon Is Nothing Then

Dim x As Integer = e.Bounds.X + intervalIconX
            Dim y As Integer = e.Bounds.Y + intervalIconY
            Dim w As Integer = maxIconWidth + intervalIconX * 2
            Dim h As Integer = maxIconHeight + intervalIconY * 2

If icon.Width <= maxIconWidth AndAlso icon.Height <= maxIconHeight Then

' アイコンのサイズが描画すべきサイズより小さい場合
                e.Graphics.DrawIcon(icon, x, y)

Else

' アイコンのサイズが描画すべきサイズより大きい場合
                e.Graphics.InterpolationMode = Drawing.Drawing2D.InterpolationMode.Bicubic

e.Graphics.DrawIcon(icon, New Rectangle(x, y, w, h))

End If

' フォーカスの長方形を描画
        e.DrawFocusRectangle()

End Sub

Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Dim folder As New FolderBrowserDialog
        'Iconを格納する
        Dim icon As Icon
        With folder
            .SelectedPath = ""
            If .ShowDialog = DialogResult.OK Then

' 以前のアイテムを削除
                For Each Icon In ListBox1.Items

Icon.Dispose()

ListBox1.BeginUpdate()
                Label1.Text = "ファイル: " + folder.SelectedPath

' アイコンを列挙する
                cls.EnumIcons(folder.SelectedPath, icon)
                ListBox1.Items.Add(icon)

ListBox1.EndUpdate()

End If
        End With
    End Sub
    ' 選択されているアイコンが変わったとき
    Private Sub listBoxIcons_SelectedIndexChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles ListBox1.SelectedIndexChanged

If Not ListBox1.SelectedItem Is Nothing Then

' アイコンを描画
            Dim icon As Icon = DirectCast(ListBox1.SelectedItem, Icon)
            Dim g As Graphics

g = PictureBox1.CreateGraphics()

g.Clear(SystemColors.Control)

g.DrawIcon(icon, 0, 0)

g.Dispose()

End If

End Sub

[Form1のクラスの下に記載]

Public Class EXE_and_DLL_Icon

'Structure構造
    Private Structure SHFILEINFO
        Public hIcon As IntPtr
        Public iIcon As Integer
        Public dwAttributes As Integer
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=260)> _
        Public szDisplayName As String
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=80)> _
        Public szTypeName As String
    End Structure

'アイコンハンドラーを取得する関数
    Private Declare Ansi Function SHGetFileInfo Lib "shell32.dll" (ByVal pszPath As String, _
    ByVal dwFileAttributes As Integer, ByRef psfi As SHFILEINFO, ByVal cbFileInfo As Integer, _
    ByVal uFlags As Integer) As IntPtr

'Const宣言
    Private Const SHGFI_ICON = &H100
    Private Const SHGFI_SMALLICON = &H1
    Private Const SHGFI_LARGEICON = &H0

'Structure構造を参照
    Dim shinfo As SHFILEINFO = New SHFILEINFO

' ファイルに関連づけられたアイコンを取得するAPI関数
    <DllImport("shell32.dll", EntryPoint:="ExtractAssociatedIcon")> _
    Private Shared Function ExtractAssociatedIcon _
        (ByVal hInst As System.IntPtr, _
        <MarshalAs(UnmanagedType.LPStr)> ByVal lpIconPath As String, _
        ByRef lpiIcon As Integer) _
        As System.IntPtr
    End Function

' ファイルに含まれるアイコンを取得するAPI関数
    <DllImport("shell32.dll", EntryPoint:="ExtractIcon")> _
    Private Shared Function ExtractIcon _
        (ByVal hInst As System.IntPtr, _
         <MarshalAs(UnmanagedType.LPStr)> ByVal lpszExeFileName As String, _
         ByVal nIconIndex As Integer) _
         As System.IntPtr
    End Function

' ファイルに含まれるアイコンを列挙してリストボックスに追加する
    Public Sub EnumIcons(ByVal fileName As String, ByRef IconFile As System.Drawing.Icon)

Dim hInst As System.IntPtr = Marshal.GetHINSTANCE([Assembly].GetExecutingAssembly.GetModules()(0))
        Dim hIcon As System.IntPtr
        Dim numOfIcons As Integer
        Dim i As Integer

shinfo.szDisplayName = New String(Chr(0), 260)
        shinfo.szTypeName = New String(Chr(0), 80)

' ファイルに含まれるアイコンを列挙する
        If File.Exists(fileName) OrElse Directory.Exists(fileName) Then

' ファイルに含まれるアイコンの総数を取得
            hIcon = ExtractIcon(hInst, fileName, -1)

' 取得できなかった場合
            If hIcon.Equals(IntPtr.Zero) Then

' ファイルに関連付けられたアイコンを取得
                'hIcon = ExtractAssociatedIcon(hInst, fileName, 0)
                hIcon = SHGetFileInfo(fileName, 0, shinfo, Marshal.SizeOf(shinfo), _
                                SHGFI_ICON Or SHGFI_SMALLICON)

If Not hIcon.Equals(IntPtr.Zero) Then
                    'ListBox1.Items.Add(Drawing.Icon.FromHandle(hIcon))
                    IconFile = Drawing.Icon.FromHandle(hIcon)
                End If

Else

' アイコン数
                numOfIcons = hIcon.ToInt32()

' ファイルに含まれるすべてのアイコンを取得
                For i = 0 To numOfIcons - 1

hIcon = ExtractIcon(hInst, fileName, i)

If Not hIcon.Equals(IntPtr.Zero) Then
                        'ListBox1.Items.Add(Drawing.Icon.FromHandle(hIcon))
                        IconFile = Drawing.Icon.FromHandle(hIcon)
                    End If

End If

End Sub
End Class

TreeViewにCドライブの中をツリー構造で入れるには？ (ID:117160)