ab.com コミュニティ

If SHChangeIconDialogA(hwnd, str, MAX_PATH, Index) <> FALSE Then

If SHChangeIconDialogA(hwnd, VarPtr(str[0]), MAX_PATH, Index) <> FALSE Then

このままだとパスが出なくて、(WindowsMe)
ChangeIconDialogの中の
[code]If SHChangeIconDialogA(hwnd, str, MAX_PATH, Index) <> FALSE Then[/code]
を、
[code]If SHChangeIconDialogA(hwnd, VarPtr(str[0]), MAX_PATH, Index) <> FALSE Then[/code]
に換えたらうまくいきました。

Typedef	PChangeIconDialogW = *Function(hWnd As HWND, lpszFilename As *Word, Reserved As Long, ByRef lpIconIndex As Long) As Long
Typedef	PChangeIconDialogA = *Function(hWnd As HWND, lpszFilename As String, Reserved As Long, ByRef lpIconIndex As Long) As Long

[code]
Typedef PChangeIconDialogW = *Function(hWnd As HWND, lpszFilename As *Word, Reserved As Long, ByRef lpIconIndex As Long) As Long
Typedef PChangeIconDialogA = *Function(hWnd As HWND, lpszFilename As String, Reserved As Long, ByRef lpIconIndex As Long) As Long
[/code]
を追加したらなんとか出来ました。
ありがとうございました。

これでOKなのか、やや不安がありますが…

回答ありがとうございます。

PChangeIconDialogW
や
PChangeIconDialogA
が無効な識別子と出るのですが、
どうすればよいのでしょうか？

Dim Index As Long
Dim strPath As String
strPath = ChangeIconDialog(hMainWnd, Index)
MessageBox(0, strPath, Str$(Index), MB_OK)

Declare Function lstrlenW Lib "kernel32" (pwsz As *WCHAR) As Long

Function ChangeIconDialog(hwnd As HWND, ByRef Index As Long) As String
	If VersionInfo.dwPlatformId <> VER_PLATFORM_WIN32_WINDOWS Then
		Dim wstr[ELM(MAX_PATH)] As WCHAR
		Dim SHChangeIconDialogW As PChangeIconDialogW
		SHChangeIconDialogW = GetProcAddress(hShell, 62 As *Byte) As PChangeIconDialogW
		If SHChangeIconDialogW(hwnd, wstr, MAX_PATH, Index) <> FALSE Then
			ChangeIconDialog = ToMBString(wstr)
		End If
	Else
		Dim str[ELM(MAX_PATH)] As Byte
		Dim SHChangeIconDialogA As PChangeIconDialogA
		SHChangeIconDialogA = GetProcAddress(hShell, 62 As *Byte) As PChangeIconDialogA
		If SHChangeIconDialogA(hwnd, str, MAX_PATH, Index) <> FALSE Then
			ChangeIconDialog = str
		End If
	End If
End Function

Function ToMBString(pwsz As *WCHAR) As String
	Dim lenW As Long
	lenW = lstrlenW(pwsz)
	Dim lenA As Long
	lenA = WideCharToMultiByte(CP_ACP, 0, pwsz, lenW, 0, 0, 0, 0)
	ToMBString = ZeroString(lenA)
	WideCharToMultiByte(CP_ACP, 0, pwsz, lenW, StrPtr(ToMBString), lenA, 0, 0)
End Function

Dim VersionInfo As OSVERSIONINFO
Dim hShell As HINSTANCE

VersionInfo.dwOSVersionInfoSize = Len(VersionInfo)
GetVersionEx(VersionInfo)

hShell = LoadLibrary("Shell32") As HINSTANCE

FreeLibrary(hShell As DWord)

まず、ByRef lpszFilename As *ByteのByRefは不要です。
strはポインタですがどこも指していないのでまずいです。
また，この関数は非公開なので，9xではマルチバイト文字，NTではユニコード文字を使用するのでその区別も必要です。

興味があったので自分なりにどうにかしてみました。
それらをChangeIconDialogという関数を作り，そこに押し込めてみました。
このように使えます。
[code]Dim Index As Long
Dim strPath As String
strPath = ChangeIconDialog(hMainWnd, Index)
MessageBox(0, strPath, Str$(Index), MB_OK)[/code]

ChangeIconDialog関数の定義です。プロジェクト内の適当なところにコピーしてください。
[hide][code]Declare Function lstrlenW Lib "kernel32" (pwsz As *WCHAR) As Long

Function ChangeIconDialog(hwnd As HWND, ByRef Index As Long) As String
If VersionInfo.dwPlatformId <> VER_PLATFORM_WIN32_WINDOWS Then
Dim wstr[ELM(MAX_PATH)] As WCHAR
Dim SHChangeIconDialogW As PChangeIconDialogW
SHChangeIconDialogW = GetProcAddress(hShell, 62 As *Byte) As PChangeIconDialogW
If SHChangeIconDialogW(hwnd, wstr, MAX_PATH, Index) <> FALSE Then
ChangeIconDialog = ToMBString(wstr)
End If
Else
Dim str[ELM(MAX_PATH)] As Byte
Dim SHChangeIconDialogA As PChangeIconDialogA
SHChangeIconDialogA = GetProcAddress(hShell, 62 As *Byte) As PChangeIconDialogA
If SHChangeIconDialogA(hwnd, str, MAX_PATH, Index) <> FALSE Then
ChangeIconDialog = str
End If
End If
End Function

Function ToMBString(pwsz As *WCHAR) As String
Dim lenW As Long
lenW = lstrlenW(pwsz)
Dim lenA As Long
lenA = WideCharToMultiByte(CP_ACP, 0, pwsz, lenW, 0, 0, 0, 0)
ToMBString = ZeroString(lenA)
WideCharToMultiByte(CP_ACP, 0, pwsz, lenW, StrPtr(ToMBString), lenA, 0, 0)
End Function[/code]
shell32.dllは毎回ロードしていては非効率なので，プログラム開始時にロードし，終了時にアンロードするようにします。

次の2つのグローバル変数が必要です。
[code]Dim VersionInfo As OSVERSIONINFO
Dim hShell As HINSTANCE[/code]
Createイベントには次の記述を追加してください。
[code]VersionInfo.dwOSVersionInfoSize = Len(VersionInfo)
GetVersionEx(VersionInfo)

hShell = LoadLibrary("Shell32") As HINSTANCE[/code]
Destroyイベントには次の記述を加えます。
[code]FreeLibrary(hShell As DWord)[/code][/hide]
あるいはOleUIChangeIconという公開関数を使うという方法もあります。
ただこの関数で表示されるダイアログは見慣れないものだということが欠点です。

	Dim hShell As HINSTANCE
	Dim SHChangeIconDialog As *Function(hWnd As HWND, ByRef lpszFilename As *Byte, Reserved As Long, ByRef lpIconIndex As Long) As Long
	Dim str As *Byte, index As Long, flag As Long
	Dim dwSize As Long, pwFileName As *Word
	hShell = LoadLibrary("Shell32") As HINSTANCE
	SHChangeIconDialog = GetProcAddress(hShell, 62 As *Byte) As *Function
	flag=SHChangeIconDialog(hMainWnd, str, -1, index)
	If flag=1 Then
		MessageBox(hMainWnd, MakeStr(str), Str$(index), MB_OK)
	End If
	FreeLibrary(hShell As DWord)

いろいろと試行錯誤の末、なんとかダイアログの表示に成功したのですが、
選択したアイコンファイルのパスが取得できません。

[code]
Dim hShell As HINSTANCE
Dim SHChangeIconDialog As *Function(hWnd As HWND, ByRef lpszFilename As *Byte, Reserved As Long, ByRef lpIconIndex As Long) As Long
Dim str As *Byte, index As Long, flag As Long
Dim dwSize As Long, pwFileName As *Word
hShell = LoadLibrary("Shell32") As HINSTANCE
SHChangeIconDialog = GetProcAddress(hShell, 62 As *Byte) As *Function
flag=SHChangeIconDialog(hMainWnd, str, -1, index)
If flag=1 Then
MessageBox(hMainWnd, MakeStr(str), Str$(index), MB_OK)
End If
FreeLibrary(hShell As DWord)
[/code]

どこをどう直せばいいのかさっぱりです。
ヒントでもいいので、よろしくお願いします。