by イグトランス » 2006年4月01日(土) 00:08
まず、ByRef lpszFilename As *ByteのByRefは不要です。
strはポインタですがどこも指していないのでまずいです。
また,この関数は非公開なので,9xではマルチバイト文字,NTではユニコード文字を使用するのでその区別も必要です。
興味があったので自分なりにどうにかしてみました。
それらをChangeIconDialogという関数を作り,そこに押し込めてみました。
このように使えます。
コード: 全て選択
Dim Index As Long
Dim strPath As String
strPath = ChangeIconDialog(hMainWnd, Index)
MessageBox(0, strPath, Str$(Index), MB_OK)
ChangeIconDialog関数の定義です。プロジェクト内の適当なところにコピーしてください。
[ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]コード: 全て選択
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
shell32.dllは毎回ロードしていては非効率なので,プログラム開始時にロードし,終了時にアンロードするようにします。
次の2つのグローバル変数が必要です。
コード: 全て選択
Dim VersionInfo As OSVERSIONINFO
Dim hShell As HINSTANCE
Createイベントには次の記述を追加してください。
コード: 全て選択
VersionInfo.dwOSVersionInfoSize = Len(VersionInfo)
GetVersionEx(VersionInfo)
hShell = LoadLibrary("Shell32") As HINSTANCE
Destroyイベントには次の記述を加えます。
コード: 全て選択
FreeLibrary(hShell As DWord)
あるいはOleUIChangeIconという公開関数を使うという方法もあります。
ただこの関数で表示されるダイアログは見慣れないものだということが欠点です。
まず、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という公開関数を使うという方法もあります。
ただこの関数で表示されるダイアログは見慣れないものだということが欠点です。