ab.com コミュニティ

コード: 全て選択

Function DriveSelect() As String
	Dim hMenu As HMENU
	Dim udtMII As MENUITEMINFO
	Dim Buf As String

	hMenu=CreatePopupMenu()

	Dim buf[MAX_PATH] As Byte
	Dim Ptr As BytePtr
	GetLogicalDriveStrings(MAX_PATH,buf)
	Ptr=buf 'ポインタを代入
	While GetByte(Ptr) '先頭がNULL以外のとき
		MsgBox NULL,MakeStr(Ptr)

		If GetDriveType(Ptr)=DRIVE_CDROM Then
			With udtMII
				.cbSize=Len(udtMII)
				.fMask=MIIM_TYPE Or MIIM_ID Or MIIM_STATE
				.fType=MFT_STRING
				.dwTypeData=Ptr
				.cch=lstrlen(Ptr)
				.wID=GetByte(Ptr) 'ドライブ名の文字コード(A=&H41・B=&H42…)
				InsertMenuItem(hMenu,0,MF_BYCOMMAND,udtMII)
			End With
		End If

		Ptr=Ptr+lstrlen(Ptr)+1
	Wend

	Dim Ret As Long,poi As POINTAPI:GetCursorPos(poi)
	Ret=TrackPopupMenu(hMenu,TPM_LEFTALIGN Or TPM_TOPALIGN Or TPM_RETURNCMD,
	poi.x,poi.y,0,hMainWnd,ByVal NULL)
	If Ret<>0 Then
		DriveSelect=Chr$(Ret) & ":\" 'ドライブ文字列に戻す
	End If
	DestroyMenu(hMenu) 'メニュー破棄
End Function

コード: 全て選択

Function DriveSelect() As String
		Dim hMenu As HMENU
		Dim udtMII As MENUITEMINFO
		Dim Buf As String

		hMenu=CreatePopupMenu()

Dim buf[MAX_PATH] As Byte
Dim Ptr As BytePtr
GetLogicalDriveStrings(MAX_PATH,buf)
Ptr=buf 'ポインタを代入
While GetByte(Ptr) '先頭がNULL以外のとき
    MsgBox NULL,MakeStr(Ptr)

		'GetDriveType(Ptr)=DRIVE_CDROM
		With udtMII
		.cbSize=Len(udtMII)
		.fMask=MIIM_TYPE Or MIIM_ID Or MIIM_STATE
		.fType=MFT_STRING
		.dwTypeData=Ptr
		.cch=Len(MakeStr(Ptr))
		.wID=Val("E")
		InsertMenuItem(hMenu,0,MF_BYCOMMAND,udtMII)

		End With

	    Ptr=Ptr+lstrlen(Ptr)+1
Wend

		Dim Ret As Long,poi As POINTAPI:GetCursorPos(poi)
		Ret=TrackPopupMenu(hMenu,TPM_LEFTALIGN Or TPM_TOPALIGN Or TPM_RETURNCMD,
		poi.x,poi.y,0,hMainWnd,ByVal NULL)
		Select Case Ret
			Case Val("E")
			DriveSelect="E:\"
		End Select
End Function