2013-06-19 07:53

'****************************************************************
'* This program was written by Elyn Rudy ,for the RAPIDQ compiler
'* written by Whilliam Yu. The code is just some freeware example
'* so you can do what ever you want with it. If you use any of
'* this routines in your code give the author's some credit too.
'* I've tested the program on my 300 MHz computer with 32 Mb Ram
'* and the result was about 4000 samples/sec (4KHz).
'* If you could make it faster by changing the code, then give
'* me some feedback at Rudy@VT4.NET (Belguim)
'* Also the program needs a SoundBlaster compatible card with a
'* line input. To load and run the code you have to use JFE, also
'* available on the downloadsite of RAPIDQ.
'****************************************************************

     DIM BasePort AS INTEGER, ReadPort AS INTEGER, WritePort AS INTEGER
     DIM X AS INTEGER, EindX AS INTEGER, Stap AS INTEGER, DacVal AS INTEGER
     DIM Hoog AS LONG, AchterKleur AS LONG, VoorKleur AS LONG
     DIM Hoogte AS INTEGER, WaardeY AS INTEGER, TijdX AS INTEGER, MaxLeng AS INTEGER
     DIM Y AS INTEGER, OldY AS INTEGER, Hoeveel AS INTEGER, Vroeg AS INTEGER, Iindex AS INTEGER
     DIM LineDummyR AS INTEGER, LineDummyL AS INTEGER, Uit AS INTEGER
     DIM Bit(60001) AS BYTE

     $INCLUDE "RapidQ.INC"
     $INCLUDE "C:\RQBETA\SBTest\SBform.bas"   'CHANGE THIS DIRECTORY
     $INCLUDE "C:\RQBETA\SBTest\SBlib.bas"    'CHANGE THIS DIRECTORY

     X = 0 : EindX = ListBox1.Width
     Stap = 1 : Hoog = 2
     AchterKleur = ListBox1.COLOR : VoorKleur = QBColor(12)
     Hoogte = ListBox1.Height : WaardeY = -350

     IF IsSb THEN
      SHOWMESSAGE "The Sound Blaster was not detected !!"
      END
     ELSE
      ReadPort = BasePort + &hA : WritePort = BasePort + &hC
      LineDummyR = LineRechtsVol
      LineDummyL = LineLinksVol
      ScrollBar2.Position = 2
      SetLineVol (13, 13)
     END IF


     SUB VeranderMag
      IF ComboBox2.ItemIndex = 0 THEN Hoog = 1 : WaardeY = -135
      IF ComboBox2.ItemIndex = 1 THEN Hoog = 2 : WaardeY = -350
      IF ComboBox2.ItemIndex = 2 THEN Hoog = 3 : WaardeY = -560
     END SUB

     SUB VeranderKleur
      IF ComboBox1.ItemIndex = 0 THEN VoorKleur = QBcolor(12)
      IF ComboBox1.ItemIndex = 1 THEN VoorKleur = QBcolor(2)
      IF ComboBox1.ItemIndex = 2 THEN VoorKleur = QBcolor(1)
     END SUB

'**************
'HOOFDPROGRAMMA
'**************
     SUB BeginLezen
      ScrollBar1.Visible = False
      Button1.Enabled = False
      Button2.Enabled = False
      Button3.Enabled = TRUE
      DIM SAMP AS INTEGER, P AS INTEGER
      Y = ((INP(ReadPort)) * Hoog) + WaardeY
      X = 0 : TijdX = X : Uit = 0 : Uit% = 0
      Tijd! = TIMER : Samp = 0
      DO
       DOEVENTS
       OUT WritePort,&h20
       OldY = Y
       Y = INT((INP(ReadPort) * Hoog) + WaardeY)
       ListBox1.Line (X ,OldY ,X+1 ,Y ,VoorKleur)
       INC X : INC Samp
       ListBox1.FillRect (X+1 ,0 ,X+3 ,Hoogte ,AchterKleur)
       IF TIMER >= Tijd! + 1 THEN
        Edit2.text = STR$(Samp)
        Samp = 0 : Tijd! = TIMER
       END IF
       IF X > EindX THEN
        IF Uit = 1 THEN Uit% = 1
        X = TijdX
        ListBox1.FillRect (X ,0 ,X+2 ,Hoogte ,AchterKleur)
       END IF
      LOOP UNTIL Uit% = 1
      Button1.Enabled = True
      Button2.Enabled = True
      Button3.Enabled = FALSE
     END SUB

     SUB Opnemen
      Button1.Enabled = False
      Button2.Enabled = False
      Button3.Enabled = TRUE
      Iindex = 0 : Uit = 0
      DO
       DOEVENTS
       OUT WritePort,&h20
       Bit(Iindex) = INP(ReadPort)
       INC Iindex
       IF Iindex = 60000 THEN Uit = 1
      LOOP UNTIL Uit = 1
      MaxLeng = Iindex
      ScrollBar1.Max = Iindex - EindX
      ScrollBar1.Position = 0
      Button1.Enabled = True
      Button2.Enabled = True
      Button3.Enabled = FALSE
      ScrollBar1.Visible = True
     END SUB


     SUB Afspelen
      DIM Z AS INTEGER
      ListBox1.FillRect (0 ,0 ,EindX ,Hoogte ,AchterKleur)
      X = ScrollBar1.Position
      Y = INT((Bit(X) * Hoog) + WaardeY) : Xx% = 0 : INC X
      FOR Z = X TO X + EindX
       OldY = Y
       Y = INT((Bit(Z) * Hoog) + WaardeY)
       ListBox1.Line (Xx% ,OldY ,Xx% + 1 ,Y ,VoorKleur)
       INC Xx%
       IF Z => MaxLeng THEN EXIT FOR
      NEXT
     END SUB

     SUB LijnVolume
      SetLineVol ((15 - ScrollBar2.Position) , (15 - ScrollBar2.Position))
     END SUB

     SUB SesieBegin
      Form.TextOut(170,212,"Samples/Sec.",0,Form.COLOR)
      Form.TextOut(5,188,"Color",0,Form.COLOR)
      Form.TextOut(5,212,"Mag.",0,Form.COLOR)
      Form.TextOut(240,107,"Line",0,Form.COLOR)
      Form.TextOut(240,120,"Volume",0,Form.COLOR)
     END SUB

     SUB EindeSesie
      SetLineVol (LineDummyR,LineDummyL)
     END SUB

     SUB Eindigen
      Uit = 1
     END SUB


     Button1.OnClick = BeginLezen
     Button2.OnClick = Opnemen
     Button3.OnClick = Eindigen
     ScrollBar1.OnChange = Afspelen
     ScrollBar2.OnChange = LijnVolume
     ComboBox1.OnChange = VeranderKleur
     ComboBox2.OnChange = VeranderMag
     Form.OnPaint = SesieBegin
     Form.OnClose = EindeSesie
     Form.SHOWMODAL

2013-06-19 07:53