ab.com コミュニティ

コード: 全て選択

Function OpenFolder(hWnd As HWND, lpFolder As BytePtr) As Long
	Dim bi As BROWSEINFO
	Dim pidlBrowse As VoidPtr
	'BROWSEINFO構造体の初期化
	FillMemory(VarPtr(bi),Len(bi),0)
	With bi
	.hwndOwner=hWnd
	.lpszTitle="フォルダの選択"
	.ulFlags=BIF_RETURNONLYFSDIRS or BIF_EDITBOX
	End With
	'「フォルダの参照」ダイアログボックスを表示
	pidlBrowse=SHBrowseForFolder(bi)

	If pidlBrowse Then
		'フォルダへのパスを取得（lpFolderポインタが示すバッファにコピー）
		SHGetPathFromIDList(pidlBrowse, lpFolder)
		GetFolderDlg=1
	Else
		GetFolderDlg=0
	End If
End Function

コード: 全て選択

Const BFFM_INITIALIZED = 1
Const BFFM_SETSELECTIONA = WM_USER + 102
Const BFFM_SETSELECTION = BFFM_SETSELECTIONA

Function BrowseCallbackProc(hwnd As HWND, msg As DWord, lp As LPARAM, lpData As LPARAM) As LRESULT
	If msg = BFFM_INITIALIZED Then
		SendMessage(hwnd, BFFM_SETSELECTION, TRUE, lpData) 'lpDataにはbi.lParamの内容（つまり初期フォルダへのポインタ）が入っている。
	End If
End Function

Typedef PIDLIST = VoidPtr

Function OpenFolder(hWnd As HWND, InitialFolder As BytePtr) As String
    Dim bi As BROWSEINFO
    Dim pidlBrowse As VoidPtr
    'BROWSEINFO構造体の初期化
    FillMemory(VarPtr(bi), Len(bi), 0)
    With bi
	    .hwndOwner=hWnd
	    .lpszTitle = "フォルダの選択"
	    .ulFlags = BIF_RETURNONLYFSDIRS or BIF_EDITBOX
		.lParam = InitialFolder As LPARAM
		.lpfn = AddressOf(BrowseCallbackProc)
    End With
    '「フォルダの参照」ダイアログボックスを表示
    pidlBrowse = SHBrowseForFolder(bi) As PIDLIST

    If pidlBrowse Then
        'フォルダへのパスを取得
		Dim folder[ELM(MAX_PATH)] As Byte
        SHGetPathFromIDList(pidlBrowse, folder)
        OpenFolder = folder
    Else
        OpenFolder = ""
    End If
End Function