Herz-Experimentierer

[Tafkadasom2k5]

Ich habe vorhin ein bisschen mit der Sound-Lib von JaPBe rumgespielt.
Dabei ist folgendes kleines Progrämmchen rausgekommen, womit man sich Herz-Töne anhören kann.

Bitte verzeiht mir die große Unordnung im Code.Es war ja ein Experiment und ein bisschen Spaß, was am Ende sich zu einem Programm entwickelte ^^

Unten links könnt ihr die Dauer der Töne in Millisekunden angeben. Die Dauer ist nicht sehr präzise, aber die Präszision musste dafür draufgehen, dass das Fenster auch noch ansprechbar ist, während ein Ton gespielt wird.

Also: Desto kleiner die Zahl unten links, desto höher die Tonwiederholfrequenz.

Tip: mal auf "1" stellen.Macht ein Geräusch wie ein gutes altes Analog-Radio

Viel Spaß mit meinem unsinnigen Dingsi

Gr33tz
Tafkadasom2k5

Hier auch ne kompilierte Version:
http://rapidshare.de/files/10921762/Her ... r.exe.html

Code: Alles auswählen

;-Hearts-Ton-Tester (C) bei Tafkadasom2k5 12.01.2006

laenge.l
herz.l
Global lastherz.l

;- Window Constants

Enumeration
  #Window_0
EndEnumeration

;- Gadget Constants
;
Enumeration
  #String_1
  #Button_0
  #TrackBar_0
  #Text_Herz
  #check_play
EndEnumeration


Procedure Open_Window_0()
  If OpenWindow(#Window_0, 332, 106, 445, 190,  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar , "Marcs Sound-Blaster V1")
    If CreateGadgetList(WindowID())
      StringGadget(#String_1, 10, 140, 100, 30, "")
      CheckBoxGadget(#check_play,200,140,100,30, "Play")
      ButtonGadget(#Button_0, 300, 140, 100, 30, "Stop nerving!!")
      TrackBarGadget(#TrackBar_0, 40, 40, 370, 40, 0, 10000)
      SetGadgetState(#TrackBar_0,5000)
      TextGadget(#Text_Herz, 150, 80, 130, 30, "", #PB_Text_Center | #PB_Text_Border) 
    EndIf
  EndIf
EndProcedure

Procedure PlayMySound(herz.l, laenge.l)
  
  ;-Diese 4 Zeilen sind zum Entflackern der Titelleiste bei kleinen Delay-Zeiten
  If herz <> lastherz
   SetWindowTitle(#Window_0,"Current Herz playing: " + Str(herz) + "        Marcs Sound-Blaster V1")
  EndIf
  lastherz = herz


  CreateSound(1,herz,laenge,20000)

  PlaySound(1)
  
  ;-Ich hätte auch ein einfaches Delay nehmen können anstatt der For-Schleife.
  ;-Mein Fenster wär dann aber zeitweise 'ne Statue und das is ja ned der Sinn der Sache.. ;-)
  
  For i=0 To (laenge/100) * 90
    Delay(1)
    WindowEvent()
    
    If herz <> lastherz
      SetGadgetText(#Text_Herz,Str(GetGadgetState(#TrackBar_0)))
    EndIf
    
    lastherz = herz
    
    If EventGadgetID() = #Button_0
      StopSound(1)
    EndIf
    
  Next
  
  FreeSound(1)
EndProcedure



InitSound()
Open_Window_0()

SetGadgetText(#String_1,"300")

Repeat
  
  EventID = WindowEvent()
  SetGadgetText(#Text_Herz,Str(herz)+ " Herz")
  
  herz = GetGadgetState(#TrackBar_0)
  laenge = Val(GetGadgetText(#String_1))
  
  If GetGadgetState(#check_play) = 0
    SetWindowTitle(#Window_0,"Marcs Sound-Blaster V1")
  EndIf
  
  
  
  If EventID = #PB_Event_CloseWindow
    Quit = 1
  EndIf 
  
  ;-Eigentlich 'ne überflüssige Funktion- denkt man erst. Ist sie auch. Wenn man aber den ersten
  ;-Gehörschaden von den Boxen hat, weil sie zu laut aufgedreht sind, weiß man einen
  ;-größeren "Notfall-Button" zu schätzen.Ausserderm kann man so die Hz-Zahl des Tons aufschreiben
  ;-ohne das des Ding weitertüdelt.
  If GetGadgetState(#TrackBar_0) <> tester
    still = 0
  EndIf
  If EventGadgetID() = #Button_0
    tester = GetGadgetState(#TrackBar_0)
    still = 1
  EndIf
  
  If GetGadgetState(#check_play) And still = 0
    
    WindowEvent()
    
    herz = GetGadgetState(#TrackBar_0)
    laenge = Val(GetGadgetText(#String_1))

    PlayMySound(herz, laenge)

  EndIf
   
  
  Delay(1)


Until Quit = 1

[Macros]

CreateSound(1,herz,laenge,20000) is not an Funktion,
an Array, or an linked list.

(PB 3.94)

[HeX0R]

Ausserdem hiess der Typ Hertz

[Tafkadasom2k5]

@ H3xx0r:
Das soll doch das wannabe-witzige daran sein..tztztz
(will nur ned meinen Fehler zugeben wie peinlich....)

@Macros:
Du musst es leider mit JaPBe Kompilieren und dann bei "Project Options"
in der Registerkarte "Include" den "Sound-Plus" - Include aktivieren..

Gr33tz
Tafkadasom2k5

[Macros]

Danke für denn Tipp,
habe mir jetzt halt die Exe runtergeladen.

[Tafkadasom2k5]

Achtung, kleinen Bug entdeckt.Nicht weiter schlimm, aber ein wenig nervig (so sind sie nunmal unsere Kleinen )

Wenn man gerade "Play" laufen hat, und auch nicht auf den "Stille-Button" geklickt hat, ist es unmöglich das Programm "normal" zu schließen.

Nicht weiter schlimm, aber ätzend-und ich finde keine Lösung dafür.
Ausserdem ist die Zahl unter dem Balken irgendwie langsam.Dabei war es gedacht, dass diese Zahl IMMER den genauen Wert des Schiebereglers angibt und die Zahl im Fenstertitel die "Currently-Playin"-Zahl..

Naja..

Gr33tz
Tafkadasom2k5

[Falko]

Dazu braucht man nicht umbedingt JaPBe.
GPI hat ja die Procedure im englischen Forum gepostet, so das es
auch unter der PB-IDE läuft

Hab mal den Source etwas angepasst.

Code: Alles auswählen

;-Hearts-Ton-Tester (C) bei Marc Giesmann 12.01.2006

laenge.l
Hertz.l
Global lastHertz.l

;- Window Constants

Enumeration
  #Window_0
EndEnumeration

;- Gadget Constants
;
Enumeration
  #String_1
  #Button_0
  #TrackBar_0
  #Text_Hertz
  #check_play
EndEnumeration
;http://forums.purebasic.com/english/viewtopic.php?p=33517#33517
; Von GPI

Structure wave_
  wFormatTag.w
  nChannels.w
  nSamplesPerSec.l
  nAvgBytesPerSec.l
  nBlockAlign.w
  wBitsPerSample.w
  cbSize.w
EndStructure 

Procedure CreateSound(nr,Frequency,Duration,SampleRate);
  SoundValue.b
  w.f; // omega ( 2 * pi * frequency)
 
  wave_FormatEx.wave_
  wave_FormatEx\wFormatTag=#WAVE_FORMAT_PCM;
  wave_FormatEx\nChannels =$0001;mono
  wave_FormatEx\nSamplesPerSec = SampleRate;
  wave_FormatEx\wBitsPerSample = $0008;
  wave_FormatEx\nBlockAlign = (wave_FormatEx\nChannels * wave_FormatEx\wBitsPerSample) /8
  wave_FormatEx\nAvgBytesPerSec = wave_FormatEx\nSamplesPerSec * wave_FormatEx\nBlockAlign;
  wave_FormatEx\cbSize = 0;
 
  DataCount = (Duration * SampleRate)/1000; // sound data
  RiffCount = 4+4 +4+ SizeOf(wave_)+4 +4+ DataCount
 
  start=GlobalAlloc_(#GMEM_FIXED|#GMEM_ZEROINIT,RiffCount+100)
  MS=start
 
  PokeS(MS,"RIFF"):MS+4   ;'RIFF'
  PokeL(MS,RiffCount):MS+4 ;file Data size
  PokeS(MS,"wave"):MS+4   ;'wave_'
  PokeS(MS,"fmt "):MS+4    ;'fmt '
  TempInt = SizeOf(wave_);
  PokeL(MS,TempInt):MS+4   ;Twave_Format data size
 
  PokeW(MS,wave_FormatEx\wFormatTag):MS+2; wave_FormatEx record
  PokeW(MS,wave_FormatEx\nChannels):MS+2
  PokeL(MS,wave_FormatEx\nSamplesPerSec):MS+4
  PokeL(MS,wave_FormatEx\nAvgBytesPerSec):MS+4
  PokeW(MS,wave_FormatEx\nBlockAlign):MS+2
  PokeW(MS,wave_FormatEx\wBitsPerSample):MS+2
  PokeW(MS,wave_FormatEx\cbSize):MS+2
 
  PokeS(MS,"data"):MS+4   ;'data'
  PokeL(MS,DataCount):MS+4 ;sound data size
 
  ; {Calculate And write out the tone signal}  // now the Data values
 
  w = 2 * 3.1415 * Frequency;  omega
  For i = 0 To DataCount - 1
   SoundValue = 127 + 127 * Sin(i * w / SampleRate);
   PokeB(MS,SoundValue):MS+1;
  Next
  CatchSound(Nr,start)
  GlobalFree_(start)
EndProcedure

Procedure Open_Window_0()
  If OpenWindow(#Window_0, 332, 106, 445, 190,  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar , "Marcs Sound-Blaster V1")
    If CreateGadgetList(WindowID())
      StringGadget(#String_1, 10, 140, 100, 30, "")
      CheckBoxGadget(#check_play,200,140,100,30, "Play")
      ButtonGadget(#Button_0, 300, 140, 100, 30, "Stop nerving!!")
      TrackBarGadget(#TrackBar_0, 40, 40, 370, 40, 0, 10000)
      SetGadgetState(#TrackBar_0,5000)
      TextGadget(#Text_Hertz, 150, 80, 130, 30, "", #PB_Text_Center | #PB_Text_Border)
    EndIf
  EndIf
EndProcedure

Procedure PlayMySound(Hertz.l, laenge.l)
 
  ;-Diese 4 Zeilen sind zum Entflackern der Titelleiste bei kleinen Delay-Zeiten
  If Hertz <> lastHertz
   SetWindowTitle(#Window_0,"Current Hertz playing: " + Str(Hertz) + "        Marcs Sound-Blaster V1")
  EndIf
  lastHertz = Hertz


  CreateSound(1,Hertz,laenge,20000)

  PlaySound(1)
 
  ;-Ich hätte auch ein einfaches Delay nehmen können anstatt der For-Schleife.
  ;-Mein Fenster wär dann aber zeitweise 'ne Statue und das is ja ned der Sinn der Sache.. ;-)
 
  For i=0 To (laenge/100) * 90
    Delay(1)
    WindowEvent()
   
    If Hertz <> lastHertz
      SetGadgetText(#Text_Hertz,Str(GetGadgetState(#TrackBar_0)))
    EndIf
   
    lastHertz = Hertz
   
    If EventGadgetID() = #Button_0
      StopSound(1)
    EndIf
   
  Next
 
  FreeSound(1)
EndProcedure



InitSound()
Open_Window_0()

SetGadgetText(#String_1,"300")

Repeat
 
  EventID = WindowEvent()
  SetGadgetText(#Text_Hertz,Str(Hertz)+ " Hertz")
 
  Hertz = GetGadgetState(#TrackBar_0)
  laenge = Val(GetGadgetText(#String_1))
 
  If GetGadgetState(#check_play) = 0
    SetWindowTitle(#Window_0,"Marcs Sound-Blaster V1")
  EndIf
 
 
 
  If EventID = #PB_Event_CloseWindow
    Quit = 1
  EndIf
 
  ;-Eigentlich 'ne überflüssige Funktion- denkt man erst. Ist sie auch. Wenn man aber den ersten
  ;-Gehörschaden von den Boxen hat, weil sie zu laut aufgedreht sind, weiß man einen
  ;-größeren "Notfall-Button" zu schätzen.Ausserderm kann man so die Hz-Zahl des Tons aufschreiben
  ;-ohne das des Ding weitertüdelt.
  If GetGadgetState(#TrackBar_0) <> tester
    still = 0
  EndIf
  If EventGadgetID() = #Button_0
    tester = GetGadgetState(#TrackBar_0)
    still = 1
  EndIf
 
  If GetGadgetState(#check_play) And still = 0
   
    WindowEvent()
   
    Hertz = GetGadgetState(#TrackBar_0)
    laenge = Val(GetGadgetText(#String_1))

    PlayMySound(Hertz, laenge)

  EndIf
   
 
  Delay(1)


Until Quit = 1