Français
Source/ Codesnippets

Api Midi Per Sound redonner Winmmdll

 

Jörg
Sellmeyer
là mir qui Profan-Syntax des Play-Befehls trop unflexibel ist, habe je pour Alternativen gesucht.
Pour ausführlichem Studium verschiedener Webseiten et dem Code de Sebastian Sprengers Piano-Trainer [...]  habe je es enfin rausbekommen, comment qui Midi-Api funktioniert. là es seulement ab XProfan11 fonctionne, habe je aussi une EXE beigefügt.
(dans qui Zip-Dossier ist une aktualisiert Exe, avec un paire (rudimentären) grafischen Ausgaben qui Töne)
ici ist cela Resultat. je s'il te plaît um Tests et Rückmeldungen.
KompilierenMarqueSéparation
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<
à class=s2>(Midi&) Fin

ah oui: s'il te plaît aussi la fois que voici testen: [...] 

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




Dieter
Zornow
chez mir hats sans Probleme funktioniert, habe seulement den Code getestet
 
Er ist ein Mann wie ein Baum. Sie nennen ihn Bonsai., Win 7 32 bit und Win 7 64 bit, mit XProfan X2
01.09.2008  
 



Funktioniert (furchtbar!) joli! peut-être sollte quelquefois encore entre Moll et Dur umhergeschalten volonté - et mancher Multiseptimakkord (ab et trop) serait cela ganze quelque chose abrunden.
 
01.09.2008  
 




Jörg
Sellmeyer
iF
Funktioniert (furchtbar!) joli! peut-être sollte quelquefois encore entre Moll et Dur umhergeschalten volonté - et mancher Multiseptimakkord (ab et trop) serait cela ganze quelque chose abrunden.


si mon aktuelles Programme, pour welches je cela avec qui WINMM.DLL seulement la fois ausgetüftelt habe, fertig ist, werde je la fois une virtuellen Klavierspieler erstellen, qui Musik pour Wunsch écoutes. avec Reglern pour:
Klassik---------------------------+------------------------Pop

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

Rhythmisch-------------+-------------------------------libre


 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
01.09.2008  
 



simple seulement une belle Drum-Machine (quelle sich sur une Midi-Temporegler dans qui Geschwindigkeit changement peut) wäre wohl einmalig! Habe cela avec den Knobs am Synth rausbekommen et donc cela Knob-Contrôle programmiert gehabt. cela Contrôle zeigt mir qui genaue Drehung - qui Werte hierfür peux je alors ansagen.
 
01.09.2008  
 




Jörg
Sellmeyer
à quelque chose comme Ähnlichem arbeite je justement.
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
01.09.2008  
 




Sebastian
Sprenger
Hi Jörg,
scheint trop marcher, mais à vrai dire peux je avec den Harmonien selbst (quoi fürn jazz ist cela?? ) et den Ausgaben pas viel anfangen.

un paire Tipps veux je dir la fois donner:

midiOutGetNumDevs  hat qui falsche Parameterzahl (3 statt 0; wird cela chez ImportDLL  pas überprüft? Nachtrag: si ego droite überlege, peux es wohl à peine...)
tu peux pour une Akkord calme denselben canal angeben (dans einem MIDI-canal peut plusieurs verschiedene Töne gleichzeitig klingen).
s'il te plaît pas qui Lautstärkeregelung meines Systems changement!! peut-être wusstest du mais simple seulement encore pas, comment on qui Lautstärke eines Kanals ändert:
KompilierenMarqueSéparation
 $B = ControlChange
 $07 = ChannelVolume
midiOutShortMsg(hMidiDevice&, $07B0 | Channel% | Volume% << 16)re>
Salut, 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
01.09.2008  
 




Jörg
Sellmeyer
allô SSebastian,


midiOutGetNumDevs

Hm - mais là habe je doch trois paramètre... cela habe je incidemment aus Deinem Piano Trainer et es était la première Funktion, qui je verwendet habe, um überhaupt la fois un un peu quoi de dem trop comprendre, quoi là abläuft

je suis là toujours schwer am rumexperimentieren. cet ganzen Statusbits et Messages sommes déjà quelque chose undurchschaubar, finde je.
comment peux on car un instrument im Stereobild Déplacer? ou bien ist cela Midikanal-Volume genauso geregelt, comment chez midiOutSetVolume?
sur jeden le cas merci pour qui Tips. peux bien son, qui je encore un paarmal nachhake, wenns droite ist.

Salut
Jörg

ah bon: qui Zahlenausgaben sommes unerheblich, mais qui Striche, (qui allerdings seulement dans qui Exe vorkommen), peux on comme Noten(positionen) im la mesure regarder.
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
02.09.2008  
 




Sebastian
Sprenger
Jörg Sellmeyer
mais là habe je doch trois paramètre...

qui trois paramètre chez midiOutGetDevCaps  sommes richtig. Du übergibst mais à midiOutGetNumDevs  également trois paramètre, quoique pour aucun vorgesehen sommes.
Jörg Sellmeyer
comment peux on car un instrument im Stereobild Déplacer?

Ähnlich comment qui ChannelVolume, seulement avec $0A statt qui $07:
KompilierenMarqueSéparation
 $B = ControlChange
 $0A = PanPot
midiOutShortMsg(hMidiDevice&, $0AB0 | Channel% | PanPot% << 16)re>
Beispielwerte:
0 = entier à gauche
64 = mittig
127 = entier à droite

Jörg Sellmeyer
peux bien son, qui je encore un paarmal nachhake, wenns droite ist.

seulement trop - eigentlich werde je entier volontiers avec Fragen gelöchert - zumindest, si je pas justement dans qui une école suis...
Salut, 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
02.09.2008  
 




Frank
Abbing
Huch, grad seulement entdeckt, sorry.
on, mon ordinateur ist völlig unmusikalisch, hätte plus de ihm erwartet...
 
16.10.2008  
 



Zum Quelltext


Topictitle, max. 100 marque.
 

Systemprofile:

ne...aucune Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

s'il te plaît s'inscrire um une Beitrag trop verfassen.
 

Options du sujet

12.783 Views

Untitledvor 0 min.
Sven Bader14.10.2021
p.specht10.11.2019
Michael W.26.02.2019
Jörg Sellmeyer22.01.2019
plus...

Themeninformationen



Admins  |  AGB  |  Applications  |  Auteurs  |  Chat  |  protection des données  |  Télécharger  |  Entrance  |  Aider  |  Merchantportal  |  Empreinte  |  Mart  |  Interfaces  |  SDK  |  Services  |  Jeux  |  cherche  |  Support

un projet aller XProfaner, qui il y a!


Mon XProfan
Privé Nouvelles
Eigenes Ablageforum
Sujets-La liste de voeux
Eigene Posts
Eigene Sujets
Zwischenablage
Annuler
 Deutsch English Français Español Italia
Traductions

protection des données


Wir verwenden Cookies seulement comme Session-Cookies à cause de qui technischen Notwendigkeit et chez uns gibt es aucun Cookies de Drittanbietern.

si du ici sur unsere Webseite klickst ou bien navigierst, stimmst du unserer Erfassung de Informationen dans unseren Cookies sur XProfan.Net trop.

Weitere Informationen trop unseren Cookies et en supplément, comment du qui Kontrolle par-dessus behältst, findest du dans unserer nachfolgenden Datenschutzerklärung.


d'accordDatenschutzerklärung
je voudrais keinen Cookie