録音変換したwavファイルの音が割れてしまう
Posted: 2005年10月15日(土) 16:53
まえ、http://www.discoversoft.net/forum/viewt ... ったyu0627です。
このごろ、プログラム開発にとっつき、完成させました。しかし、録音した音が割れてしまいます。
ステレオミキサーで録音しています。
めちゃくちゃ長いですが、全てのソースコードを載せます。
何がおかしいでしょうか...。
あと、それ以外でおかしい点があったら教えてください。
お願いいたします。
このごろ、プログラム開発にとっつき、完成させました。しかし、録音した音が割れてしまいます。
ステレオミキサーで録音しています。
めちゃくちゃ長いですが、全てのソースコードを載せます。
コード: 全て選択
'-----------------------------------------------------------------------------
' イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。
' ウィンドウ ハンドル: hMainWnd
' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。
'外部関数使用宣言
Declare Function CharNext Lib "user32" Alias "CharNextA" (lpsz As BytePtr) As BytePtr
#include <api_mmsysPro4.sbp>
'
'各種定数・構造体宣言
Type COMBOBOXEXITEM
mask As DWord
iItem As Long
pszText As BytePtr
cchTextMax As Long
iImage As Long
iSelectedImage As Long
iOverlay As Long
iIndent As Long
lParam As DWord
End Type
Const CBEIF_TEXT=&H1
Const CBEIF_IMAGE=&H2
Const CBEIF_SELECTEDIMAGE=&H4
Const CBEM_INSERTITEM=(WM_USER+1)
Const CBEM_SETIMAGELIST=(WM_USER+2)
Const SEM_FAILCRITICALERRORS=&H1
'グローバル変数宣言
Dim SoftNameVer As String 'ソフト名とバージョン
Dim MIDIPath[MAX_PATH] As Byte 'MIDIファイルのパス
Dim MIDIFolder[MAX_PATH] As Byte 'MIDIファイルが入ったフォルダ
Dim MIDIFileName[256] As Byte 'MIDIファイルの名前
Dim lpExt[10] As Byte 'MIDIファイルの拡張子
Dim mop As MCI_OPEN_PARMS 'MCI_OPEN_PARMS構造体
Dim IsPlayOrRecord As Long '再生中か録音中かを識別するためのフラグ
Dim OsVerInfo As OSVERSIONINFO 'OSの情報を格納する為の構造体
Dim MIDILong As Double
Dim MIDIM As Long, MIDIS As Long
'ここから録音デバイスの変数
Dim Play_Flag As DWord
Dim Record_Flag As DWord
Dim Stop_Flag As DWord
Const NumOfBuffers = 5 'バッファ数
Const BufferLength = 100*1024 'バッファ長
Dim hWaveIn As HWAVEIN
Dim hWaveOut As HWAVEOUT
Dim WaveHdr[ELM(NumOfBuffers)] As WAVEHDR
Dim WaveOutFormatEx As WAVEFORMATEX
Dim WaveInFormatEx As WAVEFORMATEX
Dim hMmio As HMMIO
Dim MmioInfo As MMIOINFO
Dim MmioCkInfo As MMCKINFO
Dim MmioCkInfoSub As MMCKINFO
Dim WaveData[ELM(NumOfBuffers)] As *Byte
Dim WaveInCaps As WAVEINCAPS
'ここまで
Dim hCombo As DWord 'コンボボックスのハンドル
Dim citem As COMBOBOXEXITEM 'コンボボックス内容追加のための構造体
'ここまで
'グローバル変数初期化
SoftNameVer="MIDI Encorder v1.0.0.0"
FillMemory(MIDIPath, MAX_PATH, 0)
FillMemory(VarPtr(mop), Len(mop), 0)
FillMemory(VarPtr(OsVerInfo), Len(OsVerInfo), 0)
IsPlayOrRecord=0
'ここまで
'MIDIファイルを再生するためにMCIをオープンするための自作関数
Function OpenMciDevice(FileName As BytePtr) As Long
Dim bErr As DWord
Dim dwError As DWord
Dim buffer[255] As Byte 'MCIエラーを格納する変数
'メッセージ通知のためのウィンドウを指定
mop.dwCallback=hMainWnd
'OsVerInfo.dwOSVersionInfoSizeのサイズを指定
OsVerInfo.dwOSVersionInfoSize=Len(OsVerInfo)
'OSのバージョンを取得
GetVersionEx(OsVerInfo)
'もしOSがWin2KかWinXPでファイルがMIDIならMPEGVideoデバイスを指定
If (OsVerInfo.dwPlatformId=VER_PLATFORM_WIN32_NT and Right$(FileName, 3)="mid") or _
(OsVerInfo.dwPlatformId=VER_PLATFORM_WIN32_NT and Right$(FileName, 4)="midi") Then
If OsVerInfo.dwMinorVersion=0 or OsVerInfo.dwMinorVersion=1 Then
mop.lpstrDeviceType="MPEGVideo"
mop.lpstrElementName=FileName
bErr=mciSendCommand(0, MCI_OPEN, MCI_OPEN_ELEMENT or MCI_OPEN_TYPE, mop)
If bErr Then
mciGetErrorString(dwError, buffer, 255)
MessageBox(hMainWnd, buffer, "Error - " + SoftNameVer, MB_OK or MB_ICONERROR)
OpenMciDevice=0
CloseMciDevice()
Exit Sub
End If
End If
Else
mop.lpstrElementName=FileName
bErr=mciSendCommand(0, MCI_OPEN, MCI_OPEN_ELEMENT, mop)
If bErr Then
mciGetErrorString(dwError, buffer, 255)
MessageBox(hMainWnd, buffer, "Error - " + SoftNameVer, MB_OK or MB_ICONERROR)
OpenMciDevice=0
CloseMciDevice()
Exit Sub
End If
End If
OpenMciDevice=1
End Function
'MCIデバイスをクローズするための関数
Sub CloseMciDevice()
Dim dwDummy As DWord
mciSendCommand(mop.wDeviceID, MCI_CLOSE, MCI_WAIT, dwDummy)
mop.wDeviceID=0
End Sub
'フルパスを分解する関数
Sub SpritName(lpszPath As BytePtr, lpszName As BytePtr, lpszExt As BytePtr) As Long
Dim lpszPtr As BytePtr
Dim chr As Byte
Dim length As Long
lpszPtr = lpszPath
lstrcpy(lpszName, lpszPath)
While lpszPtr <> Ex"\0"
'先頭が2バイト文字のときはスキップ
If IsDBCSLeadByte(lpszPtr[0]) = 0 Then
chr = Asc(lpszPtr) '先頭の文字を判別する
'[\(&H5C)][/(&H2F)]を見つけたら現在地+1のポインタ以降を保存
If ((chr = &H5C) or (chr = &H2F)) Then
lstrcpy(lpszName,lpszPtr + 1)
End If
'[.(&H2E)]を見つけたら現在地のポインタ+1以降を保存
If (chr = &H2E) Then
lstrcpy(lpszExt, lpszPtr+1)
End If
End If
'次の文字へポインタを進める
lpszPtr = CharNext(lpszPtr)
'戻り値の設定
Wend
'フルパス名のファイル名部分を削除
length = lstrlen(lpszPath) - lstrlen(lpszName)
lpszPath[length] = 0
'ファイル名の拡張子部分を削除
If lstrlen(lpszExt) Then
length = lstrlen(lpszName) - lstrlen(lpszExt) - 1
lpszName[length] = 0
End If
End Sub
'-----------------------------------------------------------------------------
' ウィンドウメッセージを処理するためのコールバック関数
Function MainWndProc(hWnd As HWND, dwMsg As DWord, wParam As WPARAM, lParam As LPARAM) As DWord
' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。
Dim cnt As Long
Dim ret As Long
Dim pwh As *WAVEHDR
Select Case dwMsg
Case MM_WOM_OPEN /******WAVE出力デバイスが開かれた時に呼ばれる******/
/******dataチャンクにアクセス******/
MmioCkInfoSub.ckid = mmioStringToFOURCC("data",0)
mmioDescend(hMmio,MmioCkInfoSub,MmioCkInfo,MMIO_FINDCHUNK)
For cnt=0 To NumOfBuffers-1
ret = mmioRead(hMmio,WaveData[cnt],BufferLength)
If ret = 0 or ret = -1 Then
WaveHdr[cnt].dwBufferLength = 0
WaveHdr[cnt].dwUser = TRUE
Else
WaveHdr[cnt].dwBufferLength = ret
WaveHdr[cnt].dwUser = FALSE
End If
waveOutPrepareHeader(hWaveOut,WaveHdr[cnt],SizeOf(WAVEHDR))
Next
For cnt=0 To NumOfBuffers-1
waveOutWrite(hWaveOut,WaveHdr[cnt],SizeOf(WAVEHDR))
Next
Case MM_WOM_CLOSE /******WAVE出力デバイスが閉じられる時に呼ばれる******/
For cnt=0 To NumOfBuffers-1
waveOutUnprepareHeader(hWaveOut,WaveHdr[cnt],SizeOf(WAVEHDR))
Next
Play_Flag = FALSE
Case MM_WOM_DONE /******WAVE出力デバイスのバッファの再生終了時に呼ばれる******/
pwh=lParam
If pwh->dwUser = TRUE or Stop_Flag = TRUE Then
mmioAscend(hMmio,MmioCkInfoSub,0)
mmioClose(hMmio,0)
waveOutClose(hWaveOut)
Stop_Flag = FALSE
Else
/******dataデータを読み込み******/
FillMemory(pwh->lpData,BufferLength,127)
ret = mmioRead(hMmio,pwh->lpData,BufferLength)
If ret = 0 or ret = -1 Then
pwh->dwUser = TRUE
pwh->dwBufferLength = 0
Else
pwh->dwUser = FALSE
pwh->dwBufferLength = ret
End If
waveOutWrite(hWaveOut,ByVal pwh,SizeOf(WAVEHDR))
End If
Case MM_WIM_OPEN /******WAVE入力デバイスが開かれた時に呼ばれる******/
/******dataチャンクを作成******/
MmioCkInfoSub.ckid = mmioStringToFOURCC("data",0)
mmioCreateChunk(hMmio,MmioCkInfoSub,0)
For cnt=0 To NumOfBuffers-1
WaveHdr[cnt].dwUser = FALSE
WaveHdr[cnt].dwBufferLength = BufferLength
waveInPrepareHeader(hWaveIn,WaveHdr[cnt],SizeOf(WAVEHDR))
waveInAddBuffer(hWaveIn,WaveHdr[cnt],SizeOf(WAVEHDR))
Next
waveInStart(hWaveIn)
Case MM_WIM_CLOSE /******WAVE入力デバイスが閉じられる時に呼ばれる******/
For cnt=0 To NumOfBuffers-1
waveInUnprepareHeader(hWaveIn,WaveHdr[cnt],SizeOf(WAVEHDR))
Next
Record_Flag = FALSE
Case MM_WIM_DATA /******WAVE入力デバイスのバッファが一杯になった時に呼ばれる******/
pwh=lParam
If Stop_Flag = TRUE Then
mmioWrite(hMmio,pwh->lpData,pwh->dwBytesRecorded)
mmioAscend(hMmio,MmioCkInfoSub,0)
mmioAscend(hMmio,MmioCkInfo,0)
mmioClose(hMmio,0)
waveInClose(hWaveIn)
Stop_Flag = FALSE
Else
/******dataデータを書き込み******/
mmioWrite(hMmio,pwh->lpData,pwh->dwBytesRecorded)
FillMemory(pwh->lpData,BufferLength,127)
waveInAddBuffer(hWaveIn,ByVal pwh,SizeOf(WAVEHDR))
End If
End Select
' イベントプロシージャの呼び出しを行います。
MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam)
End Function
'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。
Sub MainWnd_Destroy()
Dim cnt As Long
If Record_Flag = TRUE Then
Stop_Flag = TRUE
waveInReset(hWaveIn)
ElseIf Play_Flag = TRUE Then
Stop_Flag = TRUE
waveOutReset(hWaveOut)
End If
For cnt=0 To NumOfBuffers-1
free(WaveData[cnt])
Next
midienc_DestroyObjects()
PostQuitMessage(0)
End Sub
Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
'MainWndを画面の中央に配置
Dim MainWndRect As RECT
GetWindowRect(hMainWnd, MainWndRect)
SetWindowPos(hMainWnd, 0,_
(GetSystemMetrics(SM_CXSCREEN) - MainWndRect.right + MainWndRect.left) \ 2,_
(GetSystemMetrics(SM_CYSCREEN) - MainWndRect.bottom + MainWndRect.top) \ 2,_
0, 0, SWP_NOSIZE or SWP_NOZORDER)
'それぞれのラジオボタンをチェック
SendDlgItemMessage(hMainWnd, SameFolder_RadioButton, BM_SETCHECK, 1, 0)
'ウインドウタイトルを設定
SetWindowText(hMainWnd, SoftNameVer)
'コンボボックスの作成
Dim ic As INITCOMMONCONTROLSEX
ic.dwSize=Len(ic)
ic.dwICC=ICC_USEREX_CLASSES
InitCommonControlsEx(ic)
hCombo=CreateWindowEx( 0, "ComboBoxEx32", NULL, WS_VISIBLE or CBS_SORT or WS_CHILD or CBS_DROPDOWNLIST or CBS_SORT, 25, 245,160, 100, hMainWnd, 1, GetModuleHandle(0), NULL)
SendMessage(hCombo,WM_SETFONT,hFont_MainWnd,0)
Dim cnt As Long
For cnt=0 To NumOfBuffers-1
WaveData[cnt] = malloc(BufferLength)
WaveHdr[cnt].lpData=WaveData[cnt]
FillMemory(WaveData[cnt],BufferLength,127)
Next
'WAVE入力デバイスの性能を取得し、内容をコンボボックスに追加
waveInGetDevCaps(WAVE_MAPPER,WaveInCaps,SizeOf(WAVEINCAPS))
If WaveInCaps.dwFormats And WAVE_FORMAT_4S16 Then
With citem
.mask=CBEIF_TEXT
.pszText="44100Hz 16bit Streo"
.iItem=0
End With
End If
SendMessage(hCombo, CBEM_INSERTITEM, 0, VarPtr(citem))
If WaveInCaps.dwFormats And WAVE_FORMAT_4M16 Then
With citem
.mask=CBEIF_TEXT
.pszText="44100Hz 16bit Monoural"
.iItem=1
End With
End If
SendMessage(hCombo, CBEM_INSERTITEM, 1, VarPtr(citem))
If WaveInCaps.dwFormats And WAVE_FORMAT_4S08 Then
With citem
.mask=CBEIF_TEXT
.pszText="44100Hz 8bit Streo"
.iItem=2
End With
End If
SendMessage(hCombo, CBEM_INSERTITEM, 2, VarPtr(citem))
If WaveInCaps.dwFormats And WAVE_FORMAT_4M08 Then
With citem
.mask=CBEIF_TEXT
.pszText="44100Hz 8bit Monoural"
.iItem=3
End With
End If
SendMessage(hCombo, CBEM_INSERTITEM, 3, VarPtr(citem))
If WaveInCaps.dwFormats And WAVE_FORMAT_2S16 Then
With citem
.mask=CBEIF_TEXT
.pszText="22050Hz 16bit Streo"
.iItem=4
End With
End If
SendMessage(hCombo, CBEM_INSERTITEM, 4, VarPtr(citem))
If WaveInCaps.dwFormats And WAVE_FORMAT_2M16 Then
With citem
.mask=CBEIF_TEXT
.pszText="22050Hz 16bit Monoural"
.iItem=5
End With
End If
SendMessage(hCombo, CBEM_INSERTITEM, 5, VarPtr(citem))
If WaveInCaps.dwFormats And WAVE_FORMAT_2S08 Then
With citem
.mask=CBEIF_TEXT
.pszText="22050Hz 8bit Streo"
.iItem=6
End With
End If
SendMessage(hCombo, CBEM_INSERTITEM, 6, VarPtr(citem))
If WaveInCaps.dwFormats And WAVE_FORMAT_2M08 Then
With citem
.mask=CBEIF_TEXT
.pszText="22050Hz 8bit Monoural"
.iItem=7
End With
End If
SendMessage(hCombo, CBEM_INSERTITEM, 7, VarPtr(citem))
If WaveInCaps.dwFormats And WAVE_FORMAT_1S16 Then
With citem
.mask=CBEIF_TEXT
.pszText="11025Hz 16bit Streo"
.iItem=8
End With
End If
SendMessage(hCombo, CBEM_INSERTITEM, 8, VarPtr(citem))
If WaveInCaps.dwFormats And WAVE_FORMAT_1M16 Then
With citem
.mask=CBEIF_TEXT
.pszText="11025Hz 16bit Monoural"
.iItem=9
End With
End If
SendMessage(hCombo, CBEM_INSERTITEM, 9, VarPtr(citem))
If WaveInCaps.dwFormats And WAVE_FORMAT_1S08 Then
With citem
.mask=CBEIF_TEXT
.pszText="11025Hz 8bit Streo"
.iItem=10
End With
End If
SendMessage(hCombo, CBEM_INSERTITEM, 10, VarPtr(citem))
If WaveInCaps.dwFormats And WAVE_FORMAT_1M08 Then
With citem
.mask=CBEIF_TEXT
.pszText="11025Hz 8bit Monoural"
.iItem=11
End With
End If
SendMessage(hCombo, CBEM_INSERTITEM, 12, VarPtr(citem))
End Sub
Sub MainWnd_SameFolder_RadioButton_Click()
EnableWindow(GetDlgItem(hMainWnd, OtherFolderPath_EditBox), 0)
EnableWindow(GetDlgItem(hMainWnd, ChooseOtherFolder_Button), 0)
End Sub
Sub MainWnd_OtherFolder_RadioButton_Click()
EnableWindow(GetDlgItem(hMainWnd, OtherFolderPath_EditBox), 1)
EnableWindow(GetDlgItem(hMainWnd, ChooseOtherFolder_Button), 1)
End Sub
Sub MainWnd_ChooseMIDIButton_Click()
'変数宣言
Dim ofn As OPENFILENAME 'OPENFILENAME構造体
Dim midipath[MAX_PATH] As Byte
Dim bErr As Long
Dim buffer[255] As Byte 'MCIエラーを格納する変数
Dim msp As MCI_STATUS_PARMS
'ファイル名を取得
ofn.lStructSize=Len(ofn)
ofn.hwndOwner=hMainWnd
ofn.lpstrFilter=Ex"MIDIファイル(*.mid;*.midi)\0*.mid;*.midi\0すべてのファイル(*.*)\0*\0\0"
ofn.nFilterIndex=1
ofn.nMaxFile=MAX_PATH-1
ofn.lpstrFile=midipath
ofn.Flags=OFN_FILEMUSTEXIST or OFN_HIDEREADONLY or OFN_PATHMUSTEXIST
If GetOpenFileName(ofn)=0 Then Exit Sub
'スタティックテキストにパスを設定する
SetDlgItemText(hMainWnd, Static_MIDIPath, ofn.lpstrFile)
'--------------------------
'MIDIファイルの長さを取得
'--------------------------
'MCIデバイスをオープンする
If OpenMciDevice(midipath)=0 Then Exit Sub
'MIDIファイルの長さを取得
msp.dwItem = MCI_STATUS_LENGTH
mciSendCommand(mop.wDeviceID, MCI_STATUS, MCI_STATUS_ITEM, msp)
'取得したミリ秒から分と秒を計算
MIDILong = msp.dwReturn/1000
If MIDILong=>60 Then
MIDIM=MIDILong \ 60
MIDIS=MIDILong - (MIDIM * 60)
Else
MIDIM=0
MIDIS=MIDILong
End If
wsprintf(buffer, "時間:%d:%02d", MIDIM, MIDIS)
SetDlgItemText(hMainWnd, Static_MIDILong, buffer)
EnableWindow(GetDlgItem(hMainWnd, PlayMIDIButton), 1)
CloseMciDevice()
lstrcpy(MIDIPath, midipath)
SpritName(midipath, MIDIFileName, lpExt)
lstrcpy(MIDIFolder, midipath)
End Sub
Sub MainWnd_PlayMIDIButton_Click()
Dim mpp As MCI_PLAY_PARMS
Dim bErr As Long
'MCIデバイスをオープン
If OpenMciDevice(MIDIPath)=0 Then Exit Sub
'MIDIファイルを再生
mpp.dwCallback=hMainWnd
bErr=mciSendCommand(mop.wDeviceID, MCI_PLAY, MCI_NOTIFY, mpp)
If bErr Then
MessageBox(hMainWnd, "デバイスの再生に失敗", "Error - " + SoftNameVer, MB_OK or MB_ICONSTOP)
Exit Sub
End If
'再生ボタンを無効化し、停止ボタンを有効化する
EnableWindow(GetDlgItem(hMainWnd, PlayMIDIButton), 0)
EnableWindow(GetDlgItem(hMainWnd, StopMIDIButton), 1)
End Sub
Sub MainWnd_StopMIDIButton_Click()
Dim bErr As Long
Dim dwCallBack As DWord
'停止
bErr=mciSendCommand(mop.wDeviceID, MCI_STOP, MCI_WAIT, dwCallBack)
If bErr Then
MessageBox(hMainWnd, "デバイスの停止に失敗", "Error - " + SoftNameVer, MB_OK or MB_ICONSTOP)
CloseMciDevice()
Exit Sub
End If
'デバイスを閉じる
CloseMciDevice()
'再生ボタンを有効化し、停止ボタンを無効化する
EnableWindow(GetDlgItem(hMainWnd, PlayMIDIButton), 1)
EnableWindow(GetDlgItem(hMainWnd, StopMIDIButton), 0)
End Sub
Sub MainWnd_MciNotify(flags As Long, DevID As DWord)
If flags=MCI_NOTIFY_SUCCESSFUL Then
If IsPlayOrRecord=0 Then
'停止する
SendMessage(hMainWnd, WM_COMMAND, StopMIDIButton, 0)
Else
Dim bErr As Long
Dim dwCallBack As DWord
'停止
bErr=mciSendCommand(mop.wDeviceID, MCI_STOP, MCI_WAIT, dwCallBack)
If bErr Then
MessageBox(hMainWnd, "デバイスの停止に失敗", "Error - " + SoftNameVer, MB_OK or MB_ICONSTOP)
CloseMciDevice()
Exit Sub
End If
'デバイスを閉じる
CloseMciDevice()
Stop_Flag = TRUE
waveInReset(hWaveIn)
waveOutReset(hWaveOut)
Play_Flag = FALSE
Record_Flag = FALSE
'各種コントロールを有効・無効化する
EnableWindow(GetDlgItem(hMainWnd, GroupBox1), 1)
EnableWindow(GetDlgItem(hMainWnd, GroupBox2), 1)
EnableWindow(GetDlgItem(hMainWnd, GroupBox3), 1)
EnableWindow(GetDlgItem(hMainWnd, GroupBox4), 1)
EnableWindow(GetDlgItem(hMainWnd, GroupBox5), 1)
EnableWindow(GetDlgItem(hMainWnd, Static_MIDIPath), 1)
EnableWindow(GetDlgItem(hMainWnd, Static_MIDILong), 1)
EnableWindow(GetDlgItem(hMainWnd, ChooseMIDIButton), 1)
EnableWindow(GetDlgItem(hMainWnd, PlayMIDIButton), 1)
EnableWindow(GetDlgItem(hMainWnd, SameFolder_RadioButton), 1)
EnableWindow(GetDlgItem(hMainWnd, OtherFolder_RadioButton), 1)
EnableWindow(GetDlgItem(hMainWnd, OtherFolderPath_EditBox), 1)
EnableWindow(GetDlgItem(hMainWnd, ChooseOtherFolder_Button), 1)
EnableWindow(GetDlgItem(hMainWnd, StartEncButton), 1)
EnableWindow(hCombo, 1)
EnableWindow(GetDlgItem(hMainWnd, CancelEncButton), 0)
End If
End If
End Sub
Sub MainWnd_ChooseOtherFolder_Button_Click()
Dim bi As BROWSEINFO 'BROWSEINFO構造体
Dim pidl As Long
Dim OtherFolderPath[MAX_PATH] As Byte '他のフォルダへのパス
'BROWSEINFO構造体の初期化
FillMemory(VarPtr(bi),Len(bi),0)
bi.hwndOwner=hMainWnd
bi.lpszTitle="フォルダを選択してください"
bi.ulFlags=BIF_RETURNONLYFSDIRS
'「フォルダの参照」ダイアログボックスを表示
pidl=SHBrowseForFolder(bi)
If pidl Then
'フォルダへのパスを取得(lpFolderポインタが示すバッファにコピー)
SHGetPathFromIDList(pidl, OtherFolderPath)
CoTaskMemFree(pidl)
SetDlgItemText(hMainWnd, OtherFolderPath_EditBox, OtherFolderPath)
End If
End Sub
Sub MainWnd_StartEncButton_Click()
'MIDI->WAVに変換するプロシージャ
Dim path[MAX_PATH] As Long '変換ファイルを置くフォルダ
Dim channel As Long 'チャンネル
Dim Hz As Long 'サンプリング周波数
Dim bit As Long '量子化ビット数
Dim buffer[256] As Byte 'コンボボックスから取得した内容を格納する変数
'--------------------
'各設定内容のチェック
'--------------------
If MIDIPath[0]=0 Then
MessageBox(hMainWnd, "MIDIファイルが選択されていません", "Error - " + SoftNameVer, MB_OK)
Exit Sub
End If
If SendDlgItemMessage(hMainWnd, OtherFolder_RadioButton, BM_GETCHECK, 0, 0)=BST_CHECKED Then
GetDlgItemText(hMainWnd, OtherFolderPath_EditBox, path, MAX_PATH)
If path[0]=0 Then
MessageBox(hMainWnd, "他のフォルダへのパスが設定されていません", "Error - " + SoftNameVer, MB_OK)
Exit Sub
End If
lstrcat(path, MIDIFileName + ".wav")
Else
lstrcpy(path, MIDIFolder + MIDIFileName + ".wav")
End If
'コンボボックスで選択された内容からwavフォーマットを指定
SendMessage(hCombo, CB_GETLBTEXT, SendMessage(hCombo, CB_GETCURSEL, 0, 0), buffer)
If buffer="" Then
MessageBox(hMainWnd, "変換品質が選択されていません。", "Error - " + SoftNameVer, MB_OK)
Exit Sub
End If
WaveInFormatEx.cbSize = SizeOf(WAVEFORMATEX)
WaveInFormatEx.wFormatTag = WAVE_FORMAT_PCM
If InStr(1, buffer, "Streo") Then
WaveInFormatEx.nChannels = 2
Else
WaveInFormatEx.nChannels = 1
End If
If InStr(1, buffer, "16bit") Then
WaveInFormatEx.wBitsPerSample = 16
Else
WaveInFormatEx.wBitsPerSample = 8
End If
If InStr(1, buffer, "44100") Then
WaveInFormatEx.nSamplesPerSec = 44100
ElseIf InStr(1, buffer, "22050") Then
WaveInFormatEx.nSamplesPerSec = 22050
Else
WaveInFormatEx.nSamplesPerSec = 11025
End If
WaveInFormatEx.nBlockAlign = WaveInFormatEx.nChannels*WaveInFormatEx.wBitsPerSample/8
WaveInFormatEx.nAvgBytesPerSec = WaveInFormatEx.nBlockAlign * WaveInFormatEx.nSamplesPerSec
'MCIデバイスをオープン
If OpenMciDevice(MIDIPath)=0 Then Exit Sub
'必要ないコントロールを無効化する
EnableWindow(GetDlgItem(hMainWnd, GroupBox1), 0)
EnableWindow(GetDlgItem(hMainWnd, GroupBox2), 0)
EnableWindow(GetDlgItem(hMainWnd, GroupBox3), 0)
EnableWindow(GetDlgItem(hMainWnd, GroupBox4), 0)
EnableWindow(GetDlgItem(hMainWnd, GroupBox5), 0)
EnableWindow(GetDlgItem(hMainWnd, Static_MIDIPath), 0)
EnableWindow(GetDlgItem(hMainWnd, Static_MIDILong), 0)
EnableWindow(GetDlgItem(hMainWnd, ChooseMIDIButton), 0)
EnableWindow(GetDlgItem(hMainWnd, PlayMIDIButton), 0)
EnableWindow(GetDlgItem(hMainWnd, StopMIDIButton), 0)
EnableWindow(GetDlgItem(hMainWnd, SameFolder_RadioButton), 0)
EnableWindow(GetDlgItem(hMainWnd, OtherFolder_RadioButton), 0)
EnableWindow(GetDlgItem(hMainWnd, OtherFolderPath_EditBox), 0)
EnableWindow(GetDlgItem(hMainWnd, ChooseOtherFolder_Button), 0)
EnableWindow(GetDlgItem(hMainWnd, StartEncButton), 0)
EnableWindow(hCombo, 0)
Dim mpp As MCI_PLAY_PARMS
Dim bErr As Long
'MIDIファイルを再生
mpp.dwCallback=hMainWnd
bErr=mciSendCommand(mop.wDeviceID, MCI_PLAY, MCI_NOTIFY, mpp)
If bErr Then
MessageBox(hMainWnd, "デバイスの再生に失敗", "Error - " + SoftNameVer, MB_OK or MB_ICONSTOP)
Exit Sub
End If
/******WAVEファイルを作成******/
hMmio = mmioOpen(path, ByVal 0, MMIO_CREATE or MMIO_WRITE or MMIO_EXCLUSIVE)
/******WAVEチャンクを作成******/
MmioCkInfo.fccType = mmioStringToFOURCC("WAVE", 0)
mmioCreateChunk(hMmio, MmioCkInfo, MMIO_CREATERIFF)
/******fmt チャンクを作成******/
MmioCkInfoSub.ckid = mmioStringToFOURCC("fmt ", 0)
mmioCreateChunk(hMmio, MmioCkInfoSub, 0)
/******fmt データを書き込み******/
mmioWrite(hMmio, VarPtr(WaveInFormatEx), SizeOf(PCMWAVEFORMAT))
mmioAscend(hMmio, MmioCkInfoSub, 0)
/******WAVE入力デバイスを開く******/
waveInOpen(hWaveIn, WAVE_MAPPER, WaveInFormatEx, hMainWnd, 0, CALLBACK_WINDOW)
Record_Flag = TRUE
IsPlayOrRecord=1
'「変換中止」ボタンを有効化する
EnableWindow(GetDlgItem(hMainWnd, CancelEncButton), 1)
End Sub
Sub MainWnd_CancelEncButton_Click()
Dim bErr As Long
Dim dwCallBack As DWord
'停止
bErr=mciSendCommand(mop.wDeviceID, MCI_STOP, MCI_WAIT, dwCallBack)
If bErr Then
MessageBox(hMainWnd, "デバイスの停止に失敗", "Error - " + SoftNameVer, MB_OK or MB_ICONSTOP)
CloseMciDevice()
Exit Sub
End If
'デバイスを閉じる
CloseMciDevice()
Stop_Flag = TRUE
waveInReset(hWaveIn)
waveOutReset(hWaveOut)
Play_Flag = FALSE
Record_Flag = FALSE
'各種コントロールを有効・無効化する
EnableWindow(GetDlgItem(hMainWnd, GroupBox1), 1)
EnableWindow(GetDlgItem(hMainWnd, GroupBox2), 1)
EnableWindow(GetDlgItem(hMainWnd, GroupBox3), 1)
EnableWindow(GetDlgItem(hMainWnd, GroupBox4), 1)
EnableWindow(GetDlgItem(hMainWnd, GroupBox5), 1)
EnableWindow(GetDlgItem(hMainWnd, Static_MIDIPath), 1)
EnableWindow(GetDlgItem(hMainWnd, Static_MIDILong), 1)
EnableWindow(GetDlgItem(hMainWnd, ChooseMIDIButton), 1)
EnableWindow(GetDlgItem(hMainWnd, PlayMIDIButton), 1)
EnableWindow(GetDlgItem(hMainWnd, SameFolder_RadioButton), 1)
EnableWindow(GetDlgItem(hMainWnd, OtherFolder_RadioButton), 1)
EnableWindow(GetDlgItem(hMainWnd, OtherFolderPath_EditBox), 1)
EnableWindow(GetDlgItem(hMainWnd, ChooseOtherFolder_Button), 1)
EnableWindow(GetDlgItem(hMainWnd, StartEncButton), 1)
EnableWindow(hCombo, 1)
EnableWindow(GetDlgItem(hMainWnd, CancelEncButton), 0)
End Sub
あと、それ以外でおかしい点があったら教えてください。
お願いいたします。