簡易エクスプローラーを作るには

簡易的なエクスプローラーを作ってみます。
キーワードは「SHGetFileInfo()関数」と「イメージリスト」です。
SHGetFileInfo()関数はファイル名とオプションを指定することで
ファイルに関する様々な情報を取得してくれます。
このSHGetFileInfo()関数のサンプルはサンプル55 - ファイルのアイコンを取得するにはで紹介しています。

では、簡易エクスプローラーの作り方を紹介します。

まずはイメージリストにアイコンを入れていきます。
イメージリストを作るにはImageList_Create()関数を使います。
あらかじめ、どの程度のイメージを追加するかを決めておきます。

VBのDir関数を使って指定のディレクトリにあるファイルをリストアップします。

そして、そのファイルのアイコンをSHGetFileInfo()関数を使って取得し
ImageList_Draw()関数を使って等間隔に描画します。

ここまででも、一応ファイルのリストアップができるのですが
ちょっと工夫を入れてマウスがアイコンの上に来たときに色が変わるようにします。
そのために、ImageList_Draw()関数で描画した位置を配列に記憶します。

次に、VBのフォーム上ではマウスが動くとForm_MouseMoveイベントが発生するので
そのときのマウスの位置を取得して、それがアイコンの配列のどこかに含まれるかどうかを調べます。

もし、どこかのアイコンの上なら、その位置のアイコンの色を変えて描画します。
そして、前回のアイコンの位置に普通のアイコンを描画します。


ここで説明してもわかりにくいと思うので、実際にサンプルをダウンロードしてみてください。

実行時の様子


Dim IconPos(40) As POINTAPI
Dim lpInitCtrls As tagINITCOMMONCONTROLSEX, hImgList As Long
Dim BeforeIconIndex As Long


Private Sub Command1_Click()
    Dim FileName As String, cnt As Long
    Dim rc As Long, psfi As SHFILEINFO
    Dim x As Long, y As Long
    
    'コモンコントロールの初期化
    Call InitCommonControlsEx(lpInitCtrls)
    
    
    DirName = Me.Text1.Text
    FileName = "(init)"
    
    cnt = 0
    x = -60
    y = 80
    Do While FileName <> "" And cnt < 40
        'EXEファイル名を取得
        If FileName = "(init)" Then FileName = Dir(DirName & "\*.exe") Else FileName = Dir
        If FileName <> "" Then
            'アイコン取得
            Call SHGetFileInfo(DirName & "\" & FileName, FILE_ATTRIBUTES_NORMAL, psfi, Len(psfi), SHGFI_ICON)
            'アイコンの追加
            rc = ImageList_ReplaceIcon(hImgList, -1, psfi.hIcon)
            '位置計算
            x = x + 100
            If x > Me.ScaleWidth Then x = 40: y = y + 80
            '描画
            IconPos(cnt).x = x
            IconPos(cnt).y = y
            Call ImageList_Draw(hImgList, rc, Me.hDC, x, y, ILD_NORMAL)
            'ファイル名の描画
            Me.CurrentX = x - 15
            Me.CurrentY = y + 35
            Me.Print FileName
            'インクリメント
            cnt = cnt + 1
        End If
    Loop
End Sub


Private Sub Form_Load()
    'イメージリストの作成(適当に余裕を持って30+予備10)
    hImgList = ImageList_Create(32, 32, ILC_COLOR32 Or ILC_MASK, 30, 10)
End Sub


Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    'アイコンが描画されている上に来たら、ブレンドする
    Dim pos_x As Long, pos_y As Long, lpPoint As POINTAPI
    
    'マウスカーソルの位置取得
    Call GetCursorPos(lpPoint)
    Call ScreenToClient(Me.hWnd, lpPoint)
    
    For i = 0 To 40
        pos_x = IconPos(i).x
        pos_y = IconPos(i).y
        If lpPoint.x >= pos_x And lpPoint.x <= pos_x + 32 And _
            lpPoint.y >= pos_y And lpPoint.y <= pos_y + 32 Then
            'マウスカーソルが上にある位置のアイコンをブレンド
            Call ImageList_Draw(hImgList, i, Me.hDC, pos_x, pos_y, ILD_BLEND25)
            
            If BeforeIconIndex <> i Then
                '前回の位置をノーマル描画
                pos_x = IconPos(BeforeIconIndex).x
                pos_y = IconPos(BeforeIconIndex).y
                Call ImageList_Draw(hImgList, BeforeIconIndex, Me.hDC, pos_x, pos_y, ILD_NORMAL)
                
                '今回の位置を記憶
                BeforeIconIndex = i
            End If
            Exit For
        End If
    Next
End Sub


Private Sub Form_Resize()
    Me.Line1(0).X2 = Me.ScaleWidth
    Me.Line1(1).X2 = Me.ScaleWidth
    Me.Cls
End Sub


Private Sub Form_Unload(Cancel As Integer)
    'イメージリストの破棄
    Call ImageList_Destroy(hImgList)
End Sub

ダウンロード