我这有个例子支持ntPrivate Const VER_PLATFORM_WIN32_NT = 2
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function SHChangeIconDialogA Lib "shell32" Alias "#62" (ByVal hOwner As Long, ByVal szFilename As String, ByVal Reserved As Long, lpIconIndex As Long) As Long
Private Declare Function SHChangeIconDialogW Lib "shell32" Alias "#62" (ByVal hOwner As Long, ByVal szFilename As Long, ByVal Reserved As Long, lpIconIndex As Long) As Long
'Detect if the program is running under Windows NT
Public Function IsWinNT() As Boolean
Dim myOS As OSVERSIONINFO
myOS.dwOSVersionInfoSize = Len(myOS)
GetVersionEx myOS
IsWinNT = (myOS.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function
Public Function chooseIcon(ByRef strFile As String, ByRef lngIconNum As Long) As Boolean
Dim str1 As String * 260
Dim lng1 As Long ' Dummy?
Dim lngResult As Long
str1 = strFile & vbNullChar
'is this code executed under WinNT?
If IsWinNT Then
'if we're in WinNT, we have to call the Unicode version of the function
lngResult = SHChangeIconDialogW(Me.hWnd, StrPtr(str1), lng1, lngIconNum)
Else
'if we're in Win9x, we have to call the ANSI version of the function
lngResult = SHChangeIconDialogA(Me.hWnd, str1, lng1, lngIconNum)
End If
'The function itself returns 0 (failed) or 1 (success)
'str1 is adapted to the selected filename
chooseIcon = (lngResult <> 0)
If chooseIcon Then
strFile = Left$(str1, InStr(1, str1, vbNullChar, vbBinaryCompare) - 1)
End If
End Function
Private Sub Form_Load()
'KPD-Team 1999, 2001
'URL: http://www.allapi.net/
'E-Mail: [email protected]
'additional coding by Willem Bogaerts, [email protected]
chooseIcon "shell32.dll", 0
End Sub
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function SHChangeIconDialogA Lib "shell32" Alias "#62" (ByVal hOwner As Long, ByVal szFilename As String, ByVal Reserved As Long, lpIconIndex As Long) As Long
Private Declare Function SHChangeIconDialogW Lib "shell32" Alias "#62" (ByVal hOwner As Long, ByVal szFilename As Long, ByVal Reserved As Long, lpIconIndex As Long) As Long
'Detect if the program is running under Windows NT
Public Function IsWinNT() As Boolean
Dim myOS As OSVERSIONINFO
myOS.dwOSVersionInfoSize = Len(myOS)
GetVersionEx myOS
IsWinNT = (myOS.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function
Public Function chooseIcon(ByRef strFile As String, ByRef lngIconNum As Long) As Boolean
Dim str1 As String * 260
Dim lng1 As Long ' Dummy?
Dim lngResult As Long
str1 = strFile & vbNullChar
'is this code executed under WinNT?
If IsWinNT Then
'if we're in WinNT, we have to call the Unicode version of the function
lngResult = SHChangeIconDialogW(Me.hWnd, StrPtr(str1), lng1, lngIconNum)
Else
'if we're in Win9x, we have to call the ANSI version of the function
lngResult = SHChangeIconDialogA(Me.hWnd, str1, lng1, lngIconNum)
End If
'The function itself returns 0 (failed) or 1 (success)
'str1 is adapted to the selected filename
chooseIcon = (lngResult <> 0)
If chooseIcon Then
strFile = Left$(str1, InStr(1, str1, vbNullChar, vbBinaryCompare) - 1)
End If
End Function
Private Sub Form_Load()
'KPD-Team 1999, 2001
'URL: http://www.allapi.net/
'E-Mail: [email protected]
'additional coding by Willem Bogaerts, [email protected]
chooseIcon "shell32.dll", 0
End Sub
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货