| |
| |
|
Findus | Professor Chaos (27.02.2013)
Un 2 Jahre alte Spielerei a una (tal vez zurecht) seltenen Programmierthema... Genauer dijo: Ein Nachbau des en XProfan eingebauten Befehls "Music" - el con el Makrosprache de el alten MS-DOS-QBasic. Das besondere daran es, dass el Musik mehrstimmig ser darf y el Hauptprogramm während el Musikwiedergabe todavía de otra manera hacer kann. Konzipiert wurde todos como Incluir para XProfan 9 (y neuer). Un Demo dazu: KompilierenMarcaSeparación $I PolyMusic.inc
declare a$,b$,c$,d$,e$
usermessages 16' Fensterschließen abfangen
windowtitle "Ludwig van Beethoven - Rondo a Capriccio Op. 129 (Die Wut über den verlorenen Groschen)"
windowstyle 26
cls
a$="T160 K0 O5"
a$=a$+"L8 B4 MS >DDGG MN B4 L16"
a$=a$+">DCDC MS <A8 P8 MN"
a$=a$+">DCDC MS <A8 P8 MN <"
a$=a$+"L8 B4 MS >DDGG MN B4 L16"
a$=a$+">DCDC MS <A8 MN ABG4P4 L16"
a$=a$+"BAGF#EF#GA L8 MS BB MN >E4 L16"
a$=a$+"ED#ED# MS <B8 P8 MN >"
a$=a$+"ED#ED# MS <B8 P8 MN"
a$=a$+"BAGF#EF#GA L8 MS BB MN >E4"
a$=a$+"L32 C#C#C#C#C#C#C#C#C#C#C#C# L16 <B>C# L4 D<D"
b$="T160 K1 O4 L8 GGGG GGGG GGGG GGGG GGGG GGGG GGGG GGGG EEEE EEEE<BBBB BBBB>EEEE EEEE<AAAA>DDDD"
c$="T160 K2 O4 L8 BBBB BBBB>CCCC CCCC<BBBB BBBB>CCCC<BBBB GGGG GGGG EEEE EEEE GGGG GGGG EEEE F#F#F#F#"
d$="T160 K3 O5 L8 DDDD DDDD DDDD DDDD DDDD DDDD DDDD DP.4<BBBB BBBB AAAA AAAA BBBB BBBB GGGG AAAA"
e$="T160 K4 O5 L8 P1 F#F#F#F#F#F#F#F# P1 F#F#F#F# GP.4 P1 <BBBB BBBB P1 AAAA"
polymusic_start a$,b$,c$,d$,e$
' Bis jemand das Fenster schließt oder das Stück zu Ende ist, regelmäßig...
settimer 10
while (%umessage<>16) and polymusic_playing()
waitinput
' ...das Stück spielen...
polymusic_run' (Diese Prozedur möglichst oft aufrufen!)
' ...und dabei irgendwas tun. Bunte Kreise malen zum Beispiel.
usebrush 1,rnd(255)*257
ellipse rnd(640),rnd(480)-rnd(640),rnd(480)
endwhile
' Ressourcen freigeben
killtimer
polymusic_stop
El wichtigen Befehle y Características son: polymusic_start S[,S[,S]...] Initialisiert una mehrstimmiges Musikstück. Für jede Stimme en diesem Stück übergibt uno una String. Das Formato uno solchen Cuerdas es kompatibel con el XProfan-Befehl Music. Siehe XProfan-Ayuda. polymusic_run Muss oft y regelmäßig - z.B. todos 20 Millisekunden - aufgerufen voluntad, así el Musik kommt. polymusic_stop Stoppt todos laufenden Noten y son sämtliche Ressourcen frei. polymusic_playing() Gibt 1 zurück, solange el Stück se ejecuta, ansonsten 0. Ach sí, y natürlich el PolyMusic.inc incluso: KompilierenMarcaSeparacióndeclarar _dev%,_hmo&,_trx%,_lat&,_key%[6]
declarar _dur&[14],_dly&[14],_trk$[14],_pos%[14]
declarar _k%[14],_t%[14],_l%[14],_o%[14],_m%[14]
_dev%=-1
_key%[0]=9
_key%[1]=11
_key%[2]=0
_key%[3]=2
_key%[4]=4
_key%[5]=5
_key%[6]=7
def midiOutGetNumDevs(0) !"WINMM","midiOutGetNumDevs"
def midiOutGetDevCaps(3) !"WINMM","midiOutGetDevCapsA"
def midiOutOpen(5) !"WINMM","midiOutOpen"
def midiOutShortMsg(2) !"WINMM","midiOutShortMsg"
def midiOutClose(1) !"WINMM","midiOutClose"
'def SetTimer(4) !"USER32","SetTimer"
'def KillTimer(2) !"USER32","KillTimer"
def polymusic_playing(0) _hmo&<>0
proc polymusic_adddevices
declarar a#
dim a#,52
whileloop 0,midiOutGetNumDevs()-1
midiOutGetDevCaps(&bucle,a#,52)
addstring char$(a#,8,32)
endwhile
disponer a#
ENDPROC
proc polymusic_usedevice
_dev%=%(1)
ENDPROC
proc polymusic_stop
casenot _hmo&:volver
'KillTimer(%hwnd,1)
whileloop 0,15
midiOutShortMsg(_hmo&,$78B0 | &bucle)' AllSoundsOff
endwhile
midiOutClose(_hmo&)
clear _hmo&,_lat&,_dly&[],_k%[]
ENDPROC
proc polymusic_run
'set("FastMode",1)
'parámetros wnd%,msg%,evt%,tim&
declarar a%,b%,c%,trk%,tim&
proc _polychar
declarar a%
a%=ord(mid$(_trk$[trk%],_pos%[trk%],1))
_pos%[trk%]=_pos%[trk%]+1
volver a%
ENDPROC
proc _polyint
declarar a%,b%,c%
b%=0
c%=-1
mientras que 1
a%=_polychar()
if (a%<48) or (a%>57)
_pos%[trk%]=_pos%[trk%]-1
romper
endif
b%=b%*10+a%-48
c%=b%
endwhile
volver c%
ENDPROC
tim&=&gettickcount
casenot _lat&:_lat&=tim&
tim&=tim&-_lat&
trk%=15
mientras que trk%
dec trk%
casenot _pos%[trk%]:continue
if _dur&[trk%] and (tim&>=_dur&[trk%])
midiOutShortMsg(_hmo&,$7BB0 | _k%[trk%])' AllNotesOff
_dur&[trk%]=0
endif
caso tim&<_dly&[trk%]:continue
mientras que 1
a%=_polychar()
if (abs(a%-68)<4) or (a%=80)
b%=_polychar()
ifnot a%=80
a%=_key%[a%-65]+_o%[trk%]
if abs(b%-39)=4
inc a%
b%=_polychar()
elseif b%=45
dec a%
b%=_polychar()
endif
midiOutShortMsg(_hmo&,$7F0090 | _k%[trk%] | (a% << 8))' NoteOn
endif
casenot b%=46:_pos%[trk%]=_pos%[trk%]-1
a%=_polyint()
caso a%<0:a%=_l%[trk%]
a%=240000\_t%[trk%]\a%
caso b%=46:a%=a%+a% >> 1
_dur&[trk%]=_dly&[trk%]+a%*_m%[trk%]\8
_dly&[trk%]=_dly&[trk%]+a%
romper
elseif a%=62
caso _o%[trk%]<96:_o%[trk%]=_o%[trk%]+12' > (1 Oktave hoch)
elseif a%=60
caso _o%[trk%]>0:_o%[trk%]=_o%[trk%]-12' < (1 Oktave runter)
elseif a%<>77
if a%=32
_pos%[trk%]=0
dec _trx%
romper
endif
b%=_polyint()
if b%>=0
if a%=76
_l%[trk%]=b%' Longitud
elseif a%=79
_o%[trk%]=b%*12' Oktave
elseif a%=86
midiOutShortMsg(_hmo&,$7B0 | _k%[trk%] | (b% << 16))' Volume
elseif a%=73
midiOutShortMsg(_hmo&,$C0 | _k%[trk%] | (b% << 8))' Instrument
elseif a%=84
_t%[trk%]=b%' Tempo
elseif a%=75
_k%[trk%]=b%' Kanal
endif
endif
más
a%=_polychar()
if a%=78
_m%[trk%]=7' MNormal
elseif a%=83
_m%[trk%]=4' MStaccato
elseif a%=76
_m%[trk%]=8' MLegato
endif
endif
endwhile
endwhile
casenot _trx%:polymusic_stop
'set("FastMode",0)
ENDPROC
proc polymusic_start
declarar a$,pcount%,p$[14]
pcount%=%pcount
whileloop 1,pcount%
p$[&bucle-1]=$(&bucle)
endwhile
polymusic_stop
casenot pcount%:volver 1
casenot midiOutOpen(addr(_hmo&),_dev%,0,0,0)=0:volver 0
whileloop 0,15
midiOutShortMsg(_hmo&,$79B0 | &bucle)' ResetAllControllers
midiOutShortMsg(_hmo&,$C0 | &bucle)' ProgramChange := Acoustic Grand Piano
midiOutShortMsg(_hmo&,$6407B0 | &bucle)' Channel Volume := 100
endwhile
_trx%=pcount%
whileloop 0,_trx%-1
a$=translate$(p$[&bucle]," ","")
_trk$[&bucle]=translate$(upper$(a$),"H","B")+" "
_pos%[&bucle]=1
_t%[&bucle]=120
_l%[&bucle]=4
_o%[&bucle]=48
_m%[&bucle]=7
endwhile
'SetTimer(%hwnd,1,10,procaddr(_polymusic_run,4))
volver 1
ENDPROC
|
|
| |
| |
| |
|
(894)
Deutsch
English
Français
Español
Italia