TBass - bass.dll non-vcl component

Bass 2.4 header extension with predefined variables.
Libraries available at:
http://un4seen.com

unit Bass_obj;
{
  Bass 2.4 Object oriented helper

Allows to easily use of BASS audio library functions
  Library available in Un4seen Developments Ltd. website
  Tested in Delphi7

Coded by Armagan Corlu aka Psy_chip  
  root@psychip.net
  2009
}

interface
uses
windows,
SysUtils,
Forms,
Classes,
dynamic_bass;  // <- available in bass delphi samples directory

Type TWaveData = array [ 0..2048] of DWORD;
Type TFFTData  = array [0..512] of Single;

type TStreamdata = packed record
buffer:integer;
error:integer;
bitrate:integer;
infotag:string;
metadata:String;
end;

type Tsample = packed record
filename:string;
tag:string;
ch:HSAMPLE;
end;

type
TBass = class(Tobject)
currentsource:string;
volume:integer;       // read only - use setvolume
Length:Int64;
position:Int64;
streamdata:Tstreamdata;
fftdata:TFFTData;
time:string;
paused:boolean;
muted:boolean;
playing:Boolean;
streaming:boolean;
procedure importsamples(samples:Tstringlist);
procedure loadsample(filename:String);
procedure playsample(tag:string);
function lasterror:string;
procedure pause;
procedure stop;
procedure mute;
procedure play(filename:string);
procedure play_dsp(filename:string);
procedure stream(url:string);
function active:dword;
function getfft:TFFTData;
procedure setvolume(newvolume:integer);
procedure setposition(Pos:Int64);
function getposition:int64;
function readbitrate:Integer;
procedure init_plugins(dir:string);
procedure MetaSync(handle: HSYNC; channel, data, user: DWORD); stdcall;
procedure ReadMetaData();
procedure free_samples;
published
constructor create(const libpath:string='bass.dll';plugindir:string='\';rate:integer=44100);virtual;
destructor free;virtual;
private
realvolume:single;
samples:array[0..512] of Tsample;
samplecount:integer;
channel:dword;
dsp: HDSP;
prevbitrate:QWORD;
end;

implementation

var
echbuf: array[0..1200 - 1,0..1] of Single;
echpos: Integer;

const
  eaxlevelvar=750;

procedure processdsp(handle: HDSP; channel: DWORD; buffer: Pointer; length: DWORD; user: DWORD); stdcall;
var
  a: DWORD;
  d: PSingle;
  l, r: Single;
begin
	d := buffer;
  a := 0;

while (a < (length div 4)) do
  begin
    l := d^ + (echbuf[echpos,1] / 2);
    Inc(d);
    r := d^ + (echbuf[echpos,0] / 2);
    Dec(d);

{ Basic "bathroom" reverb }
    d^ := l;
    echbuf[echpos,0] := l;
    Inc(d);
    d^ := r;
    echbuf[echpos,1] := r;

{ Echo
    echbuf[echpos,0] := d^;
    d^ := 1;
    Inc(d);
    echbuf[echpos,1] := d^;
    d^ := r;}

echpos := echpos + 1;
		if (echpos >= eaxlevelvar) then echpos := 0;

Inc(d);
    a := a + 2;
  end;
end;

procedure Tbass.play_dsp(filename:string);
begin
self.playing:=True;
self.streaming:=False;
self.paused:=False;
if BASS_ChannelIsActive(self.channel) <> 0 then begin
BASS_ChannelStop(self.channel);
BASS_StreamFree(self.channel);
end;
FillChar(echbuf, SizeOf(echbuf), 0);
echpos := 0;
self.channel:=BASS_StreamCreateFile(FALSE, PChar(filename), 0, 0, 0 {$IFDEF UNICODE} or BASS_UNICODE {$ENDIF} or BASS_STREAM_AUTOFREE or BASS_STREAM_STATUS or BASS_MUSIC_RAMP);
Self.dsp := BASS_ChannelSetDSP(Self.channel, @processdsp, 0, 1);
BASS_ChannelSetAttribute(self.channel, BASS_ATTRIB_VOL, Self.realvolume);
self.Length:=round(BASS_ChannelBytes2Seconds(self.channel, BASS_ChannelGetLength(Self.channel, BASS_POS_BYTE)));
self.currentsource:=filename;
BASS_ChannelPlay(self.channel, False);
repeat
Sleep(250);
until BASS_ChannelIsActive(self.channel)=0;
self.playing:=false;
//BASS_ChannelRemoveDSP(self.channel, echdsp);
end;

procedure Tbass.free_samples;
var
  i:integer;
begin
for i:=0 to samplecount do begin
BASS_SampleFree(samples[i].ch);
end;

ZeroMemory(@samples,SizeOf(samples));
end;

procedure Tbass.loadsample(filename:String);
begin
Self.samples[samplecount].ch:=BASS_SampleLoad(false, PChar(filename), 0, 0, 3, BASS_SAMPLE_OVER_POS {$IFDEF UNICODE} or BASS_UNICODE {$ENDIF});
self.samples[samplecount].tag:=ExtractFileName(filename);
self.samples[samplecount].filename:=filename;
inc(samplecount);
end;

procedure Tbass.playsample(tag:string);
var
ch: HCHANNEL;
i:integer;
found:boolean;
begin
found:=False;
for i:=0 to High(self.samples) do begin
if self.samples[i].tag=tag then begin
ch:=BASS_SampleGetChannel(self.samples[i].ch, false);
if BASS_ChannelIsActive(ch)=1 then exit;
BASS_ChannelSetAttribute(ch, BASS_ATTRIB_VOL, Self.realvolume);
BASS_ChannelPlay(ch, false);
found:=true;
end;
if found then break;
end;
end;

function Tbass.lasterror:string;
var
code:Integer;
begin
code:=BASS_ErrorGetCode;
Result:=IntToStr(code);

end;

function Tbass.readbitrate;
var
rate:QWORD;
begin
rate:=BASS_StreamGetFilePosition(self.channel, BASS_FILEPOS_CURRENT) div 100;
if rate=prevbitrate then begin
result:=self.streamdata.bitrate;
exit;
end;
self.streamdata.bitrate:=rate-self.prevbitrate;
result:=self.streamdata.bitrate;
self.prevbitrate:=rate;
end;

procedure Tbass.ReadMetaData();
var
  meta: PAnsiChar;
  p: Integer;
begin
  meta := BASS_ChannelGetTags(self.channel, BASS_TAG_META);
  if (meta <> nil) then
  begin
    p := Pos('StreamTitle=', String(AnsiString(meta)));
    if (p = 0) then
      Exit;
    p := p + 13;
    self.streamdata.metadata:=AnsiString(Copy(meta, p, Pos(';', String(meta)) - p - 1));
  end;
end;

procedure TBass.MetaSync(handle: HSYNC; channel, data, user: DWORD); stdcall;
begin
self.ReadMetaData();
end;

procedure Tbass.stream(url:string);
var
  icy: PAnsiChar;
  Len, Progress: DWORD;
begin
Progress:=0;
Self.streamdata.buffer:=0;
self.streamdata.error:=0;
Self.streamdata.infotag:='';
self.streamdata.metadata:='';
if self.active <> 0 then BASS_StreamFree(self.channel);
Self.streaming:=True;
self.paused:=False;
self.currentsource:=url;
self.channel:=BASS_StreamCreateURL(PChar(url), 0, BASS_STREAM_STATUS, nil, nil);
self.streamdata.error:=Self.channel;
 if self.channel <> 0 then begin
    repeat
      len := BASS_StreamGetFilePosition(self.channel, BASS_FILEPOS_END);
      if (len = DW_Error) then break;
      progress := (BASS_StreamGetFilePosition(self.channel, BASS_FILEPOS_DOWNLOAD) - BASS_StreamGetFilePosition(self.channel, BASS_FILEPOS_CURRENT)) * 100 div len;
     self.streamdata.buffer:=progress;
    until progress > 75;
    icy := BASS_ChannelGetTags(self.channel, BASS_TAG_ICY);
    if (icy = nil) then icy := BASS_ChannelGetTags(self.channel, BASS_TAG_HTTP);
    if (icy <> nil) then self.streamdata.infotag:=icy;
   self.ReadMetaData();
   BASS_ChannelPlay(self.channel, FALSE);
 end;
end;

procedure Tbass.mute;
begin
if self.muted then self.setvolume(self.volume) else BASS_ChannelSetAttribute(self.channel, BASS_ATTRIB_VOL, 0);
self.muted:=not self.muted;
end;

procedure Tbass.setposition(Pos:Int64);
begin
BASS_ChannelSetPosition(self.channel, BASS_ChannelSeconds2Bytes(self.channel, pos), BASS_POS_BYTE);
end;

function Tbass.getposition:int64;
begin
self.position:=round(BASS_ChannelBytes2Seconds(self.channel, BASS_ChannelGetPosition(Self.channel, BASS_POS_BYTE)));
result:=self.position;
end;

procedure Tbass.init_plugins(dir:string);
var
  fd: TWin32FindData;
  fh: THandle;
  plug: HPLUGIN;
begin
  fh := FindFirstFile(PChar(dir + '*.dll'), fd);
  if (fh <> INVALID_HANDLE_VALUE) then
  try
    repeat
      plug:=BASS_PluginLoad(PChar(dir+fd.cFileName), 0 {$IFDEF UNICODE} or BASS_UNICODE {$ENDIF});
      if Plug <> 0 then
      begin

end;
    until FindNextFile(fh, fd) = false;
  finally
    Windows.FindClose(fh);
  end;

end;

procedure Tbass.stop();
begin
if self.active <> 0 then begin
BASS_ChannelStop(self.channel);
BASS_StreamFree(self.channel);
end;
end;

function Tbass.active:dword;
begin
result:=BASS_ChannelIsActive(self.channel);
end;

procedure Tbass.pause();
begin
if self.paused then BASS_ChannelPlay(self.channel,false) else BASS_channelpause(self.channel);
self.paused:=not self.paused;
end;

procedure Tbass.importsamples(samples:Tstringlist);
var
  i:integer;
begin
for i:=0 to samples.count-1 do begin
loadsample(samples.strings[i]);
end;
end;

procedure Tbass.play(filename:string);
begin
self.streaming:=False;
self.paused:=False;
if BASS_ChannelIsActive(self.channel) <> 0 then begin
BASS_ChannelStop(self.channel);
BASS_StreamFree(self.channel);
end;
self.channel:=BASS_StreamCreateFile(FALSE, PChar(filename), 0, 0, 0 {$IFDEF UNICODE} or BASS_UNICODE {$ENDIF} or BASS_STREAM_AUTOFREE or BASS_STREAM_STATUS or BASS_MUSIC_RAMP);
BASS_ChannelSetAttribute(self.channel, BASS_ATTRIB_VOL, Self.realvolume);
self.Length:=round(BASS_ChannelBytes2Seconds(self.channel, BASS_ChannelGetLength(Self.channel, BASS_POS_BYTE)));

BASS_ChannelPlay(self.channel, False);
self.currentsource:=filename;
end;

procedure Tbass.setvolume(newvolume:integer);
var
vol:single;
i:integer;
begin
vol:=newvolume;
vol:=vol / 100;
BASS_ChannelSetAttribute(self.channel, BASS_ATTRIB_VOL, vol);

for i:=0 to High(self.samples) do begin
BASS_ChannelSetAttribute(self.samples[i].ch, BASS_ATTRIB_VOL, vol);
end;
self.realvolume:=vol;
self.volume:=newvolume;
end;

constructor Tbass.create(const libpath:string='bass.dll';
plugindir:string='\';
rate:integer=44100);
begin
//inherited Create(true);
//FreeOnTerminate := True;
Load_BASSDLL(libpath);
BASS_SetConfig(BASS_CONFIG_FLOATDSP, 1);
BASS_Init(-1, rate, 0, application.Handle, nil);  //96000
BASS_SetConfig(BASS_CONFIG_NET_PLAYLIST, 1);
BASS_SetConfig(BASS_CONFIG_NET_PREBUF, 0);
self.setvolume(100);
end;

destructor Tbass.free;
begin
self.free_samples;
BASS_ChannelStop(self.channel);
BASS_FREE;
Unload_BASSDLL;
//inherited destroy;
end;

function Tbass.getfft():TFFTData;
begin
 BASS_ChannelGetData(self.channel,@self.fftdata, BASS_DATA_FFT1024);
 result:=self.fftdata;
end;

end.

Size:	9 KB
Date:	11/09/2017
Crc32:	486159685
Modified on:	3 Year, 7 Month ago

TBass - bass.dll non-vcl component

September 11, 2017