Author Topic: Noise Generator with BASS.dll for Lazarus  (Read 199 times)

USERPC01

  • Posts: 26
Noise Generator with BASS.dll for Lazarus
« on: 10 Aug '18 - 21:15 »
project1.lpr
Code: [Select]
program project1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Interfaces, // this includes the LCL widgetset
  Forms,  uNoiseTest1
  { you can add units after this };

{$R *.res}

begin
  RequireDerivedFormResource:=True;
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
       


uNoiseTest1.pas

Code: [Select]
unit uNoiseTest1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls,
  Bass;

type

  { TForm1 }
  DWORD=LongWord;
  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    procedure BitBtn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
  private
    { Private declarations }
    NoiseStream : HSTREAM;
    Toggle     : boolean;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

uses Math;

function MakeNoise( handle: HSTREAM; buffer: Pointer; length: DWORD; user: Pointer): DWORD; stdcall;
var
  buf : ^word;
  i, len : Integer;
begin
  buf := buffer;
  len := length div 2;
  for i := 0 to len - 1 do
  begin
    buf^ := 65538 - trunc(random(32767)); // Werte sind 'SIGNED'
    inc(buf);
  end;
  result := length;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // check the correct BASS was loaded
  if (HIWORD(BASS_GetVersion) <> BASSVERSION) then
  begin
  //  MessageBox(0,'An incorrect version of BASS.DLL was loaded',0,MB_ICONERROR);
    exit;
  end;
  // Initialize BASS with the default device
  if NOT BASS_Init(-1, 44100, 0, Handle, nil) then
  begin
    //MessageBox(0,'Could not initialize BASS',0,MB_ICONERROR);
    exit;
  end;
  Toggle := false;
  Randomize;
  NoiseStream := BASS_StreamCreate(44100, 2, 0, @MakeNoise, 0);
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  BASS_ChannelStop(NoiseStream);
  BASS_StreamFree(NoiseStream);
  Bass_Free;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  if not Toggle then
  begin
    if not BASS_ChannelPlay(NoiseStream, true) then
    begin
     /// MessageBox(0,'Could not start stream playback',0,MB_ICONERROR);
      Exit;
    end;
    BitBtn2.Caption := 'STOP';
    Toggle := true;
  end
  else
  begin
    BASS_ChannelStop(NoiseStream);
    BitBtn2.Caption := 'START';
    Toggle := false;
  end;
end;

end.


bass.pas , bass.dll are from bass24.zip folder, from site  https://www.un4seen.com/
How to fix  bugs


Code: [Select]
Hint: (11030) Start of reading config file C:\lazarus\fpc\3.0.4\bin\i386-win32\fpc.cfg
Hint: (11031) End of reading config file C:\lazarus\fpc\3.0.4\bin\i386-win32\fpc.cfg
Free Pascal Compiler version 3.0.4 [2018/05/19] for i386
Copyright (c) 1993-2017 by Florian Klaempfl and others
(1002) Target OS: Win32 for i386
(3104) Compiling project1.lpr
(3104) Compiling unoisetest1.pas
C:\Users\USER_PC01\Desktop\folder2\unoisetest1.pas(37,21) Hint: (5024) Parameter "handle" not used
C:\Users\USER_PC01\Desktop\folder2\unoisetest1.pas(37,70) Hint: (5024) Parameter "user" not used
C:\Users\USER_PC01\Desktop\folder2\unoisetest1.pas(68,62) Error: (4025) Incompatible type for arg no. 5: Got "ShortInt", expected "Pointer"
C:\Users\USER_PC01\Desktop\folder2\bass.pas(836,10) Hint: (5039) Found declaration: BASS_StreamCreate(LongWord;LongWord;LongWord;STREAMPROC;Pointer):DWord; StdCall;
unoisetest1.pas(105) Fatal: (10026) There were 1 errors compiling module, stopping
Fatal: (1018) Compilation aborted
Error: C:\lazarus\fpc\3.0.4\bin\i386-win32\ppc386.exe returned an error exitcode

USERPC01

  • Posts: 26
Re: Noise Generator with BASS.dll for Lazarus
« Reply #1 on: 10 Aug '18 - 21:16 »
How to use unit Messages in the  Lazarus ?

USERPC01

  • Posts: 26
Re: Noise Generator with BASS.dll for Lazarus
« Reply #2 on: 10 Aug '18 - 21:18 »
NoiseStream := BASS_StreamCreate(44100, 2, 0, @MakeNoise, 0); could not work. How to  fix data type incompatibility?

USERPC01

  • Posts: 26

USERPC01

  • Posts: 26
Re: Noise Generator with BASS.dll for Lazarus
« Reply #4 on: 10 Aug '18 - 21:22 »
Code: [Select]
unit uNoiseTest1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls,
  Bass;

type

  { TForm1 }
  DWORD=LongWord;
  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    procedure BitBtn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
  private
    { Private declarations }
    NoiseStream : HSTREAM;
    Toggle     : boolean;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

uses Math;

function MakeNoise( handle: HSTREAM; buffer: Pointer; length: DWORD; user: Pointer): DWORD; stdcall;
var
  buf : ^word;
  i, len : Integer;
begin
  buf := buffer;
  len := length div 2;
  for i := 0 to len - 1 do
  begin
    buf^ := 65538 - trunc(random(32767)); // Werte sind 'SIGNED'
    inc(buf);
  end;
  result := length;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // check the correct BASS was loaded
  if (HIWORD(BASS_GetVersion) <> BASSVERSION) then
  begin
  //  MessageBox(0,'An incorrect version of BASS.DLL was loaded',0,MB_ICONERROR);
    exit;
  end;
  // Initialize BASS with the default device
  if NOT BASS_Init(-1, 44100, 0, Handle, nil) then
  begin
    //MessageBox(0,'Could not initialize BASS',0,MB_ICONERROR);
    exit;
  end;
  Toggle := false;
  Randomize;
  NoiseStream := BASS_StreamCreate(44100, 2, 0, @MakeNoise, nil);
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  BASS_ChannelStop(NoiseStream);
  BASS_StreamFree(NoiseStream);
  Bass_Free;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  if not Toggle then
  begin
    if not BASS_ChannelPlay(NoiseStream, true) then
    begin
     /// MessageBox(0,'Could not start stream playback',0,MB_ICONERROR);
      Exit;
    end;
    BitBtn2.Caption := 'STOP';
    Toggle := true;
  end
  else
  begin
    BASS_ChannelStop(NoiseStream);
    BitBtn2.Caption := 'START';
    Toggle := false;
  end;
end;

end.
           


using NoiseStream := BASS_StreamCreate(44100, 2, 0, @MakeNoise, nil); , bug may be fixed .

USERPC01

  • Posts: 26
Re: Noise Generator with BASS.dll for Lazarus
« Reply #5 on: 10 Aug '18 - 21:38 »
Program with fixed bugs

unoisetest1.lfm
Code: [Select]
object Form1: TForm1
  Left = 141
  Height = 300
  Top = 572
  Width = 400
  Caption = 'Form1'
  ClientHeight = 300
  ClientWidth = 400
  DesignTimePPI = 120
  OnCreate = FormCreate
  LCLVersion = '1.8.4.0'
  object BitBtn1: TBitBtn
    Left = 120
    Height = 38
    Top = 128
    Width = 174
    Caption = 'Exit'
    OnClick = BitBtn1Click
    TabOrder = 0
  end
  object BitBtn2: TBitBtn
    Left = 120
    Height = 38
    Top = 64
    Width = 174
    Caption = 'Turn on Noise Generator'
    OnClick = BitBtn2Click
    TabOrder = 1
  end
end


unoisetest1.pas
Code: [Select]
unit uNoiseTest1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls,
  Bass;

type

  { TForm1 }
  DWORD=LongWord;
  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    procedure BitBtn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
  private
    { Private declarations }
    NoiseStream : HSTREAM;
    Toggle     : boolean;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

uses Math;

function MakeNoise( handle: HSTREAM; buffer: Pointer; length: DWORD; user: Pointer): DWORD; stdcall;
var
  buf : ^word;
  i, len : Integer;
begin
  buf := buffer;
  len := length div 2;
  for i := 0 to len - 1 do
  begin
    buf^ := 65538 - trunc(random(32767)); // Werte sind 'SIGNED'
    inc(buf);
  end;
  result := length;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // check the correct BASS was loaded
  if (HIWORD(BASS_GetVersion) <> BASSVERSION) then
  begin
     MessageBox(0,'An incorrect version of BASS.DLL was loaded','Error',MB_ICONERROR);
    exit;
  end;
  // Initialize BASS with the default device
  if NOT BASS_Init(-1, 44100, 0, Handle, nil) then
  begin
    MessageBox(0,'Could not initialize BASS','Error',MB_ICONERROR);
    exit;
  end;
  Toggle := false;
  Randomize;
  NoiseStream := BASS_StreamCreate(44100, 2, 0, @MakeNoise, nil);
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
   Close;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  BASS_ChannelStop(NoiseStream);
  BASS_StreamFree(NoiseStream);
  Bass_Free;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  if not Toggle then
  begin
    if not BASS_ChannelPlay(NoiseStream, true) then
    begin
       MessageBox(0,'Could not start stream playback','Error', MB_ICONERROR);
      Exit;
    end;
    BitBtn2.Caption := 'STOP';
    Toggle := true;
  end
  else
  begin
    BASS_ChannelStop(NoiseStream);
    BitBtn2.Caption := 'START';
    Toggle := false;
  end;
end;

end.
     

USERPC01

  • Posts: 26
Re: Noise Generator with BASS.dll for Lazarus
« Reply #6 on: 10 Aug '18 - 22:33 »
Alternative edition of noise generator  from using data from  https://www.delphipraxis.net/  for Lazarus :
project1.lpr
Code: [Select]
program project1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Interfaces, // this includes the LCL widgetset
  Forms, PinkMain
  { you can add units after this };

{$R *.res}

begin
  RequireDerivedFormResource:=True;
  Application.Initialize;
  Application.CreateForm(TNoiseForm, NoiseForm);
  Application.Run;
end.


project1.lps
Code: [Select]
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
  <ProjectSession>
    <PathDelim Value="\"/>
    <Version Value="10"/>
    <BuildModes Active="Default"/>
    <Units Count="4">
      <Unit0>
        <Filename Value="project1.lpr"/>
        <IsPartOfProject Value="True"/>
        <EditorIndex Value="3"/>
        <CursorPos X="19" Y="10"/>
        <UsageCount Value="21"/>
        <Loaded Value="True"/>
      </Unit0>
      <Unit1>
        <Filename Value="PinkMain.pas"/>
        <IsPartOfProject Value="True"/>
        <ComponentName Value="NoiseForm"/>
        <HasResources Value="True"/>
        <ResourceBaseClass Value="Form"/>
        <IsVisibleTab Value="True"/>
        <TopLine Value="135"/>
        <CursorPos X="14" Y="141"/>
        <UsageCount Value="21"/>
        <Loaded Value="True"/>
        <LoadedDesigner Value="True"/>
      </Unit1>
      <Unit2>
        <Filename Value="PinkMain.pas"/>
        <EditorIndex Value="1"/>
        <CursorPos X="2" Y="141"/>
        <UsageCount Value="10"/>
        <Loaded Value="True"/>
      </Unit2>
      <Unit3>
        <Filename Value="pink2.pas"/>
        <EditorIndex Value="2"/>
        <TopLine Value="45"/>
        <CursorPos X="2" Y="58"/>
        <UsageCount Value="10"/>
        <Loaded Value="True"/>
      </Unit3>
    </Units>
    <JumpHistory Count="3" HistoryIndex="2">
      <Position1>
        <Filename Value="pink2.pas"/>
        <Caret Line="158" Column="18" TopLine="82"/>
      </Position1>
      <Position2>
        <Filename Value="PinkMain.pas"/>
        <Caret Line="149" Column="4" TopLine="126"/>
      </Position2>
      <Position3>
        <Filename Value="PinkMain.pas"/>
        <Caret Line="156" Column="4" TopLine="133"/>
      </Position3>
    </JumpHistory>
  </ProjectSession>
</CONFIG>






USERPC01

  • Posts: 26
Re: Noise Generator with BASS.dll for Lazarus
« Reply #7 on: 10 Aug '18 - 22:35 »
main module PinkMain.pas
Code: [Select]
unit PinkMain;

{$mode objfpc}{$H+}



 interface

 uses
   ComCtrls,

   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls, Buttons, ExtCtrls,
   Bass;

 type
   DWORD=LongWord;
   { TNoiseForm }

   TNoiseForm = class(TForm)
     BitBtn1: TBitBtn;
     BitBtn2: TBitBtn;
     Label1: TLabel;
     TrackBar1: TTrackBar;
     procedure BitBtn1Click(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
     procedure BitBtn2Click(Sender: TObject);
     procedure TrackBar1Change(Sender: TObject);

   private
     { Private declarations }
     CanUseFloat : boolean;
     NoiseStream : HSTREAM;
     Toggle     : boolean;
   public
     { Public declarations }
   end;

 var
   NoiseForm: TNoiseForm;

 implementation

 {$R *.lfm}

 uses
   Pink2;

 var
   PN_L, PN_R : TPinkNoise2; // 2 different noises for left and right channel

 // -----------------------------------------------------------------------------
// Don't include in a Class or Form !
 function MakeNoise(handle: HSTREAM; buffer: Pointer; length: DWORD; user: Pointer): DWORD; stdcall;
 var
   buf : ^word;
   i, len : Integer;
 begin
   buf := buffer;
   len := length div 4;                         // Stereo
   for i := 0 to len - 1 do
   begin
     buf^ := word(trunc(PN_L.GetPinkNoiseVal)); // if procedure has extended result !)
     inc(buf);
     buf^ := word(trunc(PN_R.GetPinkNoiseVal));
     inc(buf);
   end;
   result := length;
 end;

 // -----------------------------------------------------------------------------
procedure TNoiseForm.FormCreate(Sender: TObject);
 var
   floatable : DWORD; // floating-point channel support? 0 = no, else yes
 begin
   // check if the correct BASS-Version was loaded
   if (HIWORD(BASS_GetVersion) <> BASSVERSION) then
   begin
     MessageBox(0, 'An incorrect version of BASS.DLL was loaded', nil, MB_ICONERROR);
     Halt; // ? exit;
   end;
   // Initialize BASS with the default device
   if (not BASS_RecordInit(-1))        // default Device
   or (not BASS_Init(-1,               // default Device
                     44100,            // Samplerate
                     0,                // Flags; 0 = 16 Bit Audio
                     Handle,           // App Window-Handle
                     nil))             // Defaultpointer User/DirectX
   then
   begin
     // for safety: Free possible resources
     BASS_RecordFree;
     BASS_Free;
     MessageBox(0, 'Could not initialize BASS with default Device', nil, MB_ICONERROR);
     Halt; // ? exit;
   end;
   // Ttry creating a floating-point stream to use
   CanUseFloat := false;
   floatable := BASS_StreamCreate(44100, 2, BASS_SAMPLE_FLOAT, NIL, NIL);
   if boolean(floatable) then
   begin
     CanUseFloat := true;              // floating-point channels are supported !
     BASS_StreamFree(floatable);       // free the test stream ...
   end;
   // Init the neccessary rest
   Toggle  := false;                  // START NOISE
   PN_L    := TPinkNoise2.Create(16, 70); // 16 Rows, 70% value
   PN_R    := TPinkNoise2.Create(16, 70); // 16 Rows, 70% value
   // create the NoiseStream
   NoiseStream := BASS_StreamCreate(44100, 2, 0, @MakeNoise, NIL);
 end;

procedure TNoiseForm.BitBtn1Click(Sender: TObject);
begin
  Close;
end;

 // -----------------------------------------------------------------------------
procedure TNoiseForm.FormDestroy(Sender: TObject);
 begin
   BASS_ChannelStop(NoiseStream);   // for safety
   BASS_StreamFree(NoiseStream);    // for safety
   Bass_Free;
   PN_L.Free;                       // for safety
   PN_R.Free;                       // for safety
 end;

 // -----------------------------------------------------------------------------
procedure TNoiseForm.BitBtn2Click(Sender: TObject);
 begin
   if not Toggle then
   begin
     if not BASS_ChannelPlay(NoiseStream, false) then
     begin
       MessageBox(0, 'Could not start stream playback', nil, MB_ICONERROR);
       Exit;
     end;
     BitBtn2.Caption := 'STOP NOISE';
     Toggle := true;
   end
   else
   begin
     BASS_ChannelStop(NoiseStream);
     BitBtn2.Caption := 'START NOISE';
     Toggle := false;
   end;
 end;

 // -----------------------------------------------------------------------------
// Min = 0, Max = 100, Position = 70, Frequency = 10
 procedure TNoiseForm.TrackBar1Change(Sender: TObject);
 begin
   PN_L.SetPinkNoiseLevel(TrackBar1.Position);
   PN_R.SetPinkNoiseLevel(TrackBar1.Position);
       Label1.Caption:=IntToStr(TrackBar1.Position);
 end;

 end.






USERPC01

  • Posts: 26
Re: Noise Generator with BASS.dll for Lazarus
« Reply #8 on: 10 Aug '18 - 22:36 »
pink2.pas
Code: [Select]
{
   Generation of pink noise

     For basic knwoledge and derivation take a look at:
     http://www.firstpr.com.au/dsp/pink-noise/
     by Phil Burk, http://www.softsynth.com
     Copyleft 1999 Phil Burk - No rights reserved.
     File/s:
     Original: http://www.firstpr.com.au/dsp/pink-noise/phil_burk_19990905_patest_pink.c
     ... else: patest_pink.c (https://www.assembla.com/code/portaudio/subversion/nodes/1368/portaudio/branches/v19-devel/test/patest_pink.c)

   Extended to use with BASS.DLL >= 2.4.10 by TERWI
   V 1.0 - 2014-05-16
 }

unit pink2;

 interface

 uses
   SysUtils, Types;

 const
   PINK_MAX_RANDOM_ROWS  = 30;
   PINK_RANDOM_BITS      = 24;
   PINK_RANDOM_SHIFT     = 8; // ((sizeof(long)*8)-PINK_RANDOM_BITS)
   PINK_OUTVALMAX        = 32767;
   PINK_OUTVALMIN        = -32767;

 type
   TPinkNoiseStat = record
     Rows      : array[0..PINK_MAX_RANDOM_ROWS - 1] of longword;
     RunningSum : longint; // Used to optimize summing of generators
     Index     : integer; // Incremented each sample
     IndexMask : integer; // Index wrapped by ANDing with this mask
     rndMax    : DWORD;   // max. value for Random
     IncVal    : boolean; // switch to align the master value to max
     Min       : longint; // min val dependend on rand-generation
     Max       : longint; // max val dependend on rand-generation
     Avg       : longint; // calc average val
     SumMin    : longint; // min val output integer (before level)
     SumMax    : longint; // max val output integer (before level)
     Level     : integer; // 0 to 100 (%) Default: 70
   end;

 type
   TPinkNoise2 = Class
   private
     PNS : TPinkNoiseStat;
     function   GenerateRandomNumber : longint;
   public
     Constructor Create(numRows : integer; level : integer);
     function   GetPinkNoiseVal : longint;
     procedure  SetPinkNoiseLevel(level : integer);
     procedure  GetPinkNoiseStat(var _PNS : TPinkNoiseStat);
   end;

 implementation

 // -----------------------------------------------------------------------------
// Setup PinkNoise structure for N rows of generators.
 // Level is between 0 and 100
 constructor TPinkNoise2.Create(numRows : integer; level : integer);
 var
   i : integer;
 begin
   // Initialize var's
   // Define parameter:
   for i := 0 to numRows - 1 do PNS.Rows[i] := 0; // filled by procedure
   PNS.RunningSum := 0;          // Used to optimize summing of generators
   PNS.Index     := 0;          // Incremented each sample
   PNS.IndexMask := 0;          // Index wrapped by ANDing with this mask
   PNS.rndMax    := 65536 * 16; // max. value for Random (default)
   PNS.IncVal    := true;       // enable auto-increasing out-val (by WarmUp)
   PNS.Min       := 2147483647; // min val dependend on rand-generation
   PNS.Max       := -2147483647; // max val dependend on rand-generation
   PNS.Avg       := -1;         // substract for average zero
   PNS.SumMin    := PNS.Min;    // min val output integer (before level)
   PNS.SumMax    := PNS.Max;    // max val output integer (before level)
   // Initialize:
   if (numrows > PINK_MAX_RANDOM_ROWS) then numrows := PINK_MAX_RANDOM_ROWS; // for safety
   PNS.Index := 0;
   PNS.IndexMask := (1 shl numRows) - 1;
   // Initialize rows.
   for i := 0 to numRows - 1 do PNS.Rows[i] := 0;
   PNS.RunningSum := 0;
   // initialize Random
   Randomize;
   // "WarmUp" to align level: call 1 million values
   // (takes less than a blink of an eye...)
   for i := 1 to 1000000 do GetPinkNoiseVal;
   // Set Outputlevel (either int or float)
   SetPinkNoiseLevel(level);
 end;

 // -----------------------------------------------------------------------------
// Calculate pseudo-random 32 bit number based on linear congruential method.
 function TPinkNoise2.GenerateRandomNumber : longint;
 begin
   result := Random(PNS.rndMax); // randomMax can change during runtime
 end;

 // -----------------------------------------------------------------------------
// Generate Pink noise values between -1.0 and +1.0
 function TPinkNoise2.GetPinkNoiseVal : longint;
 var
   newRandom  : longint;
   sum        : longint;
   OutFloat   : extended;
   OutInt     : longint;
   n, numZeros : integer;
 begin
   // Increment and mask index.
   PNS.Index := (PNS.Index + 1) and PNS.IndexMask;
   // If index is zero, don't update any random values.
   if (PNS.Index <> 0) then
   begin
     // Determine how many trailing zeros in PinkIndex.
     // This algorithm will hang if n==0 so test first.
     numZeros := 0;
     n := PNS.Index;
     while ((n and 1) = 0) do
     begin
       n := n shr 1;
       inc(numZeros);
     end;
     // Replace the indexed ROWS random value.
     // Subtract and add back to RunningSum instead of adding all the random
     // values together. Only one changes each time.
     PNS.RunningSum := PNS.RunningSum - PNS.Rows[numZeros];
     newRandom := GenerateRandomNumber shr PINK_RANDOM_SHIFT;
     PNS.RunningSum := PNS.RunningSum + newRandom;
     PNS.Rows[numZeros] := newRandom;
   end;
   // Add extra white noise value.
   newRandom := GenerateRandomNumber shr PINK_RANDOM_SHIFT;
   sum := PNS.RunningSum + newRandom;

   // Normalize the signal (by TERWI)
   if (sum < PNS.Min) then PNS.Min := sum;
   if (sum > PNS.Max) then PNS.Max := sum;
   PNS.Avg := (PNS.Max - PNS.Min) div 2;
   sum := (sum - PNS.Min) - PNS.Avg;

   // Check maximum Generator-value for 0dB-output and to provide overload
   if (sum < PNS.SumMin) then
   begin
     PNS.SumMin := sum;
     if PNS.SumMin < PINK_OUTVALMIN then // Overload negativ ?
     begin                               // YES !
       Sum := PINK_OUTVALMIN;            // Limit value now
       dec(PNS.rndMax, 300);             // reduce max. value at generation
       PNS.IncVal := false;              // stop increasing val to max
     end;
   end;
   if (sum > PNS.SumMax) then
   begin
     PNS.SumMax := sum;
     if PNS.SumMax > PINK_OUTVALMAX then // Overload positiv ?
     begin                               // YES !
       Sum := PINK_OUTVALMAX;            // Limit value now
       dec(PNS.rndMax, 300);             // reduce max. value at generation
       PNS.IncVal := false;              // stop increasing val to max
     end;
   end;
   if PNS.IncVal then inc(PNS.rndMax, 10); // stepwise increasing max. value by generation

   // Set level after normalization
   OutInt := sum * PNS.Level div 100;
   // Scale to range of -1.0 to 1.
   //OutFloat := 1 / OutInt;                // not in use yet

   result := OutInt;
 end;

 // -----------------------------------------------------------------------------
// Set PinkNoise level: 0 - 100 %
 procedure TPinkNoise2.SetPinkNoiseLevel(level : integer);
 begin
   if (level > 100) then level := 100;
   if (level < 0)  then level := 0;
   PNS.Level := level;
 end;

 // -----------------------------------------------------------------------------
// Get PinkNoise Statistics
 // ! Copy/Move seems not working. So do it in old fashion way ... var2var
 procedure TPinkNoise2.GetPinkNoiseStat(var _PNS : TPinkNoiseStat);
 var
   i : integer;
 begin
   for I := 0 to PINK_MAX_RANDOM_ROWS - 1 do
     _PNS.Rows[i] := PNS.Rows[i];      // depended row values
   _PNS.RunningSum  := PNS.RunningSum; // Used to optimize summing of generators.
   _PNS.Index       := PNS.Index;     // Incremented each sample.
   _PNS.IndexMask   := PNS.IndexMask; // Index wrapped by ANDing with this mask.
   _PNS.rndMax      := PNS.rndMax;    // max. value for Random
   _PNS.IncVal      := PNS.IncVal;    // enable auto-increasing out-val (by WarmUp)
   _PNS.Min         := PNS.Min;       // min val dependend on rand-generation
   _PNS.Max         := PNS.Max;       // max val dependend on rand-generation
   _PNS.Avg         := PNS.Avg;       // substract for average zero
   _PNS.SumMin      := PNS.SumMin;    // min val output integer (before level)
   _PNS.SumMax      := PNS.SumMax;    // max val output integer (before level)
   _PNS.Level       := PNS.Level;     // 0 to 100 (%) Default: 70
 end;

 end.


USERPC01

  • Posts: 26
Re: Noise Generator with BASS.dll for Lazarus
« Reply #9 on: 10 Aug '18 - 22:38 »
pinkmain.lfm

Code: [Select]
object NoiseForm: TNoiseForm
  Left = 180
  Height = 300
  Top = 221
  Width = 400
  Caption = 'NoiseForm'
  ClientHeight = 300
  ClientWidth = 400
  DesignTimePPI = 120
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  LCLVersion = '1.8.4.0'
  object TrackBar1: TTrackBar
    Left = 34
    Height = 31
    Top = 78
    Width = 125
    Frequency = 10
    Max = 100
    OnChange = TrackBar1Change
    Position = 70
    TabOrder = 0
  end
  object BitBtn1: TBitBtn
    Left = 176
    Height = 38
    Top = 168
    Width = 94
    Caption = 'Exit'
    OnClick = BitBtn1Click
    TabOrder = 1
  end
  object BitBtn2: TBitBtn
    Left = 40
    Height = 38
    Top = 168
    Width = 94
    Caption = 'Start '
    OnClick = BitBtn2Click
    TabOrder = 2
  end
  object Label1: TLabel
    Left = 176
    Height = 17
    Top = 88
    Width = 20
    Caption = ' 70'
    ParentColor = False
  end
end


USERPC01

  • Posts: 26
Re: Noise Generator with BASS.dll for Lazarus
« Reply #10 on: 10 Aug '18 - 22:40 »
I add files  into attach

USERPC01

  • Posts: 26
Re: Noise Generator with BASS.dll for Lazarus
« Reply #11 on: 10 Aug '18 - 22:43 »
files fot the first program