Geen SOUND commando

Alles over het toepassen van API en DLL's in Liberty BASIC

Moderator: anthonio

Geen SOUND commando

Berichtdoor Gordon » vr maart 21, 2008 5:49 pm

Waarom hoor ik hier niets?

Code: Selecteer alles
'NoMainWin


    note=48                 'will contain value for note
    sndlen = 400

    WindowWidth=640:WindowHeight=240
    UpperLeftX=10:UpperLeftY=10

    msg$="To play the piano, click the keys with your mouse " _
    +"or type on keyboard. Select a voice from the combobox."


[windowSetup]
    Button #p.default, "Close",[quit],UL,520,15,96,30
    Statictext #p, "Select Instrument",15,5,200,20
    Graphicbox #p.g, 0, 70,638,100
    Statictext #p.vol, msg$,15,180,550,40

Open "Electronic Piano" For Window_nf As #p

    LoadBmp "piano","bmp\piano6.bmp"

    #p.g   "down;drawbmp piano 0 0;flush"
    #p.g   "setfocus; when leftButtonDown [newNote]"
    #p.g   "when leftButtonUp [endNote]"
    #p     "trapclose [quit]"


    'Wnd=hWnd(#p.g)  'handle of graphicbox
    'get device context for graphicbox
    'CallDLL #user32, "GetDC",_
    '    Wnd As long,  hDC As long

    'open midi device and obtain handle
    'midi functions return 0 if successful
    struct m, a$ As ptr
    CallDLL #winmm, "midiOutOpen",_
        m As struct,-1 As long,0 As long,_
        0 As long,0 As long,ret As long

    hMidiOut=m.a$.struct    'handle to midi device

    print hMidiOut  'return 0
    print ret       'return 4 no good

    Wait

[quit]'stop note, close midi device, DLLs, window
    timer 0
    UnloadBmp "piano"
    CallDLL #winmm, "midiOutClose", hMidiOut As ulong,_
        ret As ulong

    'CallDLL#user32,"ReleaseDC",_
    '    Wnd As long,hDC As long,result As long
    Close #p
    End


[newNote]

    'play new note:
    'gosub [stopNote]
    event=144              'event 144 = play on channel 1
    low=(note*256)+event
    velocity=127
    hi=velocity*256*256
    dwMsg=low+hi
    CallDLL #winmm, "midiOutShortMsg",hMidiOut As ulong,_
        dwMsg As ulong, ret As ulong

  ' NOTE LENGTH
    tim = time$("ms") :  while time$("ms") < tim  +sndlen : wend

    print ret  'this produces a 5
'

'[stopPlay]'stop all notes from playing
'    event=128    'event 128 = stop play
'    low=(note*256)+event
'    dwMsg=low+hi
'    CallDLL #winmm, "midiOutShortMsg",hMidiOut As ulong,_
'        dwMsg As ulong, ret As ulong
'    timer 0
    wait

[endNote]
print "hallo"
wait




Gordon
Avatar gebruiker
Gordon
Site Admin
 
Berichten: 684
Geregistreerd: zo mei 22, 2005 12:50 am

Re: Geen SOUND commando

Berichtdoor Gordon » vr maart 21, 2008 10:42 pm

Oeps.... het programma (bovenstaande listing) doet het normaal.

Hier volgt een volgende poging om te komen tot een soort SOUND commando.
Code: Selecteer alles
NoMainWin


    note=48                 'will contain value for note
    sndlen = 50

    WindowWidth=640:WindowHeight=240
    UpperLeftX=100:UpperLeftY=100

    msg$="To play the piano, click the keys with your mouse " _
    +"or type on keyboard. Select a voice from the combobox."


[windowSetup]
    Graphicbox #p.g, 0, 70,638,100
    Statictext #p.vol, msg$,15,180,550,40

Open "Electronic Piano" For Window_nf As #p

    LoadBmp "piano","bmp\piano6.bmp"
    #p.g   "down;drawbmp piano 0 0;flush"

    #p.g   "setfocus; when leftButtonDown [newNote]"
    #p     "trapclose [quit]"




    'open midi device and obtain handle
    'midi functions return 0 if successful
    struct m, a$ As ptr
    CallDLL #winmm, "midiOutOpen",_
        m As struct,-1 As long,0 As long,_
        0 As long,0 As long,ret As long
    hMidiOut=m.a$.struct    'handle to midi device
    Wait

[quit]
    UnloadBmp "piano"
    CallDLL #winmm, "midiOutClose", hMidiOut As ulong,_
        ret As ulong
    Close #p
    End


[newNote]
    event=144              'event 144 = play on channel 1
    low=(note*256)+event
    velocity=127
    hi=velocity*256*256
    dwMsg=low+hi
    CallDLL #winmm, "midiOutShortMsg",hMidiOut As ulong,_
        dwMsg As ulong, ret As ulong
  ' NOTE LENGTH
    'tim = time$("ms") :  while time$("ms") < tim  +sndlen : wend

wait



Gordon
Avatar gebruiker
Gordon
Site Admin
 
Berichten: 684
Geregistreerd: zo mei 22, 2005 12:50 am


Keer terug naar API/DLL

Wie is er online

Gebruikers op dit forum: Geen geregistreerde gebruikers. en 1 gast

cron