vb 关于提取图标问题

来源：百度知道 编辑：UC知道 时间：2024/06/19 00:29:47
代码：
Private Declare Function ExtractIcon& Lib "shell32.dll" Alias "ExtractIconA" _
(ByVal hInst As Long, ByVal lpszExeFilename As String, ByVal nIconIndex As Long)
Private Declare Function DrawIcon$ Lib "user32.dll" _
(ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) '提取图标

Private Sub Command1_Click()
CommonDialog1.Filter = "游戏主程序(*.exe)|*.exe"
CommonDialog1.ShowOpen
If CommonDialog1.CancelError Then Exit Sub
If CommonDialog1.FileName = "" Then Exit Sub
Text1.Text = CommonDialog1.FileName
Text1.Locked = True '输出程序绝对地址

Dim x As Long
Dim mycal As Integer
myval = ExtractIcon(hInst, Text1.Text, -1)
Picture1.Cls
hIcon = ExtractIcon(0, Text1.Text, 0)
x = DrawIcon(Picture1.hDC, 0, 0, hIcon)
On Error Resume Next
SavePicture Picture1.Picture, Replace(Text1.Text, &q

'把DrawIcon$改成DrawIcon 即可
'改完后的代码如下：

Private Declare Function ExtractIcon& Lib "shell32.dll" Alias "ExtractIconA" _
(ByVal hInst As Long, ByVal lpszExeFilename As String, ByVal nIconIndex As Long)
Private Declare Function DrawIcon Lib "user32.dll" _
(ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long '提取图标

Private Sub Command1_Click()
CommonDialog1.Filter = "游戏主程序(*.exe)|*.exe"
CommonDialog1.ShowOpen
If CommonDialog1.CancelError Then Exit Sub
If CommonDialog1.FileName = "" Then Exit Sub
Text1.Text = CommonDialog1.FileName
Text1.Locked = True '输出程序绝对地址

Dim x As Long
Dim mycal As Integer

myval = ExtractIcon(hInst, Text1.Text, -1)

Picture1.Cls

hIcon = ExtractIcon(0, Text1.Text, 0)

x = DrawIcon(Picture1.hDC, 0, 0, hIcon)
On Error Resume Next
SavePicture