編集

名前

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

本文

32ビットでも正常に透過させることができました。

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

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

' ファイルに関連づけられたアイコンを取得する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

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

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

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

dialog = New OpenFileDialog

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

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

Label1.Text = "ファイル: " + dialog.FileName

' アイコンを列挙する
            EnumIcons(dialog.FileName)

End If
    End Sub
    ' ファイルに含まれるアイコンを列挙してリストボックスに追加する
    Private Sub EnumIcons(ByVal fileName As String)

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

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

icon.Dispose()

ListBox1.BeginUpdate()

' ファイルに含まれるアイコンを列挙する
        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)

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

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))

End If

ListBox1.EndUpdate()

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
        With folder
            .SelectedPath = ""
            If .ShowDialog = DialogResult.OK Then
                Label1.Text = "ファイル: " + folder.SelectedPath

' アイコンを列挙する
                EnumIcons(folder.SelectedPath)

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

そして、問題が・・・・・
16×16のアイコンを表示するにはどのように記述を変えればいいでしょうか？

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