PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Töne im Bereich 0-300 Hz erzeugen...

https://www.purebasic.fr/german/viewtopic.php?t=25022

Seite 1 von 2

Töne im Bereich 0-300 Hz erzeugen...

Verfasst: 03.12.2011 01:20
von dl5ndh
Hallo PB-Freunde,
wer weiß, wie man auf einfache weise einfache Töne im Bereich 0-300 Hz
erzeugen kann? Ich möchte also keine Töne mit einem Fremdprogramm erzeugen und in eine
Wave-Datei speichern, um diese dann aufzurufen.
Wie geht das einfacher? Ich brauche nämlich eine größere Anzahl von Tönen.
Vielen Dank schon 'mal für die Antwort

LG Gerhard

Re: Töne im Bereich 0-300 Hz erzeugen...

Verfasst: 03.12.2011 01:48
von STARGÅTE
Du musst nicht jeden Ton als Datei speichern, aber zumindest einen Grundton brauchst du.
Dann kannst du mit SoundFrequency() die Frequenz ändern und das in Echtzeit.

Hier mal ein Beispiel für einen Sinuston zwischen 100Hz und 900Hz:

Code: Alles auswählen

Enumeration
	#Window
	#Sound
	#TrackBarGadget
	#StringGadget
EndEnumeration

InitSound()

UseOGGSoundDecoder()

CatchSound(#Sound, ?Sinus300, 6256)

OpenWindow(#Window, 0, 0, 500, 30, "WindowTitle", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
	TextGadget(#PB_Any, 5, 5, 50, 20, "Frequenz")
	TrackBarGadget(#TrackBarGadget, 60, 5, 400, 20, 100, 900)
	StringGadget(#StringGadget, 465, 5, 30, 20, "300")
	SetGadgetState(#TrackBarGadget, 300)
	
	PlaySound(#Sound, #PB_Sound_Loop, 20)
	
Repeat
	
	Select WaitWindowEvent()
			
		Case #PB_Event_CloseWindow
			End
			
		Case #PB_Event_Gadget
			Select EventGadget()
				Case #TrackBarGadget
					SoundFrequency(#Sound, 44100*GetGadgetState(#TrackBarGadget)/300)
					SetGadgetText(#StringGadget, Str(GetGadgetState(#TrackBarGadget)))
				Case #StringGadget
					SoundFrequency(#Sound, 44100*Val(GetGadgetText(#StringGadget))/300)
					SetGadgetState(#TrackBarGadget, Val(GetGadgetText(#StringGadget)))
			EndSelect
			
	EndSelect
	
ForEver


DataSection
	Sinus300:
	Data.q $000002005367674F,$74D4000000000000,$9F4F000000000000,$726F76011E0141FB,$0100000000736962
	Data.q $000000000000AC44,$000000000003A930,$00005367674F01B8,$0000000000000000,$00000001000074D4
	Data.q $FFFF2D1146ED2FF5,$FFFFFFFFFFFFFFFF,$7603D5FFFFFFFFFF,$00001D736962726F,$724F2E6870695800
	Data.q $726F5662696C2067,$3032204920736962,$0000393236303430,$62726F7605010000,$00015643422B7369
	Data.q $C5204C3100000008,$001000005590D080,$4966930E29246000,$94987928A194A529,$8930C594A5294948
	Data.q $318C6318C5899498,$6318C6318C6318C6,$040000156434208C,$49E6A38E09288000,$728E27186739CE6A
	Data.q $0720A7384E6939A0,$26F5C20939E0518A,$CE6E6BA6B4A66E63,$000005590D082529,$5214852148400002
	Data.q $8621886214852148,$C8721C8721886218,$A0A82A0A729CA721,$324C8320C8320A82,$A3A8E93A4E93A4E9
	Data.q $0B42D0B428EA3A8E,$56D5314C4AD2B42D,$CE737C5D06BDAE63,$9CE739CE739CE739,$000156434209CE73
	Data.q $6419064204000020,$8852148521084210,$80C8320A7298A629,$80002000005590D0,$4914914700000000
	Data.q $24D1CD1CB1CB14B1,$33D13513512CF24F,$555555554D545345,$7576D76576575D75,$B85B8598597D76D7
	Data.q $5D85D85B85B8597D,$86186186186185F7,$F7DF7DF861861861,$156434207DF7DF7D,$963923A000012000
	Data.q $39E2A21A22A229E3,$640002AC868403A2,$2292092000040000,$AE6A66A649A39229,$CB6DB6AB68B69B69
	Data.q $AC86840CB2CB2CB2,$0000040001000002,$69A69A69A0000000,$A69A69A69A69A69A,$9A69A69A69A69A69
	Data.q $5965965965965966,$6596596596596596,$9659659659659659,$5965965965965965,$6840596596596596
	Data.q $C740000240002AC8,$2452452471C71C71,$05590D08072C72C7,$524000080000C800,$C73473473472C52C
	Data.q $4474473C73C73C73,$080F4CF4CD4C94C9,$080002000005590D,$1C31400000000000,$524F24D1C91C71C5
	Data.q $D73D73573572D32D,$5555575D75D74D73,$5555555555555555,$5555555555555555,$5555555555555555
	Data.q $5555555555555555,$000400005590D081,$08806A96669D2100,$0015643420619033,$4308A11800000080
	Data.q $04000005590D080C,$D09A20E4A1880000,$A0E59A0E39CDF39A,$9B5489C1D39B14A9,$39CE739B98A9B927
	Data.q $739CE319CE6C9CE7,$D099A0C599CA29CE,$A0A59A0C49CE739A,$9B1279CE739AD099,$19CE739AD2A9AD07
	Data.q $739C6119C60E9CE7,$58D9A9079AD269CE,$A8E69AD059CE739B,$9B9489CE739B14B9,$39CE739B54B9B527
	Data.q $739CE739CE739CE7,$E139C1CE9C5EA9CE,$B96B9BDA89CE739C,$9C64F9CE739C5D09,$39CE739CE109CDEE
	Data.q $739CE739CE739CE7,$40000156434209CE,$9DC618D861040000,$211462068E7D2082,$930E8F741E9321A6
	Data.q $8E8D1EA429C831A0,$2719525083A94A46,$00005590D08274A5,$2148521084000020,$5214852148521485
	Data.q $A721886218862148,$8A92A4A82A0A729C,$2CCB32CCB328CA2A,$3ACEC3ACCB32CCB3,$B4310C4310C3B0EB
	Data.q $8D6356D5352C4AD2,$6B4839AE739EE6B5,$5294A52B5AD6B5A5,$0015643420A5294A,$4190642040000200
	Data.q $8621485214851906,$0A82A0A729CA7298,$0002000005590D08,$11CF24F000000008,$D11D11D11D11D11D
	Data.q $1CF1CF1D11D11D11,$32D1251251251251,$575554553D33532D,$85B7DB7597596D76,$D7DF7DD7DF75D85D
	Data.q $6596596586175F8D,$9659659659659659,$5643420965965965,$0842000000200001,$9485214852148421
	Data.q $424E839CC7318C62,$2000005590D08109,$7147000000008000,$4B2491C91C91C714,$34F2CD2CD24D24B2
	Data.q $34514513D134F34F,$D37515D15D15534D,$6535D35D36536516,$B6D96576D56555D3,$DF7DB6597DB75B65
	Data.q $7DF7DF7DF7DF7DF7,$342075D7DF7DF7DF,$23A0000120001564,$8E39229229229239,$02AC8684049248E3
	Data.q $28A0000400006400,$249249238E38E28E,$9A89679679269259,$840AA2A9E99E99A9,$040001000002AC86
	Data.q $8A68A00000000000,$88E78A88A78A98A7,$AA9A89699689288E,$AEBAEBAECA6CA2B9,$BAEBAEBAEBAEBAEB
	Data.q $EBAEBAEBAEBAEBAE,$AEBAEBAEBAEBAEBA,$BAEBAEBAEBAEBAEB,$000240002AC86840,$4524724724724740
	Data.q $0D08072472452452,$00080000C8000559,$B2C72452431C31C0,$D134F34F34F34D2C,$4574553D33D13D13
	Data.q $02000005590D0817,$C000000000000800,$24D1CD1CB14B0C90,$52D53552D52D5251,$555555553D54552D
	Data.q $5555555555555555,$5555555555555555,$5555555555555555,$4D34D55555555555,$00009590D08134D3
	Data.q $842108C5E8000019,$57BE105A96A39210,$66315EF7352839CA,$8E4198A57BDEC414,$B528394A6299F072
	Data.q $5B5C9188A531CEA7,$553A0E61C422912B,$0849D6E741A8294E,$510004564342072D,$18C4318842000000
	Data.q $318C4420C8418C62,$8321063188841908,$08329485250841D0,$D08318C452909521,$194942948420C941
	Data.q $800000A548529094,$D0A10B0080000700,$8200009C40011590,$1063150831887390,$18AA521074A9083A
	Data.q $4A0E732527399083,$63154A4A10A52528,$0949CE6424E73210,$9083A9494A14A425,$296A4A50A5A52852
	Data.q $5210762D4A5318A5,$B529694A14A4A50A,$08318AC62D4A5B14,$5284A4E732527399,$A5273996A4A50A5A
	Data.q $529294A107529083,$74A4E732D6A4A56B,$6952529420E949D0,$92B525285AD494A9,$316B5AD695256B52
	Data.q $4A14A4A50C62D6A6,$B6296A62D4A4AD69,$E732106315AC5AD6,$14A4A50949CE64A4,$21074A4E732D494A
	Data.q $4AD695252941CE95,$9420E949CE65A949,$495AD2A4A52841D2,$D6A5254B4A50B5A5,$A94C62D6B5AD2942
	Data.q $5AD4A4AD494A1AB5,$B5ADAD5AD4B5A949,$0A5A528529083B18,$16A5318A5A96B4A5,$256B5292B5A52863
	Data.q $62D6B6B56B5AD6A5,$A4AD695254B4A50C,$AC5AD6C6AD6A5AD4,$D6B6316B5318A5A9,$39CD631CC6318D6A
	Data.q $5AD4C6296A6314A5,$7735AC631CB62D8C,$494A16A4A50A5210,$50C62D6A6314B52D,$2D494AD695256A4A
	Data.q $4A1AC5AD4C6AD6B6,$B5A9495AD4A4AD69,$4A531AB5AD8D5AD6,$18C5A94C6AD6A631,$2D6A7318B5B5CC63
	Data.q $6318B5A9AC5AD6C6,$00002D6B18C735AC,$3284C0200001C060,$000A20004AC86850,$08339CC621063100
	Data.q $18A520C68418C529,$22107398C5291083,$7398C6420E7318A5,$29420E7318C94A10,$1083A9494A12841D
	Data.q $E05000001529294A,$E2C4A68360100000,$02420004AC868500,$E739CC6294841800,$8C52908452929420
	Data.q $108A5252841CE739,$4A50839CE7318A52,$841CE6314C52954A,$C6314A52A96A5252,$8C65A94A4A50839C
	Data.q $A9494A10841CE631,$4210839CC6318CB5,$741CE739D6B52929,$E73AD8A5A5494A12,$D6A525294A10839C
	Data.q $A5494A10841CE75A,$4210839CEB62D6A5,$84218B5AD4A52529,$8B6296A525494A52,$94A525294A528431
	Data.q $A94A525496318B5A,$4A52C6B18B62D6A5,$C6318B5AD6A5294A,$8C62D6B5A96A529A,$D6B5A94A535AC6B1
	Data.q $00016B5AC6318B5A,$D0460100000E0700,$85C268D845954649,$1440011590D0A007,$86310C620C600000
	Data.q $0C7391083210739C,$A4E949CE72210742,$4A4CA52169425264,$74A4E73916A42548,$265250A5A1293252
	Data.q $EC0000295A54A425,$342842C0EC0001C0,$2100000790002564,$529486318C6314A4,$C5294A431CC6318A
	Data.q $8C6318A5298C6318,$98C6318C5294E731,$39CE731CC6318C73,$631CE739CC6318C6,$C6318E739CE731CC
	Data.q $CE731CC739CE739C,$9CE739CE639CE739,$00702A000009CE73,$9182736451B00800,$00A90002564342A0
	Data.q $841CE6314A318400,$0839CE7318851A52,$10739CE6314834A5,$A50839CE7318A94A,$4A10739CE6315294
	Data.q $94210839CE732529,$284210739CE65292,$5284210839CEA525,$A1284210739D4A4A,$525294A508429494
	Data.q $94A5294A1085A94A,$4A529294A52A5A54,$94A525294A56B5A9,$0704F00000AD6A5A,$293847561B02A000
	Data.q $90002564342C0B1A,$0641908318C00001,$1084210842106321,$0070180000090842,$B21A140CA1300800
	Data.q $520C000005480012,$C52914A4A507318A,$8A5229494A107398,$98C552929420E731,$318AB5A9494A1073
	Data.q $739D6B52929420E7,$E73B18B5A9494A10,$1086316B52929420,$210C6318B5A9494A,$4A5AD6316B529294
	Data.q $94B5CC6B18B5A949,$4A6B5AD6316B5292,$94E735AD6B18B5AD,$05CE735AD6316B5A,$D81D800038342000
	Data.q $A16058D149C23AB0,$4800003C80012B21,$14A5318C6318C629,$318A5298C6318C63,$6318C6318C6318C6
	Data.q $C6318C6318A6318C,$8C6318C6318C6318,$18C6318C6318C631,$318C6318E6318C63,$6318C639CC6318C6
	Data.q $C6318C631CE6398C,$03815000004E739C,$8C139B228D804000,$07080012B21A1504,$20E739CC618C0000
	Data.q $42107394A34A9094,$839CA51A56952528,$273996B529294212,$CCB62D6A5252A525,$2D6B529295292939
	Data.q $62D6A52D6A521276,$B5A96B529083B1AC,$8A5A52841D8D6316,$929420ED731AC62D,$A5286B5AC6316B5A
	Data.q $439AD6B1AC62D8A5,$E735AD6316B5A929,$CD6B5AC62D6A525C,$5AC6316B5292E7B5,$B1AC62D6A7B9AD6B
	Data.q $6316B53DEF735CD6,$0005CE7B9CE6B58D,$38D8254000383C98,$A17068E159D24AC3,$460000DC80012B21
	Data.q $2108420E739CC629,$398C529508421084,$8421084210841CE7,$0839CE7318A52A10,$8C64210842108421
	Data.q $21084210741CE739,$39CE7318C8421084,$8421084210842108,$084210841CE739D0,$CE73A52942508421
	Data.q $2108421084210739,$4210841CE74A5084,$94A5284A12842108,$08421084210839CE,$108421294A5284A5
	Data.q $A5294A1284210842,$42108421083A5294,$84A5294A5294A508,$294A108421084210,$108421094A5294A5
	Data.q $A5294A5294210842,$4A12842108421294,$8425294A5294A529,$294A5294A1084210,$528421084A5294A5
	Data.q $A5294A5294A5294A,$4A52942128421094,$8421294A5294A529,$294A5294A5284A12,$52942508425294A5
	Data.q $A5294A5294A5294A,$4A5294A528421084,$9421094A5294A529,$294A5294A5294A52,$0381D000005294A5
	Data.q $A762169511804000,$26190A23811E5719,$00E10002564342A0,$A5294A5294210000,$4A5294A5246A5294
	Data.q $94A525235294A529,$294A5294A5294A52,$5294A5294A5294A5,$A5294A5294A5294A,$4A5294A5294A5294
	Data.q $94A5294A5294A529,$294A5294A5294A52,$5294A5294A5294A5,$A5294A5294A5294A,$4A5294A5294A5294
	Data.q $94A5294A5294A529,$294A5294A5294A52,$5294A5294A5294A5,$94A5294A5294A54A,$294A5294A5294A52
	Data.q $A800A5294A5294A5,$671B09E8C0070CCB,$342E0D1C2B3A4958,$1800001690002564,$94A127418E6398C3
	Data.q $E8425082986B5A94,$4A35B16C4AD2A4A4,$AD4A525284210841,$4A9294A8E832D6B5,$83998C6316C5AD4A
	Data.q $8C62D4A5252A5252,$16B52D4A420ED6B1,$A1076B5AE6B18B5B,$6B5AC62D8B5A94A4,$E5AD6B4A9083BDAE
	Data.q $2841DAE739B06318,$5AD7358C62D8B529,$B58C6316B4A90E7B,$52528839CD6B5CF6,$F735CD731AD6318A
	Data.q $AE6B9AC5AD4A4BDC,$D8A5A610739F0735,$3A107B9CE7358D6A,$741EE6B98D5AD4F8,$D6AD4A741EE741D0
	Data.q $F07C21073DCE6B5A,$DEE735CD6B58B5B9,$35AB6ADF083A0F83,$839EF73DEF6B5CE7,$07C1D0735CD6316E
	Data.q $CF6B18B841F07C21,$1EF83A0E841CF739,$5C4000708DC8000C,$88D2B0CB3A909230,$B21A148110C04F1B
	Data.q $418C20000188000A,$A5294A5294842106,$8C6318C6298A6294,$18C6318C6318C631,$26000004C6318C63
	Data.q $CCAEC15804000038,$A2F24EA6E28DAAD2,$21919B11D09F020F,$D48F411393315297,$8370568760958B50
	Data.q $C80004AC86858017,$735AE6B188100000,$54B9ED62D694108E,$822194E7B16A394A,$4E410CC94B9CB49C
	Data.q $312728C8642D6B5A,$5ADAB414843214B6,$74B1AB628C5294E9,$E74A96C5A949318C,$0300008200000020
	Data.q $8181401408133211,$000290484038000C,$404045C31D0C0B0A,$384C70A0C0A3212E,$CC88410000369D27
	Data.q $1AA13120C5888910,$8605C58003A62A28,$B8BB48D8D0C8007C,$075DC5D05C032E80,$401C588210420842
	Data.q $DE2786E138380901,$EA5453A09C1B84F0,$0010000000000020,$A22200D9200001E0,$0900F8F0E8E39999
	Data.q $4941393129211911,$2000000000000951,$888056480000F800,$403E3C3A38E66668,$504E4C4A48464442
	Data.q $0000000000025452,$0000808080000000,$8000000040000000,$4404005367674F80,$D4000000000000AC
	Data.q $CF00000002000074,$2B2848332D408887,$2C2C2C2C2C2A2B2B,$2B2B292B2C2B2B2C,$2C2C2B2B2B2B2C2A
	Data.q $2A2B2C282B2B2B2B,$442C2C2B292B2C2B,$C5D644BF3F4AB42C,$D3FC06C6301209CF,$B56F78010F002331
	Data.q $72D34E8671FAD4EC,$B8F672DEFFB70EE5,$A55353F7D1536CB6,$C31D181A119B366A,$7359D4F04214E3AF
	Data.q $0000014005811DE6,$0136E6FCE1800000,$7E3E3878EEF58348,$66EBA77DBBF215F7,$7D77D1536AA3255E
	Data.q $6BDAB79DF1DF83F3,$5822DD6BAD8D8A4C,$F92D175E000E1F87,$80E9BB4C5C4779EF,$00000000000B01E5
	Data.q $12D5C40175D38000,$08EF37BF6884D4B0,$032D175E00A08A08,$D26ED305788EB3DF,$0000000002C07960
	Data.q $1440017BF4E00000,$7EBB47B6696AC04B,$5E002822823A9537,$317E23A9EFF92D17,$00002C079602869D
	Data.q $96FFFA0000000000,$DFC65E897518A000,$45045D42AB8FCAA1,$37DF437516DE0000,$1E58081BB4C9F11D
	Data.q $0000000000000000,$62EA3150014ADFFD,$7323ED87289A2F3C,$2D175E0000014117,$DDA68B7E23B6EFF9
	Data.q $0000000001E58350,$00055E7FD0000000,$49BD23794D8DDC44,$5E0000288ABA2FD3,$8F7E23B2EFF92D17
	Data.q $000001E58350DDA6,$565FD00000000000,$0D32DA3DC4450015,$4455D6EF6A6AFFCB,$EFF92D175E000011
	Data.q $B06A1BB4D1EFC474,$000000000000003C,$8218A003AAEDFA00,$959CB56BAB0EA666,$3E0045045054134B
	Data.q $067C44C5DF434D17,$000100F2C1606ED3,$B5D9C00000000000,$4F5E90A043150018,$22820252F47EE38B
	Data.q $DF434D173E000228,$582C0DDA60CF8899,$000000000000201E,$3462E00316B5B800,$346FE3A6ECADA648
	Data.q $3E000450450406A5,$327C476DDF834D17,$0000000F2C1A86ED,$CD4CFD8000000000,$2CD2F4483462E002
	Data.q $28220F262B33551E,$DF034D173E000802,$0681BB4D16FC4753,$00000000000003CB,$8C6E002AAC7F6000
	Data.q $F7DEECC1DB9EB1BB,$3E00008A08B83DCD,$8DF88EB3DF034D17,$0000003CB0103769,$AAEFF60000000000
	Data.q $6C53C637718DC004,$2A88B93FE1F1F94C,$37DF034D173E0000,$0F2C051BB4C1F11D,$8000000000000000
	Data.q $C46AE2370052F7FD,$DCAF36DFB8A9663D,$4D173E000002288D,$6ED305788E87DF83,$0000000380F2C1A0
	Data.q $0012B3FEC0000000,$BBAF1678246AE237,$002288D52BB4E5D9,$4743EFF92D175E00,$0701E5809376983C
	Data.q $EB80000000000000,$B410D4123500052F,$8356A6AFF6A38F30,$F92D175E00022822,$80E9BB4C1E23A9EF
	Data.q $00000000000701E5,$C248D401A9EB8000,$C7B5DFD86D186892,$2D175E00008A08A2,$DDA608F88EB3DF03
	Data.q $0000000380F2C1B8,$00454FF5C0000000,$291EBC22904B1C15,$0008A08A0C52C65C,$7E23A9EFF92D175E
	Data.q $001C07960206ED31,$3FF6000000000000,$E453068C5C100197,$AA314B1C3C7579EF,$DF83F516FE000A08
	Data.q $3CB017B4C5F88E87,$0000000000000000,$3462AA2000A8DFF6,$C99E2ED6E1E658D8,$2D175E0000045518
	Data.q $DDA68F7E23A6EFF9,$0000000001E58340,$004EAB7FB0000000,$BD9D7ACC42131AA8,$000015511927C1C6
	Data.q $23B2EFF92D175E00,$0003CB06BDA68F7E,$BF60000000000000,$85E491AA8201235D,$511825D515DF869D
	Data.q $032D175E00000504,$6A1BB4CEFC4745DF,$0000000000003CB0,$C7040253573C0000,$C6BD73FED98DA94A
	Data.q $3E00050141145B8D,$833E2275DF434D17,$0001403CB05A3769,$66A8700000000000,$5EE03351920D1009
	Data.q $045045162C56BB6E,$4DDF834D173E0005,$1E58340DDA62FC47,$0000000000000000,$3562EA30098B52CE
	Data.q $27423DDB3BD74A97,$4D173E0140504516,$86ED327C476DDF83,$00000000000F2C1A,$C0279A86FE800000
	Data.q $F7DCB08A64D58BB8,$005045558CCF50F7,$23B6EFF92D175E00,$000F2C050DDA637E,$FE80000000000000
	Data.q $983C637718048D79,$D61FEB7E61EDF52C,$2D175E0000A08AA8,$DDA68AFC4779EFF9,$0000000001E58350
	Data.q $600D567FD0000000,$7AAE953637718DDC,$0000011551A37F98,$F88EC7DF034D173E,$00000F2C050DDA60
	Data.q $CFFE800000000000,$9498D5C46AE30015,$4157185EFEC4E317,$DF034D173E000001,$2C050DDA60F88E87
	Data.q $000000000000580F,$2357100651BFF400,$5D754A78F0F256AE,$175E00008A08E256,$6982B88EF3DF032D
	Data.q $000001603CB06937,$0198FA7000000000,$2CFDA94AC04AD5C4,$0282282383657F9C,$23A9EFF92D175E00
	Data.q $0580F2C071BB4C5E,$E9C0000000000000,$12D48812C7100263,$1411411C1B17E546,$8EB3DF032D175E00
	Data.q $80F2C1A8DDA608F8,$C000000000000005,$58B83144004AEFE9,$42B3AFDE55F7ED2D,$4D173E000011411D
	Data.q $0DDA64F88EF3DF03,$00000000580F2C04,$40052DFFF4000000,$EF8336CF3D62EA31,$00022822EA14BFB4
	Data.q $F88EF3DF83F516FE,$00000079602F698D,$579FF40000000000,$B2A90D8DD4454001,$0AA22AE8AFE7FDDA
	Data.q $B2EFF92D175E0000,$E58350DDA68F7E23,$0000000000000001,$8F71100012AABFD0,$D6DF19F2EE034F36
	Data.q $2D175E0000114455,$1BB4D1EFC474EFF9,$00000000003CB06A,$800EAB1BFA000000,$0698B0EA66682462
	Data.q $0008A0A836D7A947,$11DAEFF92D177E00,$0007960DC6ED31BF,$BB80000000000000,$5A42D243140042D5
	Data.q $1012F53FFBFA3DDF,$832D175E00040114,$5A3769823E2275DF,$0000000000403CB0,$AB150011AE500000
	Data.q $4B1EEDF70F231539,$4D173E0045045042,$0DDA62FC474DDF83,$00000000001E5834,$B800B3579E000000
	Data.q $F3B7AB36B5120D18,$000100450406A38A,$FC4753DF034D173E,$0001E58340DDA68A,$3FB0000000000000
	Data.q $CF5883462E003AA9,$821B66A4DAF370ED,$F92D175E00008A08,$040DDA637E23B6EF,$0000000000000F2C
	Data.q $18B800956DFD8000,$77AF5C5D8A436377,$0000005511706F83,$F88E87DF038D173E,$03CB339A8D3A9E88
	Data.q $0000000030080000,$02904801556FFF60,$3DCBE7B7B2CC6484,$7FDFE000004511B8,$F7FDFF7FDFF7FDFF
	Data.q $FF7FDFF7FDFF7FDF,$F92D173E003277FD,$46EF2793E214D9CF,$0000000001E595CD,$0034A7FFB0000000
	Data.q $37FCF0C84D80262A,$05105105106B7F92
EndDataSection
Vorsicht bei Änderungen im StringGadget!

Re: Töne im Bereich 0-300 Hz erzeugen...

Verfasst: 03.12.2011 10:12
von rolaf
Toll, ein Vibrator-Sound. :lol:

Aber irgenwie funktionierts nicht richtig. Nur wenn ich ruckartig den Tonregler hin und her schiebe ändert sich der Ton. Nutzt man den Regler "normal", bleibt der Ton meist stets gleich, egal wo der Regler steht (besonders in den höheren Bereichen) - oder mein Gehör ist kaputt. *kopfkratz*

Ist bestimmt gut als Mückenabwehr-Programm. :mrgreen:
Oder ist das der Tinitus von bobobo? :wink:

Re: Töne im Bereich 0-300 Hz erzeugen...

Verfasst: 03.12.2011 10:29
von dl5ndh
Hallo Stargate,
vielen Dank für Deine Mühe, die Du dir für die Beantwortung meiner Frage gemacht hast. Ja, dann wäre es ok. Ich schaue mir Deinen Code genau durch und versuche das zu verstehen. Wie gesagt ich brauche nur Töne zwischen 0 und 300 Hz. Grund ist der, es gibt im Längstwellenbereich bei 82 Hz ein Kommunikationssignal für tiefgetauchte U-Boote. Es werden Töne mit 4 Minuten Dauer ausgesendet.
Es gibt insgesamt 12 Töne mit je 0,2 Hz Abständen.
Ich habe bereits einen kleinen Simulator geschrieben, um dieses Signal nachzubilden, so wie es im Original fast täglich zu erfassen ist. Ich hatte halt 12 Wave-Dateien dafür verwendet.
Jetzt möchte ich mein Progrämmchen auch so erweitern, das man beliebige Frequenzen mehr und auch andere Tonlängen erzeugen kann.
Wenn Du möchtest, kann ich Dir 'mal den Code dafür zukommen lassen (Falls es Dich interessiert). Es funktioniert zwar so auch, aber erstens wäre natürlich die von Dir angesprochene Möglichkeit besser und zweitens habe ich das Problem, wenn ich z.B. einen Ton mit 4 Minuten Dauer sende, dann verzweige ich dafür in eine Procedur. Dort ist eine Schleife, die nach vorgegebenen Sekunden dann den Ton beendet. Allerdings kann ich während der gesamten Sendung das Programm nicht beenden, weil man sich dann nicht mehr in der Hauptschleife befindet, sodaß die Window-Events verarbeitet werden können. Ich habe probiert, die Proceduren als Thread aufzurufen, aber irgendwie stürzt dann das Programm immer ab.
Ich versuche 'mal, hier den Code zu posten.

Hier der Quellcode, im Anschluß dann der "Fenster-Code":

Code: Alles auswählen

; PureBasic Visual Designer v3.95 build 1485 (PB4Code)
Global SekBeginn.l, SekEnde.l, Tondauer.l, TON.l, F.s, Dauer.l, Gesamtdauer.l, Freq.s
Global Amplitude.l, NR.l
IncludeFile "ZEVS_Fenster.pb"

InitSound()
UseFLACSoundDecoder()
UseOGGSoundDecoder()

Declare ton1_senden()
Declare ton2_senden()
Declare ton3_senden()
Declare ton4_senden()
Declare ton5_senden()
Declare ton6_senden()
Declare ton7_senden()
Declare ton8_senden()
Declare ton9_senden()
Declare ton10_senden()
Declare ton11_senden()
Declare ton12_senden()

NewList TON.l()

Procedure ton1_senden()
      CatchSound(0, ?ton1)
      SekBeginn=Date()
      SekEnde=SekBeginn+Tondauer
      Amplitude=Val(GetGadgetText(#Spin_0)):SoundVolume(0,Amplitude)
      PlaySound(0)
      Repeat
          SekBeginn=Date() 
          While WindowEvent():Wend
      Until SekBeginn = SekEnde
      StopSound(0)
EndProcedure
    
Procedure ton2_senden()
      CatchSound(0, ?ton2)
      SekBeginn=Date()
      SekEnde=SekBeginn+Tondauer
      Amplitude=Val(GetGadgetText(#Spin_0)):SoundVolume(0,Amplitude)
      PlaySound(0)
      Repeat
          SekBeginn=Date() 
          While WindowEvent():Wend
      Until SekBeginn = SekEnde
      StopSound(0)
    EndProcedure
    
Procedure ton3_senden()
      CatchSound(0, ?ton3)
      SekBeginn=Date()
      SekEnde=SekBeginn+Tondauer
      Amplitude=Val(GetGadgetText(#Spin_0)):SoundVolume(0,Amplitude)
      PlaySound(0)
      Repeat
          SekBeginn=Date() 
          While WindowEvent():Wend
      Until SekBeginn = SekEnde
      StopSound(0)
EndProcedure
    
Procedure ton4_senden()
      CatchSound(0, ?ton4)
      SekBeginn=Date()
      SekEnde=SekBeginn+Tondauer
      Amplitude=Val(GetGadgetText(#Spin_0)):SoundVolume(0,Amplitude)
      PlaySound(0)
      Repeat
          SekBeginn=Date() 
          While WindowEvent():Wend
      Until SekBeginn = SekEnde
      StopSound(0)
    EndProcedure
    
Procedure ton5_senden()
      CatchSound(0, ?ton5)
      SekBeginn=Date()
      SekEnde=SekBeginn+Tondauer
      Amplitude=Val(GetGadgetText(#Spin_0)):SoundVolume(0,Amplitude)
      PlaySound(0)
      Repeat
          SekBeginn=Date() 
          While WindowEvent():Wend
      Until SekBeginn = SekEnde
      StopSound(0)
EndProcedure
    
Procedure ton6_senden()
      CatchSound(0, ?ton6)
      SekBeginn=Date()
      SekEnde=SekBeginn+Tondauer
      Amplitude=Val(GetGadgetText(#Spin_0)):SoundVolume(0,Amplitude)
      PlaySound(0)
      Repeat
          SekBeginn=Date() 
          While WindowEvent():Wend
      Until SekBeginn = SekEnde
      StopSound(0)
EndProcedure
    
Procedure ton7_senden()
      CatchSound(0, ?ton7)
      SekBeginn=Date()
      SekEnde=SekBeginn+Tondauer
      Amplitude=Val(GetGadgetText(#Spin_0)):SoundVolume(0,Amplitude)
      PlaySound(0)
      Repeat
          SekBeginn=Date() 
          While WindowEvent():Wend
      Until SekBeginn = SekEnde
      StopSound(0)
EndProcedure
    
Procedure ton8_senden()
      CatchSound(0, ?ton8)
      SekBeginn=Date()
      SekEnde=SekBeginn+Tondauer
      Amplitude=Val(GetGadgetText(#Spin_0)):SoundVolume(0,Amplitude)
      PlaySound(0)
      Repeat
          SekBeginn=Date() 
          While WindowEvent():Wend
      Until SekBeginn = SekEnde
      StopSound(0)
EndProcedure
    
Procedure ton9_senden()
      CatchSound(0, ?ton9)
      SekBeginn=Date()
      SekEnde=SekBeginn+Tondauer
      Amplitude=Val(GetGadgetText(#Spin_0)):SoundVolume(0,Amplitude)
      PlaySound(0)
      Repeat
          SekBeginn=Date() 
          While WindowEvent():Wend
      Until SekBeginn = SekEnde
      StopSound(0)
EndProcedure
    
Procedure ton10_senden()
      CatchSound(0, ?ton10)
      SekBeginn=Date()
      SekEnde=SekBeginn+Tondauer
      Amplitude=Val(GetGadgetText(#Spin_0)):SoundVolume(0,Amplitude)
      PlaySound(0)
      Repeat
          SekBeginn=Date() 
          While WindowEvent():Wend
      Until SekBeginn = SekEnde
      StopSound(0)
EndProcedure
    
Procedure ton11_senden()
      CatchSound(0, ?ton11)
      SekBeginn=Date()
      SekEnde=SekBeginn+Tondauer
      Amplitude=Val(GetGadgetText(#Spin_0)):SoundVolume(0,Amplitude)
      PlaySound(0)
      Repeat
          SekBeginn=Date() 
          While WindowEvent():Wend
      Until SekBeginn = SekEnde
      StopSound(0)
EndProcedure
    
Procedure ton12_senden()
      CatchSound(0, ?ton12)
      SekBeginn=Date()
      SekEnde=SekBeginn+Tondauer
      Amplitude=Val(GetGadgetText(#Spin_0)):SoundVolume(0,Amplitude)
      PlaySound(0)
      Repeat
          SekBeginn=Date() 
          While WindowEvent():Wend
      Until SekBeginn = SekEnde
      StopSound(0)
EndProcedure





Open_Window_0()


;Das Häkchen für Routinesendung setzen
SetGadgetState(#CheckBox_0,1)

Repeat ; Start of the event loop
  Event = WaitWindowEvent() ; This line waits until an event is received from Windows
  
  WindowID = EventWindow() ; The Window where the event is generated, can be used in the gadget procedures
  
  GadgetID = EventGadget() ; Is it a gadget event?
  
  EventType = EventType() ; The event type
  
  
  If Event = #PB_Event_Gadget
    
    If GadgetID = #Button_0; STARTEN der ZEVS-Sendung
      
      ;Erst prüfen, ob eine Tonsendung generiert wurde
      If CountGadgetItems(#ListIcon_0)=0
          SetGadgetText(#Text_3,"TONTABELLE GENERIEREN")
          Goto weiter
        Else
          ;SetGadgetText(#Text_3,"TON 1 / 23  [ 82,0 Hz ]")
      EndIf
      ;**************** Jetzt Senden !!! ********************
      
      If CountGadgetItems(#ListIcon_0)=23
          Tondauer = 240
          For i = 0 To 22 ;Wegen Beginn=0 nicht 23 !
                Freq=GetGadgetItemText(#ListIcon_0,i,1)
                NR=Val(GetGadgetItemText(#ListIcon_0,i,0))
                Select Freq
                      Case "80,8":SetGadgetText(#Text_3,"TON "+Str(NR)+" / "+"23  [ 80,8 Hz ]"): ton1_senden()
                      Case "81,0":SetGadgetText(#Text_3,"TON "+Str(NR)+" / "+"23  [ 81,0 Hz ]"): ton2_senden()
                      Case "81,2":SetGadgetText(#Text_3,"TON "+Str(NR)+" / "+"23  [ 81,2 Hz ]"): ton3_senden()
                      Case "81,4":SetGadgetText(#Text_3,"TON "+Str(NR)+" / "+"23  [ 81,4 Hz ]"): ton4_senden()
                      Case "81,6":SetGadgetText(#Text_3,"TON "+Str(NR)+" / "+"23  [ 81,6 Hz ]"): ton5_senden()
                      Case "81,8":SetGadgetText(#Text_3,"TON "+Str(NR)+" / "+"23  [ 81,8 Hz ]"): ton6_senden()
                      Case "82,0":SetGadgetText(#Text_3,"TON "+Str(NR)+" / "+"23  [ 82,0 Hz ]"): ton7_senden()
                      Case "82,2":SetGadgetText(#Text_3,"TON "+Str(NR)+" / "+"23  [ 82,2 Hz ]"): ton8_senden()
                      Case "82,4":SetGadgetText(#Text_3,"TON "+Str(NR)+" / "+"23  [ 82,4 Hz ]"): ton9_senden()
                      Case "82,6":SetGadgetText(#Text_3,"TON "+Str(NR)+" / "+"23  [ 82,6 Hz ]"): ton10_senden()
                      Case "82,8":SetGadgetText(#Text_3,"TON "+Str(NR)+" / "+"23  [ 82,8 Hz ]"): ton11_senden()
                      Case "83,0":SetGadgetText(#Text_3,"TON "+Str(NR)+" / "+"23  [ 83,0 Hz ]"): ton12_senden()
                EndSelect
           Next i
           SetGadgetText(#Text_3,"ÜBERTRAGUNG BEENDET"):

      Else  ; ****** HDR Sendung senden ******
           
          ;SetGadgetText(#Text_3,"TON 1 / 552  [ 82,0 Hz ]")
          ;**************** Jetzt HDR senden !!! ********************
      
          Tondauer = 10
          For i = 0 To 551 ;Wegen Beginn=0 nicht 552 !
                Freq=GetGadgetItemText(#ListIcon_0,i,1)
                NR=Val(GetGadgetItemText(#ListIcon_0,i,0))
                
                Select Freq
                      Case "80,8":SetGadgetText(#Text_3,"TON "+Str(NR)+" / "+"552  [ 80,8 Hz ]"): ton1_senden()
                      Case "81,0":SetGadgetText(#Text_3,"TON "+Str(NR)+" / "+"552  [ 81,0 Hz ]"): ton2_senden()
                      Case "81,2":SetGadgetText(#Text_3,"TON "+Str(NR)+" / "+"552  [ 81,2 Hz ]"): ton3_senden()
                      Case "81,4":SetGadgetText(#Text_3,"TON "+Str(NR)+" / "+"552  [ 81,4 Hz ]"): ton4_senden()
                      Case "81,6":SetGadgetText(#Text_3,"TON "+Str(NR)+" / "+"552  [ 81,6 Hz ]"): ton5_senden()
                      Case "81,8":SetGadgetText(#Text_3,"TON "+Str(NR)+" / "+"552  [ 81,8 Hz ]"): ton6_senden()
                      Case "82,0":SetGadgetText(#Text_3,"TON "+Str(NR)+" / "+"552  [ 82,0 Hz ]"): ton7_senden()
                      Case "82,2":SetGadgetText(#Text_3,"TON "+Str(NR)+" / "+"552  [ 82,2 Hz ]"): ton8_senden()
                      Case "82,4":SetGadgetText(#Text_3,"TON "+Str(NR)+" / "+"552  [ 82,4 Hz ]"): ton9_senden()
                      Case "82,6":SetGadgetText(#Text_3,"TON "+Str(NR)+" / "+"552  [ 82,6 Hz ]"): ton10_senden()
                      Case "82,8":SetGadgetText(#Text_3,"TON "+Str(NR)+" / "+"552  [ 82,8 Hz ]"): ton11_senden()
                      Case "83,0":SetGadgetText(#Text_3,"TON "+Str(NR)+" / "+"552  [ 83,0 Hz ]"): ton12_senden()
                EndSelect
           Next i
           SetGadgetText(#Text_3,"ÜBERTRAGUNG BEENDET"):
           
          
       EndIf
      
      
      
weiter:
      
    ElseIf GadgetID = #Button_2: End
      
    ElseIf GadgetID = #CheckBox_0;Setzen der Routine-Sendung
      
            SetGadgetState(#CheckBox_1,0)
            If GetGadgetState(#CheckBox_0) = 0:SetGadgetState(#CheckBox_1,1):EndIf
      
    ElseIf GadgetID = #CheckBox_1;Setzen der HDR-Sendung
        
            SetGadgetState(#CheckBox_0,0)
            If GetGadgetState(#CheckBox_1) = 0:SetGadgetState(#CheckBox_0,1):EndIf  
            
    ElseIf GadgetID = #Button_3; Tonsendung generieren (Zufallsfunktion!)
      
      ;Erst abfragen, ob für Routine oder HDR und dann Tonsendung erstellen
      If GetGadgetState(#CheckBox_0)=1 ;ROUTINE ( 23 Töne )
        
        ;Statusmeldung warten bitte...
         SetGadgetText(#Text_3,"TONTABELLE WIRD GENERIERT")

        ClearGadgetItems(#ListIcon_0)
        ClearList(TON()) 
        Dauer=4:Gesamtdauer=4
        AddGadgetItem(#ListIcon_0,-1,"1"+Chr(10)+"82,0"+Chr(10)+Str(Dauer)+" Min."+Chr(10)+Str(Gesamtdauer)+" Min."+Chr(10)+"Routine")
        SetGadgetItemColor(#ListIcon_0,0,#PB_Gadget_FrontColor, RGB(255,0,0),1)
        
        For i = 2 To 4
              ;Tonfrequenzen auswählen
              
              TON=Random(11)+1
              If TON=1:TON=TON+1:EndIf
              If TON=7:TON=TON+1:EndIf
              
              AddElement(TON())    ; Erstellt das erste neue Element innerhalb der Liste
              TON() = TON 
              
              Select TON
                Case 2: F="81,0"
                Case 3: F="81,2"
                Case 4: F="81,4"
                Case 5: F="81,6"
                Case 6: F="81,8"
                Case 8: F="82,2"
                Case 9: F="82,4"
                Case 10:F="82,6"
                Case 11:F="82,8"
                Case 12:F="83,0"
              EndSelect
              
              Gesamtdauer = Gesamtdauer + 4
              
              AddGadgetItem(#ListIcon_0,-1,Str(i)+Chr(10)+F+Chr(10)+Str(Dauer)+" Min."+Chr(10)+Str(Gesamtdauer)+" Min."+Chr(10)+"Routine")
              SetGadgetItemColor(#ListIcon_0,-1,#PB_Gadget_FrontColor, RGB(255,0,0),1)
          
            Next i
            
            ;Den Trenner einbringen
            Gesamtdauer = Gesamtdauer + 4
            AddGadgetItem(#ListIcon_0,-1,"5"+Chr(10)+"80,8"+Chr(10)+Str(Dauer)+" Min."+Chr(10)+Str(Gesamtdauer)+" Min."+Chr(10)+"Routine")
            SetGadgetItemColor(#ListIcon_0,-1,#PB_Gadget_FrontColor, RGB(255,0,0),1)

            ;Jetzt die 3 Töne noch einmal senden
            ResetList(TON())
  
            For i = 6 To 8
                NextElement(TON())
                TON = TON()
                Gesamtdauer = Gesamtdauer + 4
                
              Select TON
                Case 2: F="81,0"
                Case 3: F="81,2"
                Case 4: F="81,4"
                Case 5: F="81,6"
                Case 6: F="81,8"
                Case 8: F="82,2"
                Case 9: F="82,4"
                Case 10:F="82,6"
                Case 11:F="82,8"
                Case 12:F="83,0"
              EndSelect
              
                AddGadgetItem(#ListIcon_0,-1,Str(i)+Chr(10)+F+Chr(10)+Str(Dauer)+" Min."+Chr(10)+Str(Gesamtdauer)+" Min."+Chr(10)+"Routine")
                SetGadgetItemColor(#ListIcon_0,-1,#PB_Gadget_FrontColor, RGB(255,0,0),1)

            Next i
            
            
            For i = 9 To 23
                Gesamtdauer = Gesamtdauer + 4
                AddGadgetItem(#ListIcon_0,-1,Str(i)+Chr(10)+"82,0"+Chr(10)+Str(Dauer)+" Min."+Chr(10)+Str(Gesamtdauer)+" Min."+Chr(10)+"Routine")
                SetGadgetItemColor(#ListIcon_0,-1,#PB_Gadget_FrontColor, RGB(255,0,0),1)
            Next i
            
              ;Statusmeldung ausgeben
              SetGadgetText(#Text_3,"SENDEBEREIT"):
            
            
      Else ;********************  HDR ( 552 Töne )  generieren **************************************************************
        
             ;Statusmeldung warten bitte...
             SetGadgetText(#Text_3,"TONTABELLE WIRD GENERIERT")

             ClearList(TON()) 
             Dauer=10:Gesamtdauer=0
             ClearGadgetItems(#ListIcon_0)
             For i = 1 To 24
                    Gesamtdauer = Gesamtdauer + 10
                    AddGadgetItem(#ListIcon_0,-1,Str(i)+Chr(10)+"82,0"+Chr(10)+Str(Dauer)+"s"+Chr(10)+Str(Gesamtdauer)+"s"+Chr(10)+"HDR")
                    SetGadgetItemColor(#ListIcon_0,0,#PB_Gadget_FrontColor, RGB(255,0,0),1)
             Next i
                  
        For i = 25 To 96
          
              ;Tonfrequenzen auswählen
              TON=Random(11)+1
              If TON=1:TON=TON+1:EndIf
              If TON=7:TON=TON+1:EndIf
              
              AddElement(TON())    ; Erstellt das erste neue Element innerhalb der Liste
              TON() = TON 
              
              Select TON
                Case 2: F="81,0"
                Case 3: F="81,2"
                Case 4: F="81,4"
                Case 5: F="81,6"
                Case 6: F="81,8"
                Case 8: F="82,2"
                Case 9: F="82,4"
                Case 10:F="82,6"
                Case 11:F="82,8"
                Case 12:F="83,0"
              EndSelect
              
              Gesamtdauer = Gesamtdauer + 10
              
              AddGadgetItem(#ListIcon_0,-1,Str(i)+Chr(10)+F+Chr(10)+Str(Dauer)+"s"+Chr(10)+Str(Gesamtdauer)+"s"+Chr(10)+"HDR")
              SetGadgetItemColor(#ListIcon_0,-1,#PB_Gadget_FrontColor, RGB(255,0,0),1)
            Next i
            
            ;Den Trenner einbringen
            For i = 97 To 120
                  Gesamtdauer = Gesamtdauer + 10
                  AddGadgetItem(#ListIcon_0,-1,Str(i)+Chr(10)+"80,8"+Chr(10)+Str(Dauer)+"s"+Chr(10)+Str(Gesamtdauer)+"s"+Chr(10)+"HDR")
                  SetGadgetItemColor(#ListIcon_0,-1,#PB_Gadget_FrontColor, RGB(255,0,0),1)
                 
            Next i
                
            ;Jetzt die 3 Töne noch einmal einschreiben (HDR)
            ResetList(TON())
  
            For i = 121 To 192; Noch 360
                NextElement(TON())
                TON = TON()
                Gesamtdauer = Gesamtdauer + 10
                
              Select TON
                Case 2: F="81,0"
                Case 3: F="81,2"
                Case 4: F="81,4"
                Case 5: F="81,6"
                Case 6: F="81,8"
                Case 8: F="82,2"
                Case 9: F="82,4"
                Case 10:F="82,6"
                Case 11:F="82,8"
                Case 12:F="83,0"
              EndSelect
              
                AddGadgetItem(#ListIcon_0,-1,Str(i)+Chr(10)+F+Chr(10)+Str(Dauer)+"s"+Chr(10)+Str(Gesamtdauer)+"s"+Chr(10)+"HDR")
                SetGadgetItemColor(#ListIcon_0,-1,#PB_Gadget_FrontColor, RGB(255,0,0),1)
                While WindowEvent():Wend
            Next i
                
            ;Nun 
            For i = 193 To 552
                Gesamtdauer = Gesamtdauer + 10
                AddGadgetItem(#ListIcon_0,-1,Str(i)+Chr(10)+"82,0"+Chr(10)+Str(Dauer)+"s"+Chr(10)+Str(Gesamtdauer)+"s"+Chr(10)+"HDR")
                SetGadgetItemColor(#ListIcon_0,-1,#PB_Gadget_FrontColor, RGB(255,0,0),1)
                
            Next i
            
              ;Statusmeldung ausgeben
              SetGadgetText(#Text_3,"SENDEBEREIT")
              
        
      EndIf
        
      
      
      
    ElseIf GadgetID = #Spin_0
      
       SetGadgetText(#Text_3,"AMPLITUDENÄNDERUNG"):

      If EventType()= 1;#PB_EventType_Change 
        
                        Wert.l=Val(GetGadgetText(#Spin_0))+1
                        If Wert > 100: Wert = 100:EndIf
                        SetGadgetState(#Spin_0,Wert)
                        SetGadgetText(#Spin_0,Str(Wert))

      ElseIf EventType() = -1
                        Wert.l=Val(GetGadgetText(#Spin_0))-1
                        If Wert < 1:Wert = Wert + 1:EndIf
                        SetGadgetState(#Spin_0,Wert)
                        SetGadgetText(#Spin_0,Str(Wert))
      EndIf
      
    ElseIf GadgetID = #ListIcon_0
      
    ElseIf GadgetID = #Button_5; TESTTON-Sendung mit 10 sec Dauer
      
      SetGadgetText(#Text_3,"TESTSENDUNG 10S [82,0 Hz]"):
      
      CatchSound(0, ?ton7)
      SekBeginn=Date()
      SekEnde=SekBeginn+10
      PlaySound(0)
      Repeat
              While WindowEvent(): Wend
              SekBeginn=Date()
      Until SekBeginn = SekEnde
      
      SetGadgetText(#Text_3,"TESTSENDUNG BEENDET"):
      StopSound(0)
      
    EndIf
    
  EndIf
  
Until Event = #PB_Event_CloseWindow ; End of the event loop


End

DataSection
  ton1: IncludeBinary "TON1.wav"
  ton2: IncludeBinary "TON2.wav"
  ton3: IncludeBinary "TON3.wav"
  ton4: IncludeBinary "TON4.wav"
  ton5: IncludeBinary "TON5.wav"
  ton6: IncludeBinary "TON6.wav"
  ton7: IncludeBinary "TON7.wav"
  ton8: IncludeBinary "TON8.wav"
  ton9: IncludeBinary "TON9.wav"
  ton10:IncludeBinary "TON10.wav"
  ton11:IncludeBinary "TON11.wav"
  ton12:IncludeBinary "TON12.wav"





;

Code: Alles auswählen

;
; PureBasic Visual Designer v3.95 build 1485 (PB4Code)


;- Window Constants
;
Enumeration
  #Window_0
EndEnumeration

;- Gadget Constants
;
Enumeration
  #Text_0
  #Button_0
  #Button_1
  #Button_2
  #CheckBox_0
  #Frame3D_0
  #CheckBox_1
  #Text_2
  #Text_3
  #Button_3
  #Spin_0
  #Text_4
  #ListIcon_0
  #Text_5
  #Button_5
  #Text_6
EndEnumeration

;- Fonts
Global FontID1
FontID1 = LoadFont(1, "@Arial Unicode MS", 8)
Global FontID2
FontID2 = LoadFont(2, "@Arial Unicode MS", 11)
Global FontID3
FontID3 = LoadFont(3, "@Arial Unicode MS", 10)
Global FontID4
FontID4 = LoadFont(4, "@Arial Unicode MS", 9)
Global FontID5
FontID5 = LoadFont(5, "@Arial Unicode MS", 12)
Global FontID6
FontID6 = LoadFont(6, "Arial Narrow", 10)
Global FontID7
FontID7 = LoadFont(7, "Arial Narrow", 9)
Global FontID8
FontID8 = LoadFont(8, "Arial", 9)
Global FontID9
FontID9 = LoadFont(9, "Arial", 11)
Global FontID10
FontID10 = LoadFont(10, "Arial", 10)
Global FontID11
FontID11 = LoadFont(11, "@Arial Unicode MS", 14)
Global FontID12
FontID12 = LoadFont(12, "Arial", 8)
Global FontID13
FontID13 = LoadFont(13, "Arial", 12)
Global FontID14
FontID14 = LoadFont(14, "Bookman Old Style", 8)
Global FontID15
FontID15 = LoadFont(15, "Californian FB", 8)
Global FontID16
FontID16 = LoadFont(16, "Cargo Two SF", 8)
Global FontID17
FontID17 = LoadFont(17, "Cargo Two SF", 6)
Global FontID18
FontID18 = LoadFont(18, "Cargo Two SF", 7)
Global FontID19
FontID19 = LoadFont(19, "Courier", 10)
Global FontID20
FontID20 = LoadFont(20, "Courier", 9)
Global FontID21
FontID21 = LoadFont(21, "Courier", 8)
Global FontID22
FontID22 = LoadFont(22, "Courier", 7)
Global FontID23
FontID23 = LoadFont(23, "Courier", 6)
Global FontID24
FontID24 = LoadFont(24, "Courier New", 8)
Global FontID25
FontID25 = LoadFont(25, "Dotum", 8)
Global FontID26
FontID26 = LoadFont(26, "Lucida Console", 8)
Global FontID27
FontID27 = LoadFont(27, "Lucida Fax", 8)
Global FontID28
FontID28 = LoadFont(28, "Microsoft YaHei", 8)
Global FontID29
FontID29 = LoadFont(29, "Modern", 8)
Global FontID30
FontID30 = LoadFont(30, "Tahoma", 8)
Global FontID31
FontID31 = LoadFont(31, "Arial",10)

Procedure BalloonTip(WindowID, Gadget, Text$ , Title$, Icon)
  
  ToolTip=CreateWindowEx_(0,"ToolTips_Class32","",#WS_POPUP | #TTS_NOPREFIX | #TTS_BALLOON,0,0,0,0,WindowID,0,GetModuleHandle_(0),0)
  SendMessage_(ToolTip,#TTM_SETTIPTEXTCOLOR,GetSysColor_(#COLOR_INFOTEXT),0)
  SendMessage_(ToolTip,#TTM_SETTIPBKCOLOR,GetSysColor_(#COLOR_INFOBK),0)
  SendMessage_(ToolTip,#TTM_SETMAXTIPWIDTH,0,180)
  Balloon.TOOLINFO\cbSize=SizeOf(TOOLINFO)
  Balloon\uFlags=#TTF_IDISHWND | #TTF_SUBCLASS
  Balloon\hWnd=GadgetID(Gadget)
  Balloon\uId=GadgetID(Gadget)
  Balloon\lpszText=@Text$
  SendMessage_(ToolTip, #TTM_ADDTOOL, 0, Balloon)
  If Title$ > ""
    SendMessage_(ToolTip, #TTM_SETTITLE, Icon, @Title$)
  EndIf
  
EndProcedure

Procedure Open_Window_0()
  If OpenWindow(#Window_0, 473, 168, 480, 320, "ZEVS Simulator (11/2011)",  #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_TitleBar )
    ;If CreateGadgetList(WindowID(#Window_0))
      TextGadget(#Text_0, 120, 280, 80, 30, "Copyright by Gerhard Wiche")
      SetGadgetFont(#Text_0, FontID12)
      
      ButtonGadget(#Button_0, 10, 10, 80, 40, "Start")
      BalloonTip(GadgetID(#Button_0), #Button_0, "Start der ZEVS Sendung", "", #TOOLTIP_NO_ICON)
      SetGadgetFont(#Button_0, FontID9)
      
      ButtonGadget(#Button_2, 380, 280, 90, 30, "Beenden")
      BalloonTip(GadgetID(#Button_2), #Button_2, "Schließen des Programmes", "", #TOOLTIP_NO_ICON)
      SetGadgetFont(#Button_2, FontID10)
      
      
      Frame3DGadget(#Frame3D_0, 10, 70, 100, 80, "Sendemode")
      SetGadgetFont(#Frame3D_0, FontID9)
      
      CheckBoxGadget(#CheckBox_0, 30, 100, 70, 20, "Routine", #PB_CheckBox_Right | #PB_CheckBox_Center)
      BalloonTip(GadgetID(#CheckBox_0), #CheckBox_0, "Aktivieren für eine Routinesendung", "", #TOOLTIP_NO_ICON)
      SetGadgetFont(#CheckBox_0, FontID10)

      CheckBoxGadget(#CheckBox_1, 30, 120, 55, 20, "HDR", #PB_CheckBox_Right | #PB_CheckBox_Center)
      BalloonTip(GadgetID(#CheckBox_1), #CheckBox_1, "Aktivieren für eine HDR Sendung", "", #TOOLTIP_NO_ICON)
      SetGadgetFont(#CheckBox_1, FontID10)
      
      
      TextGadget(#Text_2, 130, 22, 80, 20, "Status > ", #PB_Text_Center)
      SetGadgetFont(#Text_2, FontID9)
      TextGadget(#Text_6, 210, 12, 220, 36, "", #PB_Text_Center)
      SetGadgetFont(#Text_6, FontID9)
      SetGadgetColor(#Text_6,#PB_Gadget_BackColor, RGB(255,255,255))


      
      
      TextGadget(#Text_3, 210, 23, 220, 20, "ZEVS SIMULATOR", #PB_Text_Center)
      BalloonTip(GadgetID(#Text_3), #Text_3, "Statusmeldungen", "", #TOOLTIP_NO_ICON)
      SetGadgetFont(#Text_3,FontID31)
      SetGadgetColor(#Text_3,#PB_Gadget_FrontColor, RGB(255,0,0))
      SetGadgetColor(#Text_3,#PB_Gadget_BackColor, RGB(255,255,255))

      
      ButtonGadget(#Button_3, 10, 160, 100, 40, "Tonsendung generieren", #PB_Button_MultiLine)
      BalloonTip(GadgetID(#Button_3), #Button_3, "Generieren einer ZEVS Sendung", "", #TOOLTIP_NO_ICON)
      SetGadgetFont(#Button_3, FontID8)
      
      SpinGadget(#Spin_0, 25, 230, 70, 30, 1, 100)
      SetGadgetState (#Spin_0, 100):SetGadgetText(#Spin_0,"100")  
      BalloonTip(GadgetID(#Spin_0), #Spin_0, "Lautstärke in Stufen von 1-100 wählen", "", #TOOLTIP_NO_ICON)
      SetGadgetFont(#Spin_0, FontID11)
      TextGadget(#Text_4, 10, 210, 100, 20, "Amplitude", #PB_Text_Center)
      SetGadgetFont(#Text_4, FontID10)
      
      ;- Tonfrequenztabelle
      ListIconGadget(#ListIcon_0, 120, 60, 350, 210, "Ton Nr.", 60,#PB_ListIcon_GridLines)
      AddGadgetColumn(#ListIcon_0, 1, "F [Hz]", 50)
      AddGadgetColumn(#ListIcon_0, 2, "Tondauer", 70)
      AddGadgetColumn(#ListIcon_0, 3, "Gesamtdauer", 90)
      AddGadgetColumn(#ListIcon_0, 4, "Mode", 100)
      BalloonTip(GadgetID(#ListIcon_0), #ListIcon_0, "Sendetabelle der zu übertragenden Töne", "", #TOOLTIP_NO_ICON)
      SetGadgetFont(#ListIcon_0, FontID10)
      TextGadget(#Text_5, 220, 280, 150, 20, "Tonsendetabelle", #PB_Text_Center)
      SetGadgetFont(#Text_5, FontID13)
      ButtonGadget(#Button_5, 10, 270, 100, 40, "Testton 82,0 Hz für 10 Sekunden", #PB_Button_MultiLine)
      BalloonTip(GadgetID(#Button_5), #Button_5, "Senden eines Testtones mit 10 Sekunden Dauer", "", #TOOLTIP_NO_ICON)
      SetGadgetFont(#Button_5, FontID8)
      
    ;EndIf
  EndIf
EndProcedure
Gruß aus Oberfranken
Gerhard

Re: Töne im Bereich 0-300 Hz erzeugen...

Verfasst: 03.12.2011 10:47
von Danilo
Sounds kann man auch zur Laufzeit generieren. Ich habe mal für jemanden einen solchen Code
gemacht der DirectSound8 Buffer abspielt. Da habe ich in den Buffer Werte geschrieben, die
irgendeine Welle erzeugten und das reichte aus.
Aber was für Werte müssten denn für einen 0-300Hz Ton in den Buffer? Steh grad auf'm Schlauch. :D

Der Buffer war damals #BufferSize = 16384 und darin stehen immer 2-Byte-Words, abwechselnd
rechter und linker Kanal. Also 4096 Werte je Seite.

EDIT:
300Hz heisst in den Buffer muß die Sinuswelle genau 300mal reinpassen, wenn der Buffer 1 Sekunde lang ist, richtig?
Bei 150Hz dann 150mal eine Sinuswelle pro Sekunde spielen? Oder Sägezahn? Hmm.. bin confused. :?

Re: Töne im Bereich 0-300 Hz erzeugen...

Verfasst: 03.12.2011 12:31
von dl5ndh
Naja, mir würden auch insgesamt 250 Hz reichen, das entspräche 500 Sample/s.
Das würde im Speicher bei einem Ton mit 1 Sekunde Dauer 8000 Byte belegen, bei
16 Bit pro Abtastwert.
Ich brauche nur Mono, oder linker Kanal (egal). Will einfach nur automatisiert verschiedene
Töne erzeugen, wie bei einem Tonverfahren. Ich brauche also keine Tonregler in diesem
Sinne, weiß nicht, ob ich mich richtig ausgedrückt habe... hm

Re: Töne im Bereich 0-300 Hz erzeugen...

Verfasst: 03.12.2011 13:17
von NicTheQuick
Wichtig ist vor allem die SamplingRate. Steht sie bei 44100 Hz werden also pro Sekunde 44100 Samples abgespielt. Für einen Ton der Frequenz f und Amplitude a wäre also die Funktion in Abhängigkeit zur Sampleposition t bei 16 Bit Amplitudengenauigkeit folgende:

Sample(t) = (a * Sin(2 * Pi * t * f / 44100) + 1) * 65535

Ich rechne hier also mit unsigned words. In PB wäre das der Unicode-Datentyp. Und wie groß eurer Buffer nun ist, ist egal. Ihr müsst ihn eh immer wieder neu erstellen.

Re: Töne im Bereich 0-300 Hz erzeugen...

Verfasst: 03.12.2011 14:09
von Danilo
Mit irgendwelchen Sinusberechnungen kommen bei mir nie klare Töne raus.
Wäre gut wenn das mal jemand richtig machen kann, in der Procedure InitBuffer():

Code: Alles auswählen

;
; In this test, the errorhandler just displays
; a debug message and ends.
; This has to be changed for real world applications.
;
Procedure ErrorHandler(error$)
    Debug error$
    End
EndProcedure

;XIncludeFile "EnumDevices.pbi"          ; procedures for enumeration of DirectSound devices
;
; structure to store informations
; about the DirectSound devices
;
Structure DirectSoundDevices
    guid.GUID
    DrvName$
    Desc$
EndStructure

;
; Global Linked List for output devices found by DSEnumCallback
;
Global NewList OutDevices.DirectSoundDevices()
Global NewList InDevices .DirectSoundDevices()


Procedure DSOutputEnumCallback(*guid.GUID,Desc$,DrvName$,context)
    AddElement(OutDevices())                              ; add new element to the linked list OutDevices(),
    OutDevices()\Desc$    = Desc$                         ; set Desc$ (the device name)
    OutDevices()\DrvName$ = DrvName$                      ; and DrvName$ (internal device driver name)

    If *guid <> 0                                         ; copy the GUID for the device
        CopyMemory(*guid,@OutDevices()\guid,SizeOf(GUID)) ; - the GUID-Pointer for "Primary Sound Capture Driver"
    EndIf                                                 ;   is always 0, so dont copy it

    ;Debug "found output device: " + Desc$                 ;

    ProcedureReturn #True                                 ; return #True to continue enumeration
EndProcedure


Procedure DSInputEnumCallback(*guid.GUID,Desc$,Module$,context)
    AddElement(InDevices())                               ; add new element to the linked list InDevices(),
    InDevices()\Desc$    = Desc$                          ; set Desc$ (the device name)
    InDevices()\DrvName$ = Module$                        ; and DrvName$ (internal device driver name)
    
    If *guid <> 0                                         ; copy the GUID for the device
        CopyMemory(*guid,@InDevices()\guid,SizeOf(GUID))  ; - the GUID-Pointer for "Primary Sound Driver"
    EndIf                                                 ;   is always 0, so dont copy it
    
    ;Debug "found input device: " + Desc$                  ;
    
    ProcedureReturn #True                                 ; return #True to continue enumeration
EndProcedure



;
; Enumerate Audio Capture und Output Devices
;
Procedure EnumAudioDevices()
    ;
    ; enum output devices
    ;
    DirectSoundEnumerate_(@DSOutputEnumCallback(),0)
    ;
    ; enum input/capture devices
    ;
    DirectSoundCaptureEnumerate_(@DSInputEnumCallback(),0)
EndProcedure



;XIncludeFile "DeviceChooserDialog.pbi"  ; DeviceChooserDialog for selecting the input/output devices
;
; the DeviceSelectorDialog will set this
; 2 GUIDs to the GUID of the selected
; device.
; 
; CreateOutputBuffer() and CreateInputBuffer()
; use this 2 GUIDs later for initializing
; the selected devices.
;
Global *SelectedInputDevice.GUID = #Null
Global *SelectedOutputDevice.GUID = #Null


;
; DeviceChooserDialog for choosing input and output devices.
;
Procedure DeviceSelectorDialog()
    dialog = OpenWindow(#PB_Any,0,0,400,200,"Choose Devices",#PB_Window_ScreenCentered)
    If dialog
        TextGadget(#PB_Any,10,10,185,20,"Input Device")
        inputDeviceList  = ListViewGadget(#PB_Any, 10,30,185,130)
        TextGadget(#PB_Any,205,10,185,20,"Output Device")
        outputDeviceList = ListViewGadget(#PB_Any,205,30,185,130)
        okBtn            = ButtonGadget(#PB_Any,160,170,80,25,"OK")
        
        ;
        ; Add Items from the LinkedList InDevices() in EnumDevices.pbi
        ;
        ForEach InDevices()
            AddGadgetItem(inputDeviceList,-1,InDevices()\Desc$)
        Next
        SetGadgetState(inputDeviceList,0) ; select first item ("Primary Sound Capture Driver")
        
        ;
        ; Add Items from the LinkedList OutDevices() in EnumDevices.pbi
        ;
        ForEach OutDevices()
            AddGadgetItem(outputDeviceList,-1,OutDevices()\Desc$)
        Next
        SetGadgetState(outputDeviceList,0) ; select first item ("Primary Sound Driver")

        Repeat
            Select WaitWindowEvent()
                Case #PB_Event_Gadget
                    ;
                    ; OK Button pressed...
                    ;
                    If EventGadget() = okBtn And EventType() = #PB_EventType_LeftClick
                        ;
                        ; 1. get the selected item number from ListViewGadget 'inputDeviceList'
                        ;
                        inIndex=GetGadgetState(inputDeviceList)
                        SelectElement(InDevices(),inIndex)
                        If InDevices()\Desc$ <> "Primary Sound Capture Driver"
                            ;
                            ; 2. copy the GUID of the selected device
                            ;    to the global *SelectedInputDevice.GUID
                            ;
                            *SelectedInputDevice = AllocateMemory(SizeOf(GUID))
                            If *SelectedInputDevice
                                CopyMemory(@InDevices()\guid,*SelectedInputDevice,SizeOf(GUID))
                            Else
                                ErrorHandler("Out of memory error in DeviceChooserDialog()")
                            EndIf
                        Else
                            ;
                            ; the GUID for "Primary Sound Capture Driver" is always #Null
                            ;
                            *SelectedInputDevice = #Null
                        EndIf
                        
                        ;
                        ; 3. get the selected item number from ListViewGadget 'outputDeviceList'
                        ;
                        outIndex=GetGadgetState(outputDeviceList)
                        SelectElement(OutDevices(),outIndex)
                        If OutDevices()\Desc$ <> "Primary Sound Driver"
                            ;
                            ; 4. copy the GUID of the selected device
                            ;    to the global *SelectedOutputDevice.GUID
                            ;
                            *SelectedOutputDevice = AllocateMemory(SizeOf(GUID))
                            If *SelectedOutputDevice
                                CopyMemory(@OutDevices()\guid,*SelectedOutputDevice,SizeOf(GUID))
                            Else
                                ErrorHandler("Out of memory error in DeviceChooserDialog()")
                            EndIf
                        Else
                            ;
                            ; the GUID for "Primary Sound Driver" is always #Null
                            ;
                            *SelectedOutputDevice = #Null
                        EndIf
                        
                        ;
                        ; close the dialog
                        ;
                        CloseWindow(dialog)
                        Break
                    EndIf
            EndSelect
        ForEver
    EndIf
EndProcedure


;XIncludeFile "IO_Init.pbi"              ; DirectSound code
;
; missing PB DirectSound structures
;
Structure DSBUFFERDESC
    dwSize.l
    dwFlags.l
    dwBufferBytes.l
    dwReserved.l
    *lpwfxFormat.WAVEFORMATEX
    guid3DAlgorithm.GUID
EndStructure

Structure DSCEFFECTDESC  ; dummy. not correct, but not needed here.
  x.l
EndStructure


Structure DSCBUFFERDESC  ; works only with 32bit PureBasic!?
    dwSize.l
    dwFlags.l
    dwBufferBytes.l
    dwReserved.l
    *lpwfxFormat.WAVEFORMATEX
    ;dwFXCount.l
    ;*lpDSCFXDesc.DSCEFFECTDESC
EndStructure

Structure DSBPOSITIONNOTIFY
   dwOffset.l
   hEventNotify.l
EndStructure

;
; some missing constants for DirectSound, from dsound.h
;
#DSBCAPS_PRIMARYBUFFER          = $00000001
#DSBCAPS_STATIC                 = $00000002
#DSBCAPS_LOCHARDWARE            = $00000004
#DSBCAPS_LOCSOFTWARE            = $00000008
#DSBCAPS_CTRLFREQUENCY          = $00000020
#DSBCAPS_CTRLPAN                = $00000040
#DSBCAPS_CTRLVOLUME             = $00000080
#DSBCAPS_GLOBALFOCUS            = $00008000
#DSBCAPS_GETCURRENTPOSITION2    = $00010000
#DSBCAPS_LOCDEFER               = $00040000
#DSBCAPS_CTRLPOSITIONNOTIFY     = $00000100


#DSBPLAY_LOOPING                = $00000001
#DSBPLAY_LOCHARDWARE            = $00000002
#DSBPLAY_LOCSOFTWARE            = $00000004

#DSCBCAPS_WAVEMAPPED            = $80000000

#DSCBSTART_LOOPING              = $00000001

#CLSCTX_INPROC_SERVER           = $1
#DSSCL_PRIORITY                 = $2

;
; Sample Buffer size
;
#BufferSize = 16384

Global lpds.IDIRECTSOUND8 = #Null                   ; lpds        = DirectSound object
;Global lpdscapture.IDIRECTSOUNDCAPTURE = #Null      ; lpdscapture = DirectSound Capture object

Global wfex.WAVEFORMATEX                            ; WaveFormatEx structure for CreateOutputBuffer() and CreateInputBuffer()
Global dsbufferdesc .DSBUFFERDESC                   ; DirectSound Buffer Description
Global dscbufferdesc.DSCBUFFERDESC                  ; DirectSound Capture Buffer Description

Global dsbuffer .IDirectSoundBuffer        = #Null  ; DirectSound Buffer
;Global dscbuffer.IDirectSoundCaptureBuffer = #Null  ; DirectSound Capture Buffer


Procedure InitBuffer()
   If dsbuffer
       #DSBLOCK_ENTIREBUFFER=2
       If dsbuffer\Lock(0,0,@Ptr1,@Bytes1,@Ptr2,@Bytes2,#DSBLOCK_ENTIREBUFFER)=0
           If Ptr1
               *p.Unicode = Ptr1
                For i = 1 To #BufferSize/4

                  ; Wichtig ist vor allem die SamplingRate.
                  ; Steht sie bei 44100 Hz werden also pro Sekunde 44100 Samples abgespielt.
                  ; Für einen Ton der Frequenz f und Amplitude a wäre also die Funktion in
                  ; Abhängigkeit zur Sampleposition t bei 16 Bit Amplitudengenauigkeit folgende:
                  ;Sample(t) = (a * Sin(2 * Pi * t * f / 44100) + 1) * 65535
                  a.d=1
                  t.d=i
                  f.d=1000
                  ;value.u = (a * Sin(2 * #PI * t * f / #BufferSize) + 1) * 65535

                  value.u = 16728  + ((i & %01000) * 4000)
                  ;value.u = 16728  + ((i & %10000) * 2000)

                  *p\u = value
                  *p+2
                  *p\u = value
                  *p+2
                Next i
               
           EndIf
           dsbuffer\Unlock(Ptr1,Bytes1,Ptr2,Bytes2)
       EndIf
   EndIf
EndProcedure


Procedure CreateOutputBuffer(hWnd.l)
    ;
    ; get the DirectSound8 device object 
    ;
    hr = CoCreateInstance_(?CLSID_DirectSound8, #Null, #CLSCTX_INPROC_SERVER, ?IID_IDirectSound8, @lpds)
    If hr <> #S_OK
       ErrorHandler("Creating DirectSound8 device object failed.")  ; Add error-handling here.
    EndIf
    
    If lpds
        ;
        ; initialize the DirectSound8 device object
        ; with the GUID from DeviceSelectorDialog
        ;
        hr = lpds\Initialize(*SelectedOutputDevice)
        If hr <> #S_OK
           ErrorHandler("Initializing the DirectSound8 device failed.")  ; Add error-handling here.
        EndIf
        lpds\SetCooperativeLevel(hWnd,#DSSCL_PRIORITY)
        
        ;
        ; set WAVEFORMATEX
        ;
        wfex\cbSize         = 0
        wfex\wFormatTag     = #WAVE_FORMAT_PCM
        wfex\nChannels      = 2
        wfex\nSamplesPerSec = 44100
        wfex\wBitsPerSample = 16
        wfex\nBlockAlign    = (wfex\nChannels * wfex\wBitsPerSample) / 8
        ;wfex\nBlockAlign    = (wfex\wBitsPerSample / 8) * wfex\nChannels
        wfex\nAvgBytesPerSec= wfex\nSamplesPerSec * wfex\nBlockAlign

        ;
        ; set DirectSound Buffer Description
        ;        
        dsbufferdesc\dwSize         = SizeOf(DSBUFFERDESC)
        dsbufferdesc\dwFlags        = #DSBCAPS_LOCDEFER|#DSBCAPS_CTRLFREQUENCY
        dsbufferdesc\dwBufferBytes  = #BufferSize
        dsbufferdesc\dwReserved     = 0
        dsbufferdesc\lpwfxFormat    = @wfex
        
        ;
        ; create the Sound Buffer
        ;
        hr = lpds\CreateSoundBuffer(@dsbufferdesc,@dsbuffer,#Null)
        If hr <> #S_OK
           ErrorHandler("Initializing the DirectSound8 sound buffer failed.")  ; Add error-handling here.
        EndIf
              
    EndIf
    
EndProcedure


;
; start DirectSoundBuffer looping
;
Procedure StartBuffer()
    If dsbuffer
        dsbuffer\Play(0,0,#DSBPLAY_LOOPING)
    EndIf
EndProcedure

Procedure StopBuffer()
    If dsbuffer
        dsbuffer\Stop()
    EndIf
EndProcedure

Procedure SetBufferFrequency(freq)
    If dsbuffer
       dsbuffer\SetFrequency(freq)
    EndIf
EndProcedure


Procedure IO_Init(hWnd.l)
    ;
    ; initialize COM
    ;
    hr = CoInitializeEx_(#Null, 0)
    If hr <> #S_OK
       ErrorHandler("CoInitializeEx failed.")  ; Add error-handling here.
    EndIf
    
    ;
    ; start the DirectSound stuff...
    ; ...the procedure names say it all ;)
    ;
    CreateOutputBuffer(hWnd)
    
    InitBuffer()
        
EndProcedure


;
; IO_Close: cleanup
;
Procedure IO_Close()
    If dsbuffer                                 ;
        dsbuffer\Stop()                         ; stop and release the DirectSoundBuffer, dsbuffer
        dsbuffer\Release()                      ;
    EndIf                                       ;
    
    If lpds                                     ;
        lpds\Release()                          ; release the DirectSound object
    EndIf                                       ;
        
    CoUninitialize_()                           ; uninitialize COM
EndProcedure


;
; required GUIDs for DirectSound, from dsound.h
;
DataSection
    ;DEFINE_GUID(CLSID_DirectSound8, 0x3901cc3f, 0x84b5, 0x4fa4, 0xba, 0x35, 0xaa, 0x81, 0x72, 0xb8, 0xa0, 0x9b);
    CLSID_DirectSound8:
        Data.l $3901cc3f
        Data.w $84b5, $4fa4
        Data.b $ba, $35, $aa, $81, $72, $b8, $a0, $9b

    ;DEFINE_GUID(IID_IDirectSound8, 0xC50A7E93, 0xF395, 0x4834, 0x9E, 0xF6, 0x7F, 0xA9, 0x9D, 0xE5, 0x09, 0x66);
    IID_IDirectSound8:
        Data.l $C50A7E93
        Data.w $F395, $4834
        Data.b $9E, $F6, $7F, $A9, $9D, $E5, $09, $66
        
    ;DEFINE_GUID(CLSID_DirectSoundCapture8, 0xe4bcac13, 0x7f99, 0x4908, 0x9a, 0x8e, 0x74, 0xe3, 0xbf, 0x24, 0xb6, 0xe1);
    CLSID_DirectSoundCapture8:
        Data.l $e4bcac13
        Data.w $7f99, $4908
        Data.b $9a, $8e, $74, $e3, $bf, $24, $b6, $e1
    
    ;DEFINE_GUID(IID_IDirectSoundCapture, 0xb0210781, 0x89cd, 0x11d0, 0xaf, 0x8, 0x0, 0xa0, 0xc9, 0x25, 0xcd, 0x16);
    IID_IDirectSoundCapture8:
        Data.l $b0210781
        Data.w $89cd, $11d0
        Data.b $af, $8, $0, $a0, $c9, $25, $cd, $16
        
    ;DEFINE_GUID(IID_IDirectSoundNotify, 0xb0210783, 0x89cd, 0x11d0, 0xaf, 0x8, 0x0, 0xa0, 0xc9, 0x25, 0xcd, 0x16);
    IID_IDirectSoundNotify:
        Data.l $b0210783
        Data.w $89cd, $11d0
        Data.b $af, $8, $0, $a0, $c9, $25, $cd, $16
    
EndDataSection



;
; PROGRAM START
;
EnumAudioDevices()

DeviceSelectorDialog()

mainWindow = OpenWindow(#PB_Any,0,0,920,200,"Main Window",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
If mainWindow
    trackbar = TrackBarGadget(#PB_Any,10,10,800,30,1,25000)
    text_freq= TextGadget(#PB_Any,810,10,100,30,"300")
    ;
    ; Initialize DirectSound
    IO_Init(WindowID(mainWindow))

    SetGadgetState(trackbar,300)
    SetBufferFrequency(300)
    
    StartBuffer()
    
    Repeat
        Select WaitWindowEvent()
            Case #PB_Event_CloseWindow
                Break
            Case #PB_Event_Gadget
                If EventGadget()=trackbar
                    freq=GetGadgetState(trackbar)
                    SetGadgetText(text_freq,Str(freq))
                    SetBufferFrequency(freq)
                EndIf

        EndSelect
    ForEver

    ;
    ; cleanup
    ;    
    IO_Close()
EndIf
Ist jetzt nur mal so zusammen gewürfelt aus einem anderem Projekt, also nicht so genau hinschauen. :)
Der StartDialog enthält noch "Input Device", was hier entfernt wurde. Und das waren mal Includes
die ich hier einfach reinkopiert habe.

Die Berechnung die jetzt drin ist, ist nicht korrekt und nur so, das man halt was hört. :D

Re: Töne im Bereich 0-300 Hz erzeugen...

Verfasst: 03.12.2011 16:03
von Danilo
Man, für einen Ton einer bestimmten Frequenz braucht man doch immer nur abwechselnd an und ausschalten.

#BufferSize = 8 und dann 0,0,1,1,0,0,1,1 rein für Stereo, fertig.

Code: Alles auswählen

;
; In this test, the errorhandler just displays
; a debug message and ends.
; This has to be changed for real world applications.
;
Procedure ErrorHandler(error$)
    Debug error$
    End
EndProcedure

;XIncludeFile "EnumDevices.pbi"          ; procedures for enumeration of DirectSound devices
;
; structure to store informations
; about the DirectSound devices
;
Structure DirectSoundDevices
    guid.GUID
    DrvName$
    Desc$
EndStructure

;
; Global Linked List for output devices found by DSEnumCallback
;
Global NewList OutDevices.DirectSoundDevices()
Global NewList InDevices .DirectSoundDevices()


Procedure DSOutputEnumCallback(*guid.GUID,Desc$,DrvName$,context)
    AddElement(OutDevices())                              ; add new element to the linked list OutDevices(),
    OutDevices()\Desc$    = Desc$                         ; set Desc$ (the device name)
    OutDevices()\DrvName$ = DrvName$                      ; and DrvName$ (internal device driver name)

    If *guid <> 0                                         ; copy the GUID for the device
        CopyMemory(*guid,@OutDevices()\guid,SizeOf(GUID)) ; - the GUID-Pointer for "Primary Sound Capture Driver"
    EndIf                                                 ;   is always 0, so dont copy it

    ;Debug "found output device: " + Desc$                 ;

    ProcedureReturn #True                                 ; return #True to continue enumeration
EndProcedure


Procedure DSInputEnumCallback(*guid.GUID,Desc$,Module$,context)
    AddElement(InDevices())                               ; add new element to the linked list InDevices(),
    InDevices()\Desc$    = Desc$                          ; set Desc$ (the device name)
    InDevices()\DrvName$ = Module$                        ; and DrvName$ (internal device driver name)
    
    If *guid <> 0                                         ; copy the GUID for the device
        CopyMemory(*guid,@InDevices()\guid,SizeOf(GUID))  ; - the GUID-Pointer for "Primary Sound Driver"
    EndIf                                                 ;   is always 0, so dont copy it
    
    ;Debug "found input device: " + Desc$                  ;
    
    ProcedureReturn #True                                 ; return #True to continue enumeration
EndProcedure



;
; Enumerate Audio Capture und Output Devices
;
Procedure EnumAudioDevices()
    ;
    ; enum output devices
    ;
    DirectSoundEnumerate_(@DSOutputEnumCallback(),0)
    ;
    ; enum input/capture devices
    ;
    DirectSoundCaptureEnumerate_(@DSInputEnumCallback(),0)
EndProcedure



;XIncludeFile "DeviceChooserDialog.pbi"  ; DeviceChooserDialog for selecting the input/output devices
;
; the DeviceSelectorDialog will set this
; 2 GUIDs to the GUID of the selected
; device.
; 
; CreateOutputBuffer() and CreateInputBuffer()
; use this 2 GUIDs later for initializing
; the selected devices.
;
Global *SelectedInputDevice.GUID = #Null
Global *SelectedOutputDevice.GUID = #Null


;
; DeviceChooserDialog for choosing input and output devices.
;
Procedure DeviceSelectorDialog()
    dialog = OpenWindow(#PB_Any,0,0,400,200,"Choose Devices",#PB_Window_ScreenCentered)
    If dialog
        TextGadget(#PB_Any,10,10,185,20,"Input Device")
        inputDeviceList  = ListViewGadget(#PB_Any, 10,30,185,130)
        TextGadget(#PB_Any,205,10,185,20,"Output Device")
        outputDeviceList = ListViewGadget(#PB_Any,205,30,185,130)
        okBtn            = ButtonGadget(#PB_Any,160,170,80,25,"OK")
        
        ;
        ; Add Items from the LinkedList InDevices() in EnumDevices.pbi
        ;
        ForEach InDevices()
            AddGadgetItem(inputDeviceList,-1,InDevices()\Desc$)
        Next
        SetGadgetState(inputDeviceList,0) ; select first item ("Primary Sound Capture Driver")
        
        ;
        ; Add Items from the LinkedList OutDevices() in EnumDevices.pbi
        ;
        ForEach OutDevices()
            AddGadgetItem(outputDeviceList,-1,OutDevices()\Desc$)
        Next
        SetGadgetState(outputDeviceList,0) ; select first item ("Primary Sound Driver")

        Repeat
            Select WaitWindowEvent()
                Case #PB_Event_Gadget
                    ;
                    ; OK Button pressed...
                    ;
                    If EventGadget() = okBtn And EventType() = #PB_EventType_LeftClick
                        ;
                        ; 1. get the selected item number from ListViewGadget 'inputDeviceList'
                        ;
                        inIndex=GetGadgetState(inputDeviceList)
                        SelectElement(InDevices(),inIndex)
                        If InDevices()\Desc$ <> "Primary Sound Capture Driver"
                            ;
                            ; 2. copy the GUID of the selected device
                            ;    to the global *SelectedInputDevice.GUID
                            ;
                            *SelectedInputDevice = AllocateMemory(SizeOf(GUID))
                            If *SelectedInputDevice
                                CopyMemory(@InDevices()\guid,*SelectedInputDevice,SizeOf(GUID))
                            Else
                                ErrorHandler("Out of memory error in DeviceChooserDialog()")
                            EndIf
                        Else
                            ;
                            ; the GUID for "Primary Sound Capture Driver" is always #Null
                            ;
                            *SelectedInputDevice = #Null
                        EndIf
                        
                        ;
                        ; 3. get the selected item number from ListViewGadget 'outputDeviceList'
                        ;
                        outIndex=GetGadgetState(outputDeviceList)
                        SelectElement(OutDevices(),outIndex)
                        If OutDevices()\Desc$ <> "Primary Sound Driver"
                            ;
                            ; 4. copy the GUID of the selected device
                            ;    to the global *SelectedOutputDevice.GUID
                            ;
                            *SelectedOutputDevice = AllocateMemory(SizeOf(GUID))
                            If *SelectedOutputDevice
                                CopyMemory(@OutDevices()\guid,*SelectedOutputDevice,SizeOf(GUID))
                            Else
                                ErrorHandler("Out of memory error in DeviceChooserDialog()")
                            EndIf
                        Else
                            ;
                            ; the GUID for "Primary Sound Driver" is always #Null
                            ;
                            *SelectedOutputDevice = #Null
                        EndIf
                        
                        ;
                        ; close the dialog
                        ;
                        CloseWindow(dialog)
                        Break
                    EndIf
            EndSelect
        ForEver
    EndIf
EndProcedure


;XIncludeFile "IO_Init.pbi"              ; DirectSound code
;
; missing PB DirectSound structures
;
Structure DSBUFFERDESC
    dwSize.l
    dwFlags.l
    dwBufferBytes.l
    dwReserved.l
    *lpwfxFormat.WAVEFORMATEX
    guid3DAlgorithm.GUID
EndStructure

Structure DSCEFFECTDESC  ; dummy. not correct, but not needed here.
  x.l
EndStructure


Structure DSCBUFFERDESC  ; works only with 32bit PureBasic!?
    dwSize.l
    dwFlags.l
    dwBufferBytes.l
    dwReserved.l
    *lpwfxFormat.WAVEFORMATEX
    ;dwFXCount.l
    ;*lpDSCFXDesc.DSCEFFECTDESC
EndStructure

Structure DSBPOSITIONNOTIFY
   dwOffset.l
   hEventNotify.l
EndStructure

;
; some missing constants for DirectSound, from dsound.h
;
#DSBCAPS_PRIMARYBUFFER          = $00000001
#DSBCAPS_STATIC                 = $00000002
#DSBCAPS_LOCHARDWARE            = $00000004
#DSBCAPS_LOCSOFTWARE            = $00000008
#DSBCAPS_CTRLFREQUENCY          = $00000020
#DSBCAPS_CTRLPAN                = $00000040
#DSBCAPS_CTRLVOLUME             = $00000080
#DSBCAPS_GLOBALFOCUS            = $00008000
#DSBCAPS_GETCURRENTPOSITION2    = $00010000
#DSBCAPS_LOCDEFER               = $00040000
#DSBCAPS_CTRLPOSITIONNOTIFY     = $00000100


#DSBPLAY_LOOPING                = $00000001
#DSBPLAY_LOCHARDWARE            = $00000002
#DSBPLAY_LOCSOFTWARE            = $00000004

#DSCBCAPS_WAVEMAPPED            = $80000000

#DSCBSTART_LOOPING              = $00000001

#CLSCTX_INPROC_SERVER           = $1
#DSSCL_PRIORITY                 = $2

;
; Sample Buffer size
;
;#BufferSize = 44100*4
#BufferSize = 16384 ; 8

Global lpds.IDIRECTSOUND8 = #Null                   ; lpds        = DirectSound object
;Global lpdscapture.IDIRECTSOUNDCAPTURE = #Null      ; lpdscapture = DirectSound Capture object

Global wfex.WAVEFORMATEX                            ; WaveFormatEx structure for CreateOutputBuffer() and CreateInputBuffer()
Global dsbufferdesc .DSBUFFERDESC                   ; DirectSound Buffer Description
Global dscbufferdesc.DSCBUFFERDESC                  ; DirectSound Capture Buffer Description

Global dsbuffer .IDirectSoundBuffer        = #Null  ; DirectSound Buffer
;Global dscbuffer.IDirectSoundCaptureBuffer = #Null  ; DirectSound Capture Buffer


Procedure InitBuffer()
   If dsbuffer
       #DSBLOCK_ENTIREBUFFER=2
       If dsbuffer\Lock(0,0,@Ptr1,@Bytes1,@Ptr2,@Bytes2,#DSBLOCK_ENTIREBUFFER)=0
           If Ptr1
               *p.Word = Ptr1
                For i = 1 To #BufferSize/4
                  x.w!1
                  value.w = 32767-x*65535

                  *p\w = value
                  *p+2
                  *p\w = value
                  *p+2
                Next i
               
           EndIf
           dsbuffer\Unlock(Ptr1,Bytes1,Ptr2,Bytes2)
       EndIf
   EndIf
EndProcedure


Procedure CreateOutputBuffer(hWnd.l)
    ;
    ; get the DirectSound8 device object 
    ;
    hr = CoCreateInstance_(?CLSID_DirectSound8, #Null, #CLSCTX_INPROC_SERVER, ?IID_IDirectSound8, @lpds)
    If hr <> #S_OK
       ErrorHandler("Creating DirectSound8 device object failed.")  ; Add error-handling here.
    EndIf
    
    If lpds
        ;
        ; initialize the DirectSound8 device object
        ; with the GUID from DeviceSelectorDialog
        ;
        hr = lpds\Initialize(*SelectedOutputDevice)
        If hr <> #S_OK
           ErrorHandler("Initializing the DirectSound8 device failed.")  ; Add error-handling here.
        EndIf
        lpds\SetCooperativeLevel(hWnd,#DSSCL_PRIORITY)
        
        ;
        ; set WAVEFORMATEX
        ;
        wfex\cbSize         = 0
        wfex\wFormatTag     = #WAVE_FORMAT_PCM
        wfex\nChannels      = 2
        wfex\nSamplesPerSec = 44100
        wfex\wBitsPerSample = 16
        ;wfex\nBlockAlign    = (wfex\nChannels * wfex\wBitsPerSample) / 8
        wfex\nBlockAlign    = (wfex\wBitsPerSample / 8) * wfex\nChannels
        wfex\nAvgBytesPerSec= wfex\nSamplesPerSec * wfex\nBlockAlign

        ;
        ; set DirectSound Buffer Description
        ;        
        dsbufferdesc\dwSize         = SizeOf(DSBUFFERDESC)
        dsbufferdesc\dwFlags        = #DSBCAPS_LOCDEFER|#DSBCAPS_CTRLFREQUENCY
        dsbufferdesc\dwBufferBytes  = #BufferSize
        dsbufferdesc\dwReserved     = 0
        dsbufferdesc\lpwfxFormat    = @wfex
        
        ;
        ; create the Sound Buffer
        ;
        hr = lpds\CreateSoundBuffer(@dsbufferdesc,@dsbuffer,#Null)
        If hr <> #S_OK
           ErrorHandler("Initializing the DirectSound8 sound buffer failed.")  ; Add error-handling here.
        EndIf
              
    EndIf
    
EndProcedure


;
; start DirectSoundBuffer looping
;
Procedure StartBuffer()
    If dsbuffer
        dsbuffer\Play(0,0,#DSBPLAY_LOOPING)
    EndIf
EndProcedure

Procedure StopBuffer()
    If dsbuffer
        dsbuffer\Stop()
    EndIf
EndProcedure

Procedure SetBufferFrequency(freq)
    If dsbuffer
       dsbuffer\SetFrequency(freq)
    EndIf
EndProcedure


Procedure IO_Init(hWnd.l)
    ;
    ; initialize COM
    ;
    hr = CoInitializeEx_(#Null, 0)
    If hr <> #S_OK
       ErrorHandler("CoInitializeEx failed.")  ; Add error-handling here.
    EndIf
    
    ;
    ; start the DirectSound stuff...
    ; ...the procedure names say it all ;)
    ;
    CreateOutputBuffer(hWnd)
    
    InitBuffer()
        
EndProcedure


;
; IO_Close: cleanup
;
Procedure IO_Close()
    If dsbuffer                                 ;
        dsbuffer\Stop()                         ; stop and release the DirectSoundBuffer, dsbuffer
        dsbuffer\Release()                      ;
    EndIf                                       ;
    
    If lpds                                     ;
        lpds\Release()                          ; release the DirectSound object
    EndIf                                       ;
        
    CoUninitialize_()                           ; uninitialize COM
EndProcedure


;
; required GUIDs for DirectSound, from dsound.h
;
DataSection
    ;DEFINE_GUID(CLSID_DirectSound8, 0x3901cc3f, 0x84b5, 0x4fa4, 0xba, 0x35, 0xaa, 0x81, 0x72, 0xb8, 0xa0, 0x9b);
    CLSID_DirectSound8:
        Data.l $3901cc3f
        Data.w $84b5, $4fa4
        Data.b $ba, $35, $aa, $81, $72, $b8, $a0, $9b

    ;DEFINE_GUID(IID_IDirectSound8, 0xC50A7E93, 0xF395, 0x4834, 0x9E, 0xF6, 0x7F, 0xA9, 0x9D, 0xE5, 0x09, 0x66);
    IID_IDirectSound8:
        Data.l $C50A7E93
        Data.w $F395, $4834
        Data.b $9E, $F6, $7F, $A9, $9D, $E5, $09, $66
        
    ;DEFINE_GUID(CLSID_DirectSoundCapture8, 0xe4bcac13, 0x7f99, 0x4908, 0x9a, 0x8e, 0x74, 0xe3, 0xbf, 0x24, 0xb6, 0xe1);
    CLSID_DirectSoundCapture8:
        Data.l $e4bcac13
        Data.w $7f99, $4908
        Data.b $9a, $8e, $74, $e3, $bf, $24, $b6, $e1
    
    ;DEFINE_GUID(IID_IDirectSoundCapture, 0xb0210781, 0x89cd, 0x11d0, 0xaf, 0x8, 0x0, 0xa0, 0xc9, 0x25, 0xcd, 0x16);
    IID_IDirectSoundCapture8:
        Data.l $b0210781
        Data.w $89cd, $11d0
        Data.b $af, $8, $0, $a0, $c9, $25, $cd, $16
        
    ;DEFINE_GUID(IID_IDirectSoundNotify, 0xb0210783, 0x89cd, 0x11d0, 0xaf, 0x8, 0x0, 0xa0, 0xc9, 0x25, 0xcd, 0x16);
    IID_IDirectSoundNotify:
        Data.l $b0210783
        Data.w $89cd, $11d0
        Data.b $af, $8, $0, $a0, $c9, $25, $cd, $16
    
EndDataSection



;
; PROGRAM START
;
EnumAudioDevices()

DeviceSelectorDialog()

mainWindow = OpenWindow(#PB_Any,0,0,920,200,"Main Window",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
If mainWindow
    trackbar = TrackBarGadget(#PB_Any,10,10,800,30,1,25000)
    text_freq= TextGadget(#PB_Any,810,10,100,30,"300")
    ;
    ; Initialize DirectSound
    IO_Init(WindowID(mainWindow))

    SetGadgetState(trackbar,300)
    SetBufferFrequency(300)
    
    StartBuffer()
    
    Repeat
        Select WaitWindowEvent()
            Case #PB_Event_CloseWindow
                Break
            Case #PB_Event_Gadget
                If EventGadget()=trackbar
                    freq=GetGadgetState(trackbar)
                    SetGadgetText(text_freq,Str(freq))
                    SetBufferFrequency(freq)
                EndIf

        EndSelect
    ForEver

    ;
    ; cleanup
    ;    
    IO_Close()
EndIf

Re: Töne im Bereich 0-300 Hz erzeugen...

Verfasst: 03.12.2011 21:29
von NicTheQuick
Mein Fehler. Die Sample-Funktion, die ich beschrieben hab, passt gar nicht in eine Unicode-Variable. Sie muss also so aussehen:

Sample(t) = (0.5 * a * Sin(2 * Pi * t * f / 44100) + 1) * 65535

Sin() geht ja von -1 bis 1, addiert man 1 dazu, geht es von 0 bis 2, also müssen wir wieder durch 2 teilen um im Bereich 0 bis 1 zu landen und den dann mit 65535 multiplizieren. Dann sollten auch saubere Sinustöne heraus kommen.
Alle Zeiten sind UTC+02:00
Seite 1 von 2

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de