TreeViewにCドライブの中をツリー構造で入れるには?

解決


マグ  2004-10-22 20:05:56  No: 117140

TreeViewに指定フォルダーの最下層を表示させるプログラムを作っているのですが、
問題が起きて困っています。
ソースは

   Private Treekaisou As Treeview_kaisou
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        'コントロールの登録
        Treekaisou = New Treeview_kaisou(Me.TreeView1)
    End Sub
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        With FolderBrowserDialog1
            .SelectedPath = ""
            If .ShowDialog = DialogResult.Cancel Then
                Exit Sub
            End If
            'Treekaisou.RootPath(指定したフォルダーの階層を全て表示します。, _
            'セパレータ(分からない場合は"\"でいいです。))
            Treekaisou.RootPath(.SelectedPath, "\")
        End With

    End Sub

    Private Sub TreeView1_AfterSelect(ByVal sender As Object, ByVal e As System.Windows.Forms.TreeViewEventArgs) Handles TreeView1.AfterSelect
        'TreeViewで選んだ時にパスを取得
        Label1.Text = e.Node.FullPath
    End Sub
End Class
Public Class Treeview_kaisou
    Private treeview As treeview
    Public Sub New(ByVal TreeViewControl As treeview)
        treeview = TreeViewControl
    End Sub
    Public Sub RootPath(ByVal PATH As String, ByVal Separator As String)
        '重要かもしれないから、記載してください。
        treeview.PathSeparator = Separator
        If System.IO.Directory.Exists(PATH) Then
            Dim root As String = PATH
            treeview.BeginUpdate()
            Try
                Dim temp As TreeNode = treeview.Nodes.Add(root)
                GetDirFileList(root, temp)
                treeview.CollapseAll()
            Finally
                treeview.EndUpdate()
            End Try
        Else
            MessageBox.Show("フォルダーではありません。", "エラー")
        End If
    End Sub
    Private Sub GetDirFileList(ByVal SerchFolderPath As String, ByVal InputTreeviewNode As TreeNode)
        Dim TeigiFolderdirInfo As System.IO.DirectoryInfo = New System.IO.DirectoryInfo(SerchFolderPath)
        Dim Folderdirs() As System.IO.DirectoryInfo = TeigiFolderdirInfo.GetDirectories()
        Dim Folderrdir As System.IO.DirectoryInfo
        For Each Folderrdir In Folderdirs
            Dim temp As TreeNode = InputTreeviewNode.Nodes.Add(Folderrdir.Name)
            GetDirFileList(Folderrdir.FullName, temp)
        Next

        Dim files() As System.IO.FileInfo = TeigiFolderdirInfo.GetFiles()
        Dim file As System.IO.FileInfo
        For Each file In files
            InputTreeviewNode.Nodes.Add(file.Name)
        Next
    End Sub
End Class

のようになっていますが、
指定フォルダーをデスクトップにすると、エラーも出ずに成功するのですが、
Cドライブに指定すると、エラーが発生してしまいます。
エラー内容が、フォルダー名が書かれていて、そのフォルダー名の一部が見つかりませんでした。っという
エラー内容です。
このエラーについてどのようにソースを記述すれば、回避できるか教えてください。


raki  URL  2004-10-24 15:25:00  No: 117141

どこでエラーが起こっているかはわかりませんが、
ソースを見る限り以下の2行でしょう。
  Dim TeigiFolderdirInfo As System.IO.DirectoryInfo = New System.IO.DirectoryInfo(SerchFolderPath)
  Dim Folderdirs() As System.IO.DirectoryInfo = TeigiFolderdirInfo.GetDirectories()
の3行になりますが、これらをTry...Catch...Finally ステートメントに
入れ込んでやれば、エラーはキャッチできます。

C:\System Volume Information フォルダや破損しているフォルダに
アクセスしようとしてもエラーが発生しますので、
何かしらのエラーキャッチ処理は入れておくべきです。

また、ソースを見る限り、一気にツリーを作成しているようですが、
階層の深いフォルダや総サブフォルダ数の多いフォルダを指定すると、
ツリーの作成に時間がかかって応答なしになる可能性があります。

一応私のサイトにもフォルダツリーのサンプルは置いてあります。
どのようなツリーを作られるのかは知りませんが、
参考程度にどうぞ。
一応動的にノード作成をしているので、初回表示までが早く、
応答なしになる可能性は低いです。


マグ  2004-10-24 18:55:11  No: 117142

ありがとうございました。
Try...Catch...Finally ステートメントの動きが分かりました。

そして・・・・・
入れ込んだのですが、デスクトップを指定するぐらいなら大丈夫だったのですが、
Cドライブを指定した時、Try...Catch...Finally ステートメントでエラー
は防げたのですが、本当に応答しなくなりました。
これは、
処理方法を変えるしかないでしょうか?
サブルーチン内で再起処理を使っているのですが・・・・・

実は以前に参考程度にということで、ソースを見たのですが、

    Public Property hensuu() As String
        Get
            Return ○
        End Get
        Set(ByVal Value As String)
 
        End Set
    End Property

の構文の動きが分からなくって・・・・・(-_-;)

あと、私の目的は画面の色が32bitモードの時でも
フォルダーなど16ビットの時と同じように表示されるようにするため
作成しているのですが。
なかなかうまくいかないんです。


raki  URL  2004-10-25 20:45:03  No: 117143

>Cドライブを指定した時、本当に応答しなくなりました。
>処理方法を変えるしかないでしょうか?

変えるしかないですね。
起動時に指定パス以下の全てのフォルダを総なめするので、
時間がかかってしまいます。
単に「応答なし」を防ぐだけでしたら、DoEventsを入れることで
対処できますが、返ってくるまでの時間が多少長くなるだけで、
短くはなりません。

>Public Property hensuu() As String
>    Get
>        Return ○
>    End Get
>    Set(ByVal Value As String)
>
>    End Set
>End Property
はプロパティの宣言しています。
これが宣言されているクラスをABCとすると、使い方は
ABC.hensuu = "test"              ' Setステートメントが実行される
Dim aaa As String = ABC.hensuu   ' Getステートメントが実行される
となります。
プロパティ・メソッドについて勉強してください。

>あと、私の目的は画面の色が32bitモードの時でも
>フォルダーなど16ビットの時と同じように表示されるようにするため
>作成しているのですが。

ツリービューの各ノードに表示するアイコンイメージのことでしたら、
私のサンプルにある Icon.FromHandle の方法ではうまく描画されません。
ハンドルからPictureオブジェクトを作成するOLE系のDLLを利用するしか
無いのかもしれません。
実は私もVB6では簡単に出来たものの、.NETではまだ出来てなかったりします。
海外サイトもかなり漁ったのですが、未だもって・・・勉強不足ですね。


マグ  2004-10-26 18:13:27  No: 117144

>これが宣言されているクラスをABCとすると、使い方は
>ABC.hensuu = "test"              ' Setステートメントが実行される
>Dim aaa As String = ABC.hensuu   ' Getステートメントが実行される
>となります。
>プロパティ・メソッドについて勉強してください。

いろいろ試してみます。

報告は後にレスします。


マグ  2004-10-27 22:58:04  No: 117145

TreeViewの項目の左に表示させるアイコンで32ビットの画面でも正常に
透過(影の部分)を表示させようといろいろ試しているのですが、
できませんでした。

あと、ネットで

ハンドルからPictureオブジェクトを作成するOLE系のDLLを探しているのですが、
どこにあるか教えてください。
お願いします。

できれば、無料で・・・・・


raki  URL  2004-10-28 15:57:48  No: 117146

>TreeViewの項目の左に表示させるアイコンで32ビットの画面でも正常に
>透過(影の部分)を表示させようといろいろ試しているのですが、
>できませんでした。

先に書いたとおり、私が知りたいくらいなのですが、
OLE系のDLLについて、一言。

VB6では最初から参照設定されている
【OLE Automation】をVB.NETでも参照設定すれば、
一応は使えるようになります。
確かOffice製品に含まれているとかなんとか。
あまり気にしたことがなかったので分かりませんが、
Officeさえ入っていれば、あると思います。

で、これの使い方なのですが、
まず、VB6で話を進めると、
OleCreatePictureIndirectをDeclare宣言して、
引数にアイコンハンドルを格納した構造体を渡してやれば、
Pictureオブジェクトが帰ってきますので、ImageListにそのまま登録でOK。
サンプルも多々ありますので、詳しくは調べて下さい。

これを.NETで使用する場合、
OleCreatePictureIndirectの宣言はいいとして、
コールして得られるオブジェクトをImageListに登録する方法が
分かっていません。
OleCreatePictureIndirectの第四引数にIPicutreDispインターフェースの
変数を用意することまでは分かっているのですが
これをImageオブジェクトに変換できないんです。

OleCreatePictureIndirectをコールして得られるIPicutreDispそのものが
既に間違っているのかもしれないとも思いつつあります。

ぜひ成功させて、私にも教えて下さい。
お願いします。


マグ  2004-10-28 17:54:05  No: 117147

環境はVB.NET です。

あと、参照設定したのですが、EXEファイルと同フォルダーの所に
OLE AutomationのDLLが自動で追加されません。

操作している内容は
プロジェクト→参照の追加→COMタブ→OLE Automation 2.0 をダブルクリック→
OKをクリックしました。

DLLが追加されなくてもいいのでしょうか?

あと、できれば、

>OleCreatePictureIndirectの第四引数にIPicutreDispインターフェースの
>変数を用意することまでは分かっているのですが
>これをImageオブジェクトに変換できないんです。

>OleCreatePictureIndirectをコールして得られるIPicutreDispそのものが
>既に間違っているのかもしれないとも思いつつあります。

のソースを教えてください。

ついでに
>VB6で話を進めると、
>OleCreatePictureIndirectをDeclare宣言して、
>引数にアイコンハンドルを格納した構造体を渡してやれば、
>Pictureオブジェクトが帰ってきますので、ImageListにそのまま登録でOK。
>サンプルも多々ありますので、詳しくは調べて下さい。

のソースも教えてください。

API系をあまり使ったことがないので、一行も打てずに悪戦苦闘中です(TT)


raki  URL  2004-10-29 02:17:58  No: 117148

環境がVB.NETというのは、一番初めの貴方の書き込みのソースを見れば分かります。
なので、
>まず、VB6で話を進めると、
と前書きしておきました。

で、参照設定が成功していれば、
ソリューションエクスプローラの【参照設定】ノードの下に、
『stdole』が追加されているはずです。
DLLは同一フォルダにはコピーされてきません。
Side-by-Side配置で利用するDLLではない(従来型のDLL)なので。

VB.NET版でのソースについては、訳あって教えられません。
Win32API、COM、Class、Interfaceの概念を知らないとコードを見ても
分からないからというのが一点。
もう一点は、動くソースではないため、どこまであっていて、
どこが間違っているのか私でも分からなく、
そのソースを見て、変な先入観を持って欲しくないからです。
つまり、ここはこう記述すればいいんだ、と間違ったソースで間違った知識を
もって欲しくないということです。

VB6のソースについては、
http://www31.ocn.ne.jp/~heropa/vb214.htm
のページの一番下にある
ConvertIcon関数を参考にして下さい。
私もここを参考にさせて頂きました。


マグ  2004-10-29 21:05:22  No: 117149

分かりました。

VB6のソースをVB.NETに変えて見ようと思います。
分からない部分は根性で何とかなるとおもいます。・・・多分


マグ  2004-10-29 22:33:11  No: 117150

どうにもなりませんでした(TT)

難しすぎ & エラーの連発で・・・・・
断念しました。

rakiさんソースが完成したら、ぜひ、教えてください。
おねがいします。

最終手段です。
せこいからあまりやりたくなかったのですが・・・・・
TreeViewの背景色を黒にしてしまえば、
色が同化して見分けることが出来ないはずです。・・・・多分


raki  URL  2004-10-30 00:34:16  No: 117151

そんな1時間半ほどであきらめないで。(T T)
もっと挑戦して下さい。

ちなみに、そのサイトのVB6のサンプルは、
私がVB.NET版に修正及び改良して、自サイトにてサンプルとして
公開してあります。
もちろんただ単純にVB.NET版にしたのではなく、
アルゴリズムなどを参考にしただけなので、
ある意味別物のソースになってますが。

VB.NETからのユーザなのか、VB6からのユーザなのかは
知りませんが、まずはWin32APIの使い方から覚えられたほうがよろしいかと。
大分.NET Frameworkで行えるようにはなりましたが、
まだまだWin32APIに頼らなければいけない部分も多いです。

久しぶりにもう一度挑戦してみようと思います。
出来たらまた私のサイトで公開しますね。

あと、
>TreeViewの背景色を黒にしてしまえば、
ですが、やってみましたw
文字色も白に変えてみましたが、結構いい感じ。
黒地に白ということで、ある意味見やすい?
少々邪道ではありますが、面白い案ですね。


マグ  2004-10-30 04:46:49  No: 117152

では、32ビット画面でも、16ビット画面のときと同じようにアイコンが表示される
のを待っています。

>文字色も白に変えてみましたが、結構いい感じ。
>黒地に白ということで、ある意味見やすい?
>少々邪道ではありますが、面白い案ですね。

たしかに邪道と言われれば、邪道かもしれません。
ある意味・・・・・

でも、これもアイディアだと思います。・・・・多分


マグ  2004-11-09 20:20:30  No: 117153

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

        Next

        ListBox1.Items.Clear()

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

                Next

            End If

        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

        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のアイコンを表示するにはどのように記述を変えればいいでしょうか?


raki  URL  2004-11-10 00:08:30  No: 117154

上のソースでどのサイズのアイコンなら表示できるのですか?
ソースを見る限り、どのサイズのアイコンでも描画できるようですが。
アイコンのサイズと描画範囲のサイズの大小を判定している部分が
存在しますし。


マグ  2004-11-10 02:30:49  No: 117155

アイコンのサイズの大小を判断しているソースは

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

でしょうか?
そして、
 ' アイコンの最大表示サイズ
    Private Const maxIconWidth As Integer = 16
    Private Const maxIconHeight As Integer = 16
に書き換えたのですが、
16×16のサイズで表示はされたのですが、16×16のアイコンの形では
ないです。

で、念のため、rakiさんのFolderTreeClassに表示される
フォルダーアイコンの形を見比べましたら、
アイコンの形が違いました。

どこが原因でしょうか?


raki  URL  2004-11-10 03:13:35  No: 117156

> 16×16のサイズで表示はされたのですが、16×16のアイコンの形では
> ないです。
やはりそちらの意味でしたか。
分かってはいたのですが、御自分で原因に気づいて欲しかったので。

まず、私のサンプルと違う所は、アイコンハンドルを取得する部分。
APIの宣言を見れば一目瞭然だと思います。

そもそも、私の『FolderTreeClass』と
santamartaさんのサンプルでは、やっていることが全然違います。
アイコンの形が違うのは当たり前です。
何がしたいのですか?
『TreeViewにCドライブの中をツリー構造で入れる』
のではないのですか?

16×16のアイコンではないという事実から
取得しているアイコンが既に違う?⇒
アイコンを取得している部分を見比べる。
くらいはしてください。
現象から理由(原因)を予想し、その予想を解決していく努力をしなければ
上達はしません。
これを怠らなければ、いずれは問題が発生したと同時に
ほぼ的確な原因予測ができるようになります。

余談ですが、
santamartaさんのサンプルでは
Graphicsオブジェクトを使って自分で描画していますが、
GraphicsオブジェクトはGDI+をサポートしていますので、
32bitアイコンも正常に透過されて表示されます。
TreeViewの場合、描画をどのように行っているのかわかりませんが、
正常に透過されないのはここらへんが関係しているのかもしれません。

私のサンプルも制限付きではあるものの、
32bitアイコンの描画に対応させました。
いずれは自前で描画するようにして、この制限を無くすかもしれません。


マグ  2004-11-10 23:02:15  No: 117157

>16×16のアイコンではないという

この原因は多分ですけど、EXEファイルやDLLファイルからアイコンを取得するには
まず、APIのアイコンハンドルを取得する関数に問題があるかと思ったのですが、
APIはあまり、使わないため、皆無に等しすぎて、
16×16のアイコンハンドルを取得する方法がわからずに、質問したのです。

rakiさんのソースと見比べながら、ハンドル取得に関わっているソースを
見ていきます。

とりあえず、解決としておきます。
わからなければ、質問します。

まだ、TreeViewFolderBrowserを作るには先の話ですが・・・・・
プログラムでImageListに画像を入れるのと取り出す方法がわからない上
TreeViewにノードを追加するときにDoEventsを使っているため、
描画速度が非常に遅いし、
っということで現在、改善させなければ、いけないものが多いので、
完成まで、先の話になりそうな気がします。


raki  URL  2004-11-10 23:30:06  No: 117158

きつい言い方をしてしまい、申し訳ありませんでした。
一つ一つクリアしつつ、先を目指して下さい。

最後に一つだけヒントを。
SHGetFileInfo APIを調べて下さい。
SmallIcon, LargeIcon, OpenIcon, CloseIconを組み合わせて
アイコンハンドルを取得することが出来ます。

ここから先は御自身で。


マグ  2004-11-10 23:59:24  No: 117159

>SHGetFileInfo APIを調べて下さい。
>SmallIcon, LargeIcon, OpenIcon, CloseIconを組み合わせて
>アイコンハンドルを取得することが出来ます。

アドバイス、ありがとうございました。
調べてみます。


マグ  2004-11-11 17:25:01  No: 117160

なぜか  できません(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()

            Next

            ListBox1.Items.Clear()

            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

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

                Next

                ListBox1.Items.Clear()

                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

                Next

            End If

        End If

    End Sub
End Class


※返信する前に利用規約をご確認ください。




  


  このエントリーをはてなブックマークに追加