Vfp menjalankan mp3 dgn output lebih dari 1 Sound card

[yaten]

dear foxer
Mohon pencerahannya
saya sudah berhasil membuat aplikasi dengan vfp dengan menggunakan
ocx yang ada (mci32.ocx) itu sudah berhasil. ( play, pause,stop, dll)
Tapi yang jadi masalah adalah gimana caranya sy dapat membagi :
lagu 1 ->untuk soundcard 1
lagu 2 ->untuk soundcard 2
 
dah coba ke news2news tapi samplenya tidak bisa diambil harus member
ada contoh delphi tp sy engak mudeng trus

Tks sebelumnya

[armen]

Pake WinAPI memang ruwet pak,
ini contohnya:

Code: [Select]

*!* Ini buat browse All Sound Card
#DEFINE MMSYSERR_NOERROR 0
DO decl
 
LOCAL nDevCount, nDevIndex
 
nDevCount = waveOutGetNumDevs()
IF nDevCount < 1
* no waveform-audio output devices found
    RETURN
ENDIF
 
CREATE CURSOR csDevices (mid I, pid I, drvver I, devname C(32))
 
FOR nDevIndex=0 TO nDevCount-1
    DO QueryDevice WITH nDevIndex
ENDFOR
 
GO TOP
BROWSE NORMAL NOWAIT
* end of main
 
PROCEDURE QueryDevice(nIndex)
*|typedef struct {
*|    WORD      wMid;                 0:2
*|    WORD      wPid;                 2:2
*|    MMVERSION vDriverVersion;       4:4
*|    TCHAR     szPname[MAXPNAMELEN]; 8:32
*|    DWORD     dwFormats;           40:4
*|    WORD      wChannels;           44:2
*|    WORD      wReserved1;          46:2
*|    DWORD     dwSupport;           48:4
*|} WAVEOUTCAPS; total 52 bytes
#DEFINE WAVEOUTCAPS_SIZE 52
    LOCAL cBuffer, nResult
    cBuffer = Repli(Chr(0), WAVEOUTCAPS_SIZE)
 
    nResult = waveOutGetDevCaps(nIndex, @cBuffer, WAVEOUTCAPS_SIZE)
    IF nResult <> MMSYSERR_NOERROR
        ? "Error:", GetWaveError(nResult)
        RETURN
    ENDIF
 
    LOCAL mid, pid, drvver, devname, formats, channels
    mid = buf2word(SUBSTR(cBuffer, 1,2))
    pid = buf2word(SUBSTR(cBuffer, 3,2))
    drvver = buf2dword(SUBSTR(cBuffer, 5,4))
    devname = SUBSTR(cBuffer, 9,32)
    m.devname = SUBSTR(m.devname, 1, AT(Chr(0),m.devname)-1)
 
    INSERT INTO csDevices VALUES (m.mid, m.pid, m.drvver,;
        m.devname)
 
FUNCTION GetWaveError(lnError)
    LOCAL lcBuf
    lcBuf = Repli(Chr(0), 250)
    = waveOutGetErrorText(lnError, @lcBuf, Len(lcBuf))
RETURN STRTRAN(lcBuf, Chr(0),"")
 
PROCEDURE decl
    DECLARE INTEGER waveOutGetNumDevs IN winmm
 
    DECLARE INTEGER waveOutGetDevCaps IN winmm;
        INTEGER uDeviceID, STRING @pwoc, LONG cbwoc
 
    DECLARE INTEGER waveOutGetErrorText IN winmm;
        INTEGER mmrError, STRING @pszText, LONG cchText
 
FUNCTION buf2dword(lcBuffer)
RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
    BitLShift(Asc(SUBSTR(lcBuffer, 2,1)),  +;
    BitLShift(Asc(SUBSTR(lcBuffer, 3,1)), 16) +;
    BitLShift(Asc(SUBSTR(lcBuffer, 4,1)), 24)
 
FUNCTION buf2word(lcBuffer)
RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
       Asc(SUBSTR(lcBuffer, 2,1)) * 256

*!* Trus Buka Portnya
DECLARE INTEGER waveOutOpen IN winmm;
        INTEGER @ phwo,;
        INTEGER   uDeviceID,;
        STRING  @ pwfx,;
        INTEGER   dwCallback,;
        INTEGER   dwCallbackInst,;
        INTEGER   fdwOpen

*!* trus mainkan file pada soundcard yg dipilih
DECLARE INTEGER sndPlaySound IN winmm;
        STRING  lpszSound,;
        INTEGER fuSound

lpszSound= GETENV("SystemRoot")+'\media\Windows XP Startup.wav'
 = sndPlaySound(lpszSound, 2)


He..he..he
Mabok ga tuh code?
Trus suppor juga file.Wav, kalo MP3 bisa diconvert dulu juga pake WinAPI

hm.... mungkin pake WMI (Windows Management Instrumentation) lebih simple
Silahkan dicari dulu pak

[yaten]

Tks mas armen
terus terang maboknya dah 1 mggu lalu hehe. 

DECLARE INTEGER sndPlaySound IN winmm;
        STRING  lpszSound,;
        INTEGER fuSound

lpszSound= GETENV("SystemRoot")+'\media\Windows XP Startup.wav'
 = sndPlaySound(lpszSound, 2)

Ini engak kebayang sebelumnya, tp tks dah dapat pencerahan

sy sdh coba code mengikuti urutan untuk menjalankan lagu
1. waveOutGetnumdevs()  <Sukses>
2. waveOutGetDevCaps()  <Sukses>
3. waveOutOpen()             <Sukses>
4. waveOutPrepareHeader()  <Error , mabok deh, mentok disini>
5. waveOutWrite()                 
6. waveOutUnprepareHeader()
7. waveOutReset()                 
8. waveOutClose()

sy cari terus sample untuk foxpro tapi minim untuk kasus ini , ada pake Vb
ini contoh codenya :
Type WAVEHDR
        lpData As Long
        dwBufferLength As Long
        dwBytesRecorded As Long
        dwUser As Long
        dwFlags As Long
        dwLoops As Long
        lpNext As Long
        Reserved As Long
End Type

dst..

    For i = 1 To NUM_BUFFERS
        hdr(i).lpData = pmem(i)
        hdr(i).dwBufferLength = bufferSize
        hdr(i).dwFlags = 0
        hdr(i).dwLoops = 0
        rc = waveOutPrepareHeader(hWaveOut, hdr(i), Len(hdr(i)))
        If (rc <> MMSYSERR_NOERROR) Then
            waveOutGetErrorText rc, msg, Len(msg)
            MsgBox msg
        End If
    Next

saya kesulitan nulis coding padananya kl  di foxpro gimana ??

Tks sebelumnya mas armen

[armen]

pak yaten,

oooo...kenapa harus gitu panjang procedurenya pak?
Mentok di function waveOutPrepareHeader(),
Apa tidak mungkin dengan memilih salah satu AudioSound terlebih dahulu kemudian, panggil function sndPlaySound()

Untuk memilih DirecOutput Sound bisa pake mciSendCommand()
Dah dapat detail function ini?

Code: [Select]

*!* Original Script by VB
   Public Const MMSYSERR_NOERROR = 0
   Public Const MCI_SET = &H80D
   Public Const MCI_WAVE_OUTPUT = &H800000
   Type MCI_WAVE_SET_PARMS
       dwCallback As Long
       dwTimeFormat As Long
       dwAudio As Long
       wInput As Long
       wOutput As Long
       wFormatTag As Integer
       wReserved2 As Integer
       nChannels As Integer
       wReserved3 As Integer
       nSamplesPerSec As Long
       nAvgBytesPerSec As Long
       nBlockAlign As Integer
       wReserved4 As Integer
       wBitsPerSample As Integer
       wReserved5 As Integer
   End Type

   Declare Function mciGetErrorString Lib "winmm.dll" _
       Alias "mciGetErrorStringA" (ByVal dwError As Long, _
       ByVal lpstrBuffer As String, ByVal uLength As Long) As Long

   Declare Function mciSendCommand Lib "winmm.dll" Alias _
       "mciSendCommandA" (ByVal wDeviceID As Long, _
       ByVal uMessage As Long, ByVal dwParam1 As Long, _
       ByRef dwParam2 As Any) As Long

Yang ini script buat sendCommand untuk milih Autdio DeviceID

Code: [Select]

Dim parms As MCI_WAVE_SET_PARMS
    Dim rc As Long

    ' Specify the soundcard. This specifies the soundcard with a deviceID
    ' of 0. If you have a single soundcard, then this will open it. If you
    ' have multiple soundcards, the deviceIDs will be 0, 1, 2, etc.
    parms.wOutput = 0

    ' Send the MCI command to set the output device.
    rc = mciSendCommand(MMControl1.DeviceID, MCI_SET, _
        MCI_WAVE_OUTPUT, parms)

    if (rc <> MMSYSERR_NOERROR) then
        ' The command failed.
    End If


Nah tinggal convert to VFP aja lagi silahkan yang lain 

[yaten]

Tks mas armen atas infonya
akan saya coba untuk padanannya di foxpro

tks banyak

[armen]

Tks mas armen atas infonya
akan saya coba untuk padanannya di foxpro

tks banyak

Nah gitu donk biar dictionarinya nambah jadi bukan vfp aja hehehe

Upsss....

List PnP AudioSound pake WMI
Ini sudah saya conver ke VFP, Spesial hadiah untuk pak yaten

Code: [Select]

objWMIService = GetObject("winmgmts:\\.\root\CIMV2")
colNet = objWMIService.ExecQuery("Select deviceid, Description, DeviceClass, Location from Win32_PNPSignedDriver WHERE DeviceClass = 'MEDIA' AND Location > 0")
CREATE CURSOR curdrv (DeviceID c(50), Description c(50), DeviceClass C(20), Location C(30))
INDEX ON DeviceClass TAG Dev
FOR EACH loDev IN colNet
    IF !ISNULL(loDev.Description)
        INSERT INTO curdrv VALUES (loDev.deviceid, loDev.Description, loDev.DeviceClass, IIF(ISNULL(loDev.Location ),'',loDev.Location ))
    ENDIF
ENDFOR
BROWSE

Tinggal ganti Set Default AudioSound Direct Output, lalu Klik tombol Play pada wmp.dll......tu..tut..tut... jadi deh lagu pindah2 sampe 10 Speker beda2 tergantung jumlah Soundcard anda
Silahkan 

[yaten]

mas armen sudah sy cari untuk merubah Set Default AudioSound Direct Output itu di Wmplayer.ocx7 tapi tidak ada parameter yang berkaitan dengan audiosound direct output ?

sy coba bikin 1 form dengan :
[ rencana untuk soundcard 1 ]
olemp31 << dari wmplayer.ocx7>>
text1.value='lagu1.mp3'
cmdplay1.click=thisform.olemp31.url=text1.value
cmdStop1.click=thisform.olemp31.controls.stop

[ rencana untuk soundcard 2 ]
olemp32 << dari wmplayer.ocx7>>
text2.value='lagu2.mp3'
cmdplay2.click=thisform.olemp32.url=text2.value
cmdStop2.click=thisform.olemp32.controls.stop

saya play berbarengan (olemp31 & olemp32 )  tapi keluarnya hanya pada 1 soundcard
yang pertama saja, tidak pisah ke soundcard 2.

sudah sy lakukan perubahan di window media player / tool/option/device/speaker/<<soundcard 2>> lalu OK. kalo kita menjalankan window media player output langsung ke soundcard2 berhasil.
Tapi kalo lewat program yang kita buat,  sound yang keluar tetap semuanya ke soundcard yang 1.
Apa saya salah setting mas armen ?

Tks

[onytoo]

saya nemu link ini saat googling:

www.un4seen.com/forum/?topic=10621.0

coba di cek, dan donlod 'BASS' -nya, disitu ada dll udah jadi serta contoh dg c/delphi/vb dan dokumentasi lengkap, yg mungkin bisa dipakai untuk keperluanmu. silahkan dipelajari.
semoga berhasil. 

[armen]

mas armen sudah sy cari untuk merubah Set Default AudioSound Direct Output itu di Wmplayer.ocx7 tapi tidak ada parameter yang berkaitan dengan audiosound direct output ?

Oh...itu ya maaf mungkin post saya diatas berupa bahasa isyarat, hingga pak yaten tidak menangkpanya..heheheh
Untuk melakukan select output AudioSound, pak yaten harus merobah dulu script VB6 diatas ke script code VFP, trus panggil fungsi mciSendCommand() sebelum push File ke olemp32.url

, prinsipnya sama seperti kita melakukan Select IP Addres pada beberapa Ethernet/WIFI Adapter yang terpasang pada sistim CPU.
Demikian pak

saya nemu link ini saat googling:

www.un4seen.com/forum/?topic=10621.0

coba di cek, dan donlod 'BASS' -nya, disitu ada dll udah jadi serta contoh dg c/delphi/vb dan dokumentasi lengkap, yg mungkin bisa dipakai untuk keperluanmu. silahkan dipelajari.
semoga berhasil. 

Nah yang itu juga ada hint pak...

Silahkan dilanjut perjuangannya.

[onytoo]

nih satu lagi

http://support.microsoft.com/kb/182799

semoga berhasil 

[yaten]

Terimakasih mas armen & mas onytoo 
sy akan terus berjuang penasaran nih.

tks banyak

[manyun]

penasaran juga, bagi dong mas yaten