DrawIconVB
ファイルに関連付けられているアイコンを取得し、指定したデバイスコンテキストに描画する関数です。
実在するファイルのみならず、".bmp"
のように拡張子からアイコンを取得することも可能です。
'標準モジュールに記述します。 Option Explicit 'パスの最大長 Private Const MAX_PATH = 260 'ファイルオブジェクトに関する情報を定義する構造体 Private Type SHFILEINFOA hIcon As Long iIcon As Long dwAttributes As Long szDisplayName(MAX_PATH - 1) As Byte szTypeName(80 - 1) As Byte End Type 'ファイルシステムオブジェクトの情報を取得 Private Declare Function SHGetFileInfo Lib "Shell32" Alias "SHGetFileInfoA" _ (ByVal pszPath As String, _ ByVal dwFileAttributes As Long, _ psfi As SHFILEINFOA, _ ByVal cbFileInfo As Long, _ ByVal uFlags As Long) As Long 'SHGetFileInfo() API 関連の定数 Private Const SHGFI_ICON = &H100& Private Const SHGFI_LARGEICON = &H0& Private Const SHGFI_SMALLICON = &H1& Private Const SHGFI_USEFILEATTRIBUTES = &H10& 'アイコンの描画 Private Declare Function DrawIconEx Lib "user32" _ (ByVal hDC As Long, _ ByVal xLeft As Long, ByVal yTop As Long, _ ByVal hIcon As Long, _ ByVal cxWidth As Long, ByVal cyWidth As Long, _ ByVal istepIfAniCur As Long, _ ByVal hbrFlickerFreeDraw As Long, _ ByVal diFlags As Long) As Long 'DrawIcon, DrawIconEx() API 関連の定数 Private Const DI_NORMAL As Long = &H3 'アイコンの解放 Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long '取得したいアイコンサイズの指定(インテリセンス機能用) Public Enum ICONSIZE Size32x32 = SHGFI_LARGEICON '大きいアイコン Size16x16 = SHGFI_SMALLICON '小さいアイコン End Enum Public Sub DrawIconVB(hDC As Long, FilePath As String, icSize As ICONSIZE) '<機能> ' ファイル名もしくは拡張子から関連付けられているアイコンを取得し、 ' 指定したデバイスコンテキストに描画します '<引数> ' hDC : 描画を行うデバイスコンテキストハンドル ' 通常は Picture1,hDC などを指定する ' FilePath : ファイルのフルパス、もしくは ".bmp" のような拡張子を表す文字列 ' icSize : 取得したいアイコンのサイズ ( 32x32 or 16x16 ) Dim udtShellFileInfo As SHFILEINFOA 'ファイルに関する情報を取得 Call SHGetFileInfo(FilePath, 0&, udtShellFileInfo, _ Len(udtShellFileInfo), _ SHGFI_ICON Or icSize Or SHGFI_USEFILEATTRIBUTES) '引数で渡されたデバイスコンテキストに描画 Call DrawIconEx(hDC, 0, 0, udtShellFileInfo.hIcon, 0, 0, 0, 0, DI_NORMAL) 'アイコンの解放 Call DestroyIcon(udtShellFileInfo.hIcon) End Sub
実行例:
'フォームにボタンとピクチャーボックスを用意して、以下のプロシージャを記述します。 Private Sub Command1_Click() '拡張子 "bas" のアイコンを取得して Picture1 に描画します Call DrawIconVB(Picture1.hDC, ".bas", Size32x32) End Sub
実行画面