VB程序代码-得到EXE文件中图标
'得到EXE文件中的小图标而不用打开文件的例子
'稍加改进会是一个很有用的小工具
'Sample VB4/32-bit code to retrieve the regular (32x32) and
'small (16x16) icons from an .EXE file without starting the program.
'Extraction techniques using ExtractIcon only return the 32x32 icon.
'Note: If the .EXE does not include a small icon, the regular icon will be
'produced reduced to 16x16, making the function appear to have worked.
'This sample is hard-coded to look , which does have both
'icons.
'Developed by Don Bradner with the assistance of Karl Peterson when a
'particularly nasty GPF wouldn't go away.  Feedback welcome to the Visual
二年级下册数学期中
'Basic Programmer's Journal forum on Compuserve (GO VBPJFORUM), in the
'32-bit section.
Option Explicit
Private Const MAX_PATH = 260
Private Const SHGFI_ICON = &H100
Private Const SHGFI_SYSICONINDEX = &H4000                '  get system icon index
Private Const SHGFI_LARGEICON = &H0                      '  get large icon
Private Const SHGFI_SMALLICON = &H1                      '  get small icon
Private Const ILD_TRANSPARENT = &H1
Private Type SHFILEINFO 'Structure used by SHGetFileInfo
hIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * MAX_PATH
szTypeName As String * 80
End Type
Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long
Private Declare Function ImageList_Draw Lib "comctl32.dll" (ByVal himl&, ByVal i&, ByVal hDCDest&, ByVal x&, ByVal y&, ByVal flags&) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private shinfo As SHFILEINFO
Private WinPath As String
Private xPixels As Integer
Private yPixels As Integer
Private Sub Command1_Click()
Dim himl As Long
Dim lpzxExeName As String '.EXE file name to get icon from
Dim nRet As Long
Dim picLeft As Long
厉内荏的意思Dim picTop As Long
lpzxExeName = WinPath & "\" 'Use any other executable that might contain a small icon
himl = SHGetFileInfo(lpzxExeName, 0&, shinfo, Len(shinfo), SHGFI_SYSICONINDEX Or SHGFI_SMALLICON)
'----------------------------------------------------
'set the picture box up to receive the icon, centered
'----------------------------------------------------
picLeft = (Picture1.ScaleWidth / xPixels) / 2 - 8
picTop = (Picture1.ScaleHeight / yPixels) / 2 - 8
Picture1.Picture = LoadPicture() 'Clear any existing image
Picture1.AutoRedraw = True
赞颂老师的歌nRet = ImageList_Draw(himl, shinfo.iIcon, Picture1.hDC, picLeft, picTop, ILD_TRANSPARENT)
Picture1.Refresh
End Sub
Private Sub Command2_Click()
新年祝福语简短大方
Dim himl As Long
订火车票提前几天
Dim lpzxExeName As String '.EXE file name to get icon from
Dim nRet As Long
Dim picLe
ft As Long
Dim picTop As Long
lpzxExeName = WinPath & "\"
himl = SHGetFileInfo(lpzxExeName, 0&, shinfo, Len(shinfo), SHGFI_SYSICONINDEX Or SHGFI_LARGEICON)
'----------------------------------------------------
'set the picture box up to receive the icon, centered
'----------------------------------------------------
picLeft = (Picture1.ScaleWidth / xPixels) / 2 - 16tf卡修复
picTop = (Picture1.ScaleHeight / yPixels) / 2 - 16
Picture1.Picture = LoadPicture()
Picture1.AutoRedraw = True
nRet = ImageList_Draw(himl, shinfo.iIcon, Picture1.hDC, picLeft, picTop, ILD_TRANSPARENT)
Picture1.Refresh
End Sub
Private Sub Form_Load()
Dim Buffer As String
Dim nRet As Long
Buffer = Space(MAX_PATH)
nRet = GetWindowsDirectory(Buffer, Len(Buffer))
WinPath = Left(Buffer, nRet)
xPixels = Screen.TwipsPerPixelX
yPixels = Screen.TwipsPerPixelY
End Sub

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。