SHChangeIconDialog

[GM]

Код: Выделить всё

Private 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: KPDTeam@Allapi.net
    'additional coding by Willem Bogaerts, w-p@dds.nl
    chooseIcon "shell32.dll", 0
End Sub


lngResult = SHChangeIconDialogW(Me.hWnd, StrPtr(str1), lng1, lngIconNum)

Проблема в том что в НТ системах str1 не возращае путь к значку. а лиш предыдущие значение.

[alibek]

В NT используется Unicode, проблема наверняка в этом. Используй StrConv.

[tyomitch]

Вот так работает:

Код: Выделить всё

Public Function chooseIcon(ByRef strFile As String, ByRef lngIconNum As Long) As Boolean
    Dim str1 As String
    Dim lng1 As Long ' NOT Dummy!
    Dim lngResult As Long
    str1 = strFile & String(260, 0): lng1 = 260
    '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


У строк фиксированной длины нельзя взять StrPtr. Это фишка такая


2alibek: у него эта особенность WinNT не только учтена, но и прокомментирована Дело было не в ней.

[GM]

Дык и я что похожое делал:

Код: Выделить всё

str1 = strFile & String(260 - len(strfile), vbNullChar)


Только я не знал что у строк фиксированой длины нельзя взять strptr.

[tyomitch]

Дык и я что похожое делал:

Код: Выделить всё

str1 = strFile & String(260 - len(strfile), vbNullChar)


Только я не знал что у строк фиксированой длины нельзя взять strptr.

У тебя ещё был Dummy, который вовсе не Dummy...

[alibek]

tyomitch, посыпаю волосы пеплом
Код даже не читал, взгляд выхватил "НТ системах" и "StrPtr", а мозг автоматом выдал заключение