TreeViewにCドライブの中をツリー構造で入れるには？
解決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ドライブに指定すると、エラーが発生してしまいます。
エラー内容が、フォルダー名が書かれていて、そのフォルダー名の一部が見つかりませんでした。っという
エラー内容です。
このエラーについてどのようにソースを記述すれば、回避できるか教えてください。
どこでエラーが起こっているかはわかりませんが、
ソースを見る限り以下の２行でしょう。
Dim TeigiFolderdirInfo As System.IO.DirectoryInfo = New System.IO.DirectoryInfo(SerchFolderPath)
Dim Folderdirs() As System.IO.DirectoryInfo = TeigiFolderdirInfo.GetDirectories()
の３行になりますが、これらをTry...Catch...Finally ステートメントに
入れ込んでやれば、エラーはキャッチできます。
C:\System Volume Information フォルダや破損しているフォルダに
アクセスしようとしてもエラーが発生しますので、
何かしらのエラーキャッチ処理は入れておくべきです。
また、ソースを見る限り、一気にツリーを作成しているようですが、
階層の深いフォルダや総サブフォルダ数の多いフォルダを指定すると、
ツリーの作成に時間がかかって応答なしになる可能性があります。
一応私のサイトにもフォルダツリーのサンプルは置いてあります。
どのようなツリーを作られるのかは知りませんが、
参考程度にどうぞ。
一応動的にノード作成をしているので、初回表示までが早く、
応答なしになる可能性は低いです。
ありがとうございました。
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ビットの時と同じように表示されるようにするため
作成しているのですが。
なかなかうまくいかないんです。
>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ではまだ出来てなかったりします。
海外サイトもかなり漁ったのですが、未だもって・・・勉強不足ですね。
>これが宣言されているクラスをABCとすると、使い方は
>ABC.hensuu = "test" ' Setステートメントが実行される
>Dim aaa As String = ABC.hensuu ' Getステートメントが実行される
>となります。
>プロパティ・メソッドについて勉強してください。
いろいろ試してみます。
報告は後にレスします。
TreeViewの項目の左に表示させるアイコンで32ビットの画面でも正常に
透過（影の部分）を表示させようといろいろ試しているのですが、
できませんでした。
あと、ネットで
ハンドルからPictureオブジェクトを作成するOLE系のDLLを探しているのですが、
どこにあるか教えてください。
お願いします。
できれば、無料で・・・・・
>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そのものが
既に間違っているのかもしれないとも思いつつあります。
ぜひ成功させて、私にも教えて下さい。
お願いします。
環境は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)
環境が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関数を参考にして下さい。
私もここを参考にさせて頂きました。
分かりました。
VB6のソースをVB.NETに変えて見ようと思います。
分からない部分は根性で何とかなるとおもいます。・・・多分
どうにもなりませんでした(TT)
難しすぎ ＆ エラーの連発で・・・・・
断念しました。
rakiさんソースが完成したら、ぜひ、教えてください。
おねがいします。
最終手段です。
せこいからあまりやりたくなかったのですが・・・・・
TreeViewの背景色を黒にしてしまえば、
色が同化して見分けることが出来ないはずです。・・・・多分
そんな１時間半ほどであきらめないで。(T T)
もっと挑戦して下さい。
ちなみに、そのサイトのVB6のサンプルは、
私がVB.NET版に修正及び改良して、自サイトにてサンプルとして
公開してあります。
もちろんただ単純にVB.NET版にしたのではなく、
アルゴリズムなどを参考にしただけなので、
ある意味別物のソースになってますが。
VB.NETからのユーザなのか、VB6からのユーザなのかは
知りませんが、まずはWin32APIの使い方から覚えられたほうがよろしいかと。
大分.NET Frameworkで行えるようにはなりましたが、
まだまだWin32APIに頼らなければいけない部分も多いです。
久しぶりにもう一度挑戦してみようと思います。
出来たらまた私のサイトで公開しますね。
あと、
>TreeViewの背景色を黒にしてしまえば、
ですが、やってみましたｗ
文字色も白に変えてみましたが、結構いい感じ。
黒地に白ということで、ある意味見やすい？
少々邪道ではありますが、面白い案ですね。
では、32ビット画面でも、16ビット画面のときと同じようにアイコンが表示される
のを待っています。
>文字色も白に変えてみましたが、結構いい感じ。
>黒地に白ということで、ある意味見やすい？
>少々邪道ではありますが、面白い案ですね。
たしかに邪道と言われれば、邪道かもしれません。
ある意味・・・・・
でも、これもアイディアだと思います。・・・・多分
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のアイコンを表示するにはどのように記述を変えればいいでしょうか？
上のソースでどのサイズのアイコンなら表示できるのですか？
ソースを見る限り、どのサイズのアイコンでも描画できるようですが。
アイコンのサイズと描画範囲のサイズの大小を判定している部分が
存在しますし。
アイコンのサイズの大小を判断しているソースは
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に表示される
フォルダーアイコンの形を見比べましたら、
アイコンの形が違いました。
どこが原因でしょうか？
> 16×16のサイズで表示はされたのですが、16×16のアイコンの形では
> ないです。
やはりそちらの意味でしたか。
分かってはいたのですが、御自分で原因に気づいて欲しかったので。
まず、私のサンプルと違う所は、アイコンハンドルを取得する部分。
APIの宣言を見れば一目瞭然だと思います。
そもそも、私の『FolderTreeClass』と
santamartaさんのサンプルでは、やっていることが全然違います。
アイコンの形が違うのは当たり前です。
何がしたいのですか？
『TreeViewにCドライブの中をツリー構造で入れる』
のではないのですか？
16×16のアイコンではないという事実から
取得しているアイコンが既に違う？⇒
アイコンを取得している部分を見比べる。
くらいはしてください。
現象から理由（原因）を予想し、その予想を解決していく努力をしなければ
上達はしません。
これを怠らなければ、いずれは問題が発生したと同時に
ほぼ的確な原因予測ができるようになります。
余談ですが、
santamartaさんのサンプルでは
Graphicsオブジェクトを使って自分で描画していますが、
GraphicsオブジェクトはGDI+をサポートしていますので、
32bitアイコンも正常に透過されて表示されます。
TreeViewの場合、描画をどのように行っているのかわかりませんが、
正常に透過されないのはここらへんが関係しているのかもしれません。
私のサンプルも制限付きではあるものの、
32bitアイコンの描画に対応させました。
いずれは自前で描画するようにして、この制限を無くすかもしれません。
>16×16のアイコンではないという
この原因は多分ですけど、EXEファイルやDLLファイルからアイコンを取得するには
まず、APIのアイコンハンドルを取得する関数に問題があるかと思ったのですが、
APIはあまり、使わないため、皆無に等しすぎて、
16×16のアイコンハンドルを取得する方法がわからずに、質問したのです。
rakiさんのソースと見比べながら、ハンドル取得に関わっているソースを
見ていきます。
とりあえず、解決としておきます。
わからなければ、質問します。
まだ、TreeViewFolderBrowserを作るには先の話ですが・・・・・
プログラムでImageListに画像を入れるのと取り出す方法がわからない上
TreeViewにノードを追加するときにDoEventsを使っているため、
描画速度が非常に遅いし、
っということで現在、改善させなければ、いけないものが多いので、
完成まで、先の話になりそうな気がします。
きつい言い方をしてしまい、申し訳ありませんでした。
一つ一つクリアしつつ、先を目指して下さい。
最後に一つだけヒントを。
SHGetFileInfo APIを調べて下さい。
SmallIcon, LargeIcon, OpenIcon, CloseIconを組み合わせて
アイコンハンドルを取得することが出来ます。
ここから先は御自身で。
>SHGetFileInfo APIを調べて下さい。
>SmallIcon, LargeIcon, OpenIcon, CloseIconを組み合わせて
>アイコンハンドルを取得することが出来ます。
アドバイス、ありがとうございました。
調べてみます。
なぜか できません(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
| ツイート |  |