回 帖 发 新 帖 刷新版面

主题:[讨论]如何用vb获取应用程序图标

我想作一个小程序,需要一个获取程序图标的功能,现在我每次获取都把这个程序所有的图标都取出来,不能控制,谁能帮帮我啊!一下是我写的代码:
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
Private Sub Command1_Click()
Dim i As Long
Dim j As Long
Dim k As Long
Dim blgzz As Long
Dim filename As String
filename = "此处添所要图标程序的路径"
blgzz = ExtractIcon(App.hInstance, filename, -1)
If blgzz > 0 Then
Do
j = ExtractIcon(App.hInstance, filename, i)
k = DrawIcon(Picture1.hdc, 10 + 40 * i, 10, j)
i = i + 1
If i = blgzz Then Exit Sub
Loop
Else
j = MsgBox(filename & "文件中没有图标!")
End If
End Sub

回复列表 (共2个回复)

沙发

Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Sub RtlMoveMemory Lib "KERNEL32" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Private Sub Command1_Click()
    
  On Error Resume Next
    Dim s_hwnd&, i&, s_path$, pid&
    
    s_hwnd& = FindWindow(vbNullString, "Form1") 'or
    's_hwnd& = FindWindow("ThunderRT6FormDC", vbNullString)
    
    i = GetWindowThreadProcessId(s_hwnd, pid)    'Pid
    s_path = GetProcessPathByProcessID(pid)      '获取程序全路径
    'i = ExtractIcon(s_hwnd&, s_path, -1)        '取图标数量
    i = ExtractIcon(s_hwnd&, s_path, 0)
    Me.Print
    Me.AutoRedraw = -1
    DrawIcon Me.hdc, 25, 25, i
    Me.Refresh
End Sub
Private Function GetProcessPathByProcessID(pid As Long) As String
     On Error GoTo Z
     Dim cbNeeded As Long
     Dim szBuf(1 To 250) As Long
     Dim Ret As Long
     Dim szPathName As String
     Dim nSize As Long
     Dim hProcess As Long
     hProcess = OpenProcess(&H400 Or &H10, 0, pid)
     If hProcess <> 0 Then
        Ret = EnumProcessModules(hProcess, szBuf(1), 250, cbNeeded)
        If Ret <> 0 Then
            szPathName = Space(260)
            nSize = 500
            Ret = GetModuleFileNameExA(hProcess, szBuf(1), szPathName, nSize)
            GetProcessPathByProcessID = Left(szPathName, Ret)
        End If
     End If

     Ret = CloseHandle(hProcess)
     If GetProcessPathByProcessID = "" Then
        GetProcessPathByProcessID = "SYSTEM  "
     End If
Z:
End Function

板凳

Option Explicit

Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long

Private Sub Form_Load()
    Me.OLEDropMode = 1
End Sub

Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Cls
    Dim nIndex%, nCounter%, nIconCount&, i&
    With Data
        If .GetFormat(15) = True Then
            nCounter = .Files.Count
            For nIndex = 1 To nCounter
                Debug.Print Data.Files(nIndex)
                nIconCount = ExtractIcon(App.hInstance, Data.Files(nIndex), -1)
                If nIconCount > 0 Then
                    For i = 0 To nIconCount - 1 Step 1
                        Dim hIcon&
                        hIcon& = ExtractIcon(App.hInstance, Data.Files(nIndex), i)
                        DrawIcon Me.hdc, 10 + 40 * i, 10 + 40 * (nIndex - 1), hIcon&
                        DestroyIcon hIcon&
                    Next
                Else
                    Debug.Print "没有图标! "; Data.Files(nIndex)
                    Print "没有图标! "; Data.Files(nIndex)
                End If
            Next
        End If
    End With
End Sub

我来回复

您尚未登录,请登录后再回复。点此登录或注册