EXE・DLLからアイコンを取得する(T)          <TOP>


EXE・DLLファイルからアイコンを取り出します。

ExtractIcon アイコンを取得

DrawIcon アイコンを描画

GetDC デバイスコンテキストのハンドルを取得

ReleaseDC デバイスコンテキストを解放

 

アイコンを取得するファイルパスをエディットボックスに入力し『取得』ボタンをクリックします。

 

'================================================================
'= EXE・DLLからアイコンを取り出す
'=    (ExtractIcon.bas)
'================================================================
#include "Windows.bi"

' EXE・DLLからアイコンを取得
Declare Function Api_ExtractIcon& Lib "shell32" Alias "ExtractIconA" (ByVal hInst&, ByVal Path$, ByVal Index&)

' アイコンを描画
Declare Function Api_DrawIcon& Lib "user32" Alias "DrawIcon" (ByVal hDC&, ByVal x&, ByVal y&, ByVal exhIcon&)

' 指定されたウィンドウのクライアント領域または画面全体を表すディスプレイデバイスコンテキストのハンドルを取得
Declare Function Api_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&)

' デバイスコンテキストを解放
Declare Function Api_ReleaseDC& Lib "user32" Alias "ReleaseDC" (ByVal hWnd&, ByVal hDC&)

Var Shared Edit1 As Object
Var Shared Text1 As Object
Var Shared Text2 As Object
Var Shared Picture1 As Object
Var Shared Button1 As Object

Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14
Text1.Attach GetDlgItem("Text1") : Text1.SetFontSize 14
Text2.Attach GetDlgItem("Text2") : Text2.SetFontSize 14
Picture1.Attach GetDlgItem("Picture1")
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Edit1.SetFocus
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var hIcon As Long
    Var Ret As Long
    Var pDC As Long

    Picture1.cls
    pDC = Api_GetDC(Picture1.GethWnd)

    hIcon = Api_ExtractIcon(GethWnd, Edit1.GetWindowText, 0)

    If hIcon = 1 Then
        Text2.SetWindowText "EXE・DLLではありません"
        Exit Sub
    Else If hIcon = 0 Then
        Text2.SetWindowText "アイコンが存在しません"
        Exit Sub
    Else
        Ret = Api_DrawIcon(pDC, 0, 0, hIcon)
    End If

    If Ret <> 0 Then
        Text2.SetWindowText "成功!"
    Else
        Text2.SetWindowText "失敗!"
    End If

    Ret = Api_ReleaseDC(GethWnd, pDC)
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End