Imports System.Runtime.InteropServices
Public Class Form1
Private Sub NumericUpDown1_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NumericUpDown1.ValueChanged
Change()
End Sub
Private Sub ComboBox1_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles ComboBox1.TextChanged
Change()
End Sub
Sub Change()
If loading Then
Exit Sub
End If
Dim ic As New ExtractIconEx(ComboBox1.Text, NumericUpDown1.Value)
PictureBox1.Image = ic.LargeIcon.ToBitmap
End Sub
Dim loading As Boolean = True
Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
loading = False
Change()
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
PictureBox1.Image.Save("c:\test.ico", Imaging.ImageFormat.Icon)'ここでファイルパスを指定します。一回やったら変えなければならない。
MsgBox("アイコンが保存されました", MsgBoxStyle.Information, "OKを押そう")
End Sub
End Class
Public Class ExtractIconEx
Private property_FilePath As String
Private property_IconIndex As Integer
Private property_Icon As Icon
Public Sub New(ByVal FilePath As String, ByVal IconIndex As Integer)
If (FilePath Is Nothing Or FilePath Like "") = False Then
property_Icon = Nothing
property_FilePath = FilePath
property_IconIndex = IconIndex
MakeIcon()
Else
Throw New ArgumentException("ファイルパスを指定してください")
End If
End Sub
Private Sub MakeIcon()
Try
Dim phiconLarge_ptr, phiconSmall_ptr As IntPtr
API.ExtractIconEx((property_FilePath), property_IconIndex, phiconLarge_ptr, phiconSmall_ptr, 1)
Try
If phiconLarge_ptr <> 0 Then
property_Icon = Icon.FromHandle(phiconLarge_ptr)
End If
Catch ex As Exception
API.DestroyIcon(phiconLarge_ptr)
End Try
Catch ex As Exception
End Try
End Sub
Public ReadOnly Property FilePath() As String
Get
Return property_FilePath
End Get
End Property
Public ReadOnly Property IconIndex() As Integer
Get
Return property_IconIndex
End Get
End Property
Public ReadOnly Property LargeIcon() As Icon
Get
Return property_Icon
End Get
End Property
Private Class API
Private Sub New()
End Sub
'ファイルパスとインデックスからアイコンを取得する関数
<DllImport("shell32.dll", EntryPoint:="ExtractIconExA", CharSet:=CharSet.Ansi, SetLastError:=True, ExactSpelling:=True)> _
Public Shared Function ExtractIconEx(<MarshalAs(UnmanagedType.VBByRefStr)> ByRef lpszFile As String, ByVal nIconIndex As Integer, _
ByRef phiconLarge As IntPtr, ByRef phiconSmall As IntPtr, ByVal nIcons As Integer) As Integer
End Function
'リソースを解放する関数
<DllImport("user32.dll", CharSet:=CharSet.Ansi, SetLastError:=True, ExactSpelling:=True)> _
Public Shared Function DestroyIcon(ByVal hIcon As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
End Function
End Class
End Class
