English
Source / code snippets

Api Midi Per Sound Wiedergeben Winmmdll

 

Jörg
Sellmeyer
there me The Profan-Syntax the Play-Befehls To unflexibel is, have I to Alternativen sought.
After ausführlichem studies verschiedener Websites and the Code Sebastian Sprengers Piano-coach [...]  have I it finally rausbekommen, as Midi-Api functions. there it first ex XProfan11 runs, have so did i a EXE enclosed.
(in the zipper-File is a updated Exe, with a couple (rudimentären) grafischen expenses the sounds)
here's the result. I Please to test and Rückmeldungen.
CompileMarkSeparation
Code von Jörg Sellmeyer für die Profangemeinschaft

Proc MidiPlayInstrument

    Parameters hMidiDevice&,Instrument%,Channel%,Ton%,Volume%
    Declare b#
    Dim b#,8
    MidiOutShortMsg(hMidiDevice&,Instrument% * 256 + $C * 16 + Channel%)
     $C = Statusbyte zum Einstellen des Kanals
    Byte b#,0=$9 * 16 + Channel%,Ton%,Volume%,0
     $9 = Statusbyte zum Einschalten des Tones
    MidiOutShortMsg(hMidiDevice&,Long(b#,0))
    Dispose b#

EndProc

Proc MidiChannelVolume

EndProc

Proc PlayAccord

    Parameters hMidiDevice&,Instrument%,GrundTon%,Volume%
    MidiPlayInstrument(hMidiDevice&,Instrument%,5,GrundTon%,Volume%)
    MidiPlayInstrument(hMidiDevice&,Instrument%,6,GrundTon% + 5,Volume%)
    MidiPlayInstrument(hMidiDevice&,Instrument%,7,GrundTon% + 7,Volume%)

EndProc

WindowTitle "Virtual Keith Jarrett"
Cls
Set("Decimals",0)
Var hWinMMDll& = ImportDll("WINMM","")
Declare Dev#,lpHMidiOut#,shMsg#,Tick&
Dim lpHMidiOut#,16
Dim Dev#,52
print MidiOutGetNumDevs(0,Dev#,52),"Gerät(e) vorhanden"

If MidiOutGetNumDevs(0,Dev#,52) > 0

    ClearList

    WhileLoop MidiOutGetNumDevs(0,Dev#,52)

        MidiOutGetDevCapsA(0,Dev#,52)
        AddString Char$(Dev#,8,31)
        Print "Taste",&Loop,"für: q";Char$(Dev#,8,31);"q drücken"

    Wend

Else

    Print "Kein Midifähiges Gerät gefunden :("
    Print "Beliebige Eingabe beendet das Programm"
    WaitInput
    End

EndIf

Print "Welche Nummer?"
Declare Nr%
Input Nr%
Print "Device",Nr% - 1,"gewählt"
CaseNot Nr%:End
Case Nr% > MidiOutGetNumDevs(0,Dev#,52):End
MidiOutOpen(lpHMidiOut#,Nr% - 1,0,0,0)
Var Midi& = Long(lpHMidiOut#,0)
Randomize
Print "ESC zum Beenden drücken"
Declare n1%,n2%,n1alt%,n2alt%
Locate 8,1
Declare Takt&,Takte&

WhileLoop 1000

    Case IsKey(27):Break

    If &Loop Mod (1 + Rnd(6))

        n1% = 40 + Rnd(60)
        Case n1alt%:MidiPlayInstrument(Midi&,0,0,n1%,0)
        n1alt% = n1%
        MidiPlayInstrument(Midi&,Rnd(4),0,n1%,40 + Rnd(88))

    ElseIf &Loop Mod (1 + Rnd(6))

        n2% = 40 + Rnd(60)
        Case n2alt%:MidiPlayInstrument(Midi&,Rnd(4),1,n2alt%,40 + Rnd(88))
        n2alt% = n2%
        MidiPlayInstrument(Midi&,0,1,n2%,0)

    EndIf

    midiOutSetVolume(Midi&,MakeLong((78 + Rnd(50)) * 256,(78 + Rnd(50)) * 256))
    Tick& = &GetTickcount
    Sleep 125 + (Rnd(141) - 70)
    Tick& = &GetTickcount - Tick&
    Case Rnd(20) = 4:PlayAccord(Midi&,3,Rnd(40) + 30,80 + Rnd(48))

    If Takt& >= 1000

        Locate %CsrLin,1
        Print "                    "
        Print "                    "
        Print "                    "
        Locate 8,1
        Clear Takt&
        midiOutSetVolume(Midi&,$7F007F00)

    EndIf

    Add Takt&,Tick&
    Print Format$(" 000",Tick&),Format$("  000%",Tick& / 125 * 100),Format$("  0000",Takt&)

Wend

MidiOutReset(Midi&)
Locate 25,1
Print "Das war eine vom Computer qimprovisierteq Suite"
waitinput
FreeDll hWinMMDll&
MidiOutClose<
on class=s2>(Midi&) End

alas Yes: Please too time that here testing: [...] 

447 kB
Hochgeladen:09/01/08
Downloadcounter290
Download
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
09/01/08  
 




Dieter
Zornow
by me hats without Problems functions, have only whom code tested
 
Er ist ein Mann wie ein Baum. Sie nennen ihn Bonsai., Win 7 32 bit und Win 7 64 bit, mit XProfan X2
09/01/08  
 



functions (awful!) beautiful! Perhaps ought to sometimes yet between Moll and Dur umhergeschalten go - and some Multiseptimakkord (now and than) would the whole something round down.
 
09/01/08  
 




Jörg
Sellmeyer
iF
functions (awful!) beautiful! Perhaps ought to sometimes yet between Moll and Dur umhergeschalten go - and some Multiseptimakkord (now and than) would the whole something round down.


If my News Program, for which I with the the WINMM.DLL first time ausgetüftelt have, is done, I will time a virtual Klavierspieler create, the music to wish game. with Reglern for:
Klassik---------------------------+------------------------Pop

Straight-----------------------------------------+---------Jazzy

Rhythmisch-------------+-------------------------------spare


 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
09/01/08  
 



simply only a nice thatswhy-Machine (which itself a Midi-Temporegler in the speed Change can) would well einmalig! have with the whom Knobs on the Synth rausbekommen and therefore the Knob-Control program had. the Control shows me The detailed turn - The values this can I means announce.
 
09/01/08  
 




Jörg
Sellmeyer
on something like Ähnlichem work I straight.
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
09/01/08  
 




Sebastian
Sprenger
Hi Jörg,
shining To functions, but sincere said can I with the Harmonien self (what fürn jazz is the?? ) and the expenses not plenty begin.

a couple Tipps I will you time give:

midiOutGetNumDevs  has The incorrect Parameterzahl (3 instead of 0; becomes the with ImportDLL  not screen? Nachtrag: If ichs right consider, can it well hardly...)
You can for a accord quiet the same channel indicate (in one MIDI-channel can several different sounds at the same time sound).
Please not The Lautstärkeregelung of my Systems Change!! Perhaps known You but just not yet, How one The Volume one Kanals changes:
CompileMarkSeparation
 $B = ControlChange
 $07 = ChannelVolume
midiOutShortMsg(hMidiDevice&, $07B0 | Channel% | Volume% << 16)re>
Greeting, Sebastian
 
Profan² 7.0e, XProfan 9, 11.2a, FreeProfan32
Windows Vista Home Premium 32-Bit, 2.8 Ghz, 4 GB RAM
Windows Me, 1.8 Ghz, 256 MB RAM
09/01/08  
 




Jörg
Sellmeyer
Hello SSebastian,


midiOutGetNumDevs

Hm - but since have I still three Parameter... the have I incidentally from Your Piano coach and it was The first function, The I uses have, circa at all time one little of what the To understand, what there expires

i'm there still heavy on the might try experimenting. These whole Statusbits and Messages are already something undurchschaubar, find I.
How can because one instrument in the Stereobild move? or is the Midikanal-Volume just as geregelt, How with midiOutSetVolume?
On each drop thanks for hints. can well his, that I another paarmal nachhake, ifs right is.

Greeting
Jörg

I see: The Zahlenausgaben are beside the point, but the Striche, (The though only in the Exe vorkommen), can as notes(positions) in the beat standing.
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
09/02/08  
 




Sebastian
Sprenger
Jörg Sellmeyer
but since have I still three Parameter...

The three Parameter with midiOutGetDevCaps  are correctly.. You commit but on midiOutGetNumDevs  ditto three Parameter, though for no vorgesehen are.
Jörg Sellmeyer
How can because one instrument in the Stereobild move?

Similar as ChannelVolume, only with $0A instead of the $07:
CompileMarkSeparation
 $B = ControlChange
 $0A = PanPot
midiOutShortMsg(hMidiDevice&, $0AB0 | Channel% | PanPot% << 16)re>
Beispielwerte:
0 = integrally left
64 = center
127 = integrally right

Jörg Sellmeyer
can well his, that I another paarmal nachhake, ifs right is.

go ahead - really I will integrally gladly with ask gelöchert - at least, if I not straight in the school be...
Greeting, Sebastian
 
Profan² 7.0e, XProfan 9, 11.2a, FreeProfan32
Windows Vista Home Premium 32-Bit, 2.8 Ghz, 4 GB RAM
Windows Me, 1.8 Ghz, 256 MB RAM
09/02/08  
 




Frank
Abbing
Huch, strain first discover, sorry.
one, my computer is completely unmusikalisch, had More of it expects...
 
10/16/08  
 



Zum Quelltext


Topictitle, max. 100 characters.
 

Systemprofile:

no Systemprofil laid out. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Please register circa a Posting To verfassen.
 

Topic-Options

12.810 Views

Untitledvor 0 min.
Sven Bader10/14/21
p.specht11/10/19
Michael W.02/26/19
Jörg Sellmeyer01/22/19
More...

Themeninformationen



Admins  |  AGB  |  Applications  |  Authors  |  Chat  |  Privacy Policy  |  Download  |  Entrance  |  Help  |  Merchantportal  |  Imprint  |  Mart  |  Interfaces  |  SDK  |  Services  |  Games  |  Search  |  Support

One proposition all XProfan, The there's!


My XProfan
Private Messages
Own Storage Forum
Topics-Remember-List
Own Posts
Own Topics
Clipboard
Log off
 Deutsch English Français Español Italia
Translations

Privacy Policy


we use Cookies only as Session-Cookies because of the technical necessity and with us there no Cookies of Drittanbietern.

If you here on our Website click or navigate, stimmst You ours registration of Information in our Cookies on XProfan.Net To.

further Information To our Cookies and moreover, How You The control above keep, find You in ours nachfolgenden Datenschutzerklärung.


all rightDatenschutzerklärung
i want none Cookie