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