Commentaires sur une source : SCAN THREAD : BASS

softime Messages postés 5 Date d'inscription vendredi 16 mars 2007 Statut Membre Dernière intervention 13 novembre 2007
18 juin 2009 à 20:30

Je te remercie Nico, je vais essayer de mettre en appli ce que tu me dis, c'est vrai que moi je n'ai pas utilisé la fonction de chargement du fichier *.cda mais celle qui crée un stream à partir d'un N° de piste et cela peut peut etre tout changer :o). Merci, Je te tiens au courant A+.

Nicolas___ Messages postés 992 Date d'inscription jeudi 2 novembre 2000 Statut Membre Dernière intervention 24 avril 2013 1
18 juin 2009 à 18:25

non testé mais ca devrait fonctionner :

dans le onCreate(de la fiche) , tu charges un Plugin avec BASS (tu charges le plugin basscd.dll)
-> BASS_PluginLoad(PChar(PATH+'BassCD.dll'),0); (il sera libérer quand appel à BASS_Free())
-> PATH := ExtractFilePath(Application.ExeName); tu dois donc placer ta basscd.dll dans le répertoire du projet

à partir de la , tu seras capable de lire les *.cda , donc tu peux charger ton *.cda très facilement (comme ci c'était un fichier normal )

Donc une ligne à rajouter normalement (marche aussi avec bassmidi(testé) et basswma(testé aussi))

Nico

softime Messages postés 5 Date d'inscription vendredi 16 mars 2007 Statut Membre Dernière intervention 13 novembre 2007
18 juin 2009 à 17:34

Bonjour,
D'abord félicitation pour ta source !
Je voulais te demander si tu as déjà utiliser la DLL BASSCD et si oui as-tu réussi à lancer un play d'une piste tout en décodant le channel de cette même piste ? Ca fonctionne trés bien avec un fichier wav ou mp3 mais je n'ai pas réussi à le faire avec une piste de CDAudio. Le but étant de lancer la lecture, puis de décoder et d'afficher le spectre en tache de fond sans que la lecture soit interrompue bien sûr.
Merci

naninagra Messages postés 2 Date d'inscription vendredi 12 juin 2009 Statut Membre Dernière intervention 12 juin 2009
12 juin 2009 à 16:45

salut

cs_MAURICIO Messages postés 2106 Date d'inscription mardi 10 décembre 2002 Statut Modérateur Dernière intervention 15 décembre 2014 5
12 juin 2009 à 13:21

Salut Nicolas__,

j' avoue tout de suite que je n' ai pas encoré téléchargé la source et je ne prononcerai donc pas sur celle-ci.

il me semble que l' erreur FFF40000 vient du fait que tu essayes d' accéder à un objet qui n' existe pas ou qui n' existe plus.

Ça arrive normalement lorsque tu fermes ton appli, essayes de mettre des :
"if Application.Termined" dans ton appli
"if csDestroying in ComponentState" pour les compos.

A+

Nicolas___ Messages postés 992 Date d'inscription jeudi 2 novembre 2000 Statut Membre Dernière intervention 24 avril 2013 1
9 juin 2009 à 15:07

Salut foxi , (ou les autres), je me chope souvent cette erreur :
---------------------------
Notification d'une exception du débogueur
---------------------------
Le projet ScanThread.exe a provoqué une classe d'exception EAccessViolation avec le message 'Violation d'accès à l'adresse FFF40000. Lecture de l'adresse FFF40000'. Processus stoppé. Utilisez Pas-à-pas ou Exécuter pour continuer.
---------------------------
OK Aide
---------------------------

Quand je veux changer de musique (donc quand je libère mon TScanThread) , est ce du au fait que le thread est en train d'utiliser le paintbox (ou autre) ...
Synchronize n'est pas censé éviter ce genre de chose ?

Quelques questions concernant ton code :

pourquoi avoir déclarer TSpectrumTheme en packed array ?
Y'a t-il un avantage quelconque ? j'ai lu l'aide mais j'aimerais ton avis ...

j'ai lu sur delphibasics la significations de dynamic et je ne suis toujours pas très convaincu de son utilisation ici
(surtout que si il fallait en utiliser 1, mon choix se serait porter sur virtual mais le débat vitesse mémoire ...)

PS : il n'y a bien sûr aucunes remarques désobligeantes dans mes questions, juste une envie de savoir ...

PS 2 : Aurais tu une idée pour permettre le dessin en temps réel du spectre (je veux dire par la ne pas attendre que la fonction scanpeak scanne tout, au fur et a mesure qu'elle scanne , ca dessine dans le bufferBitmap)

Nico

Nicolas___ Messages postés 992 Date d'inscription jeudi 2 novembre 2000 Statut Membre Dernière intervention 24 avril 2013 1
8 juin 2009 à 22:45

pour l'auteur c'était pour rire (vu que cette source est déjà tirée d'une source ... )

ok pr ta signature , je changerais ca ...

Merci

Nicolas___ Messages postés 992 Date d'inscription jeudi 2 novembre 2000 Statut Membre Dernière intervention 24 avril 2013 1
8 juin 2009 à 19:22

*** j'ai complètement oublié de libérer les ressources
(j'avais fait cette petite unité pour un programme a part, je voulais tout simplement la partagé , pas fait gaf, c'est pas une excuse tout de même )

Il me reste plus qu'a regardé tout ca ,

Première question : quelle interêt de mettre
procedure ScanPeaks; dynamic; // Récuperation des Levels
procedure DrawSpectrum; dynamic; // Dessin du spectre

en dynamic ???

Bien merci , ça fait plaisir d'avoir un pro qui regarde ça source et qui la corrige
(je serais tenté de dire enfin un commentaire intéressante :) (plus que la moyenne) )

PS : change l'auteur ;) lol (ou pas)

Je fais la MAJ

f0xi Messages postés 4205 Date d'inscription samedi 16 octobre 2004 Statut Modérateur Dernière intervention 12 mars 2022 35
8 juin 2009 à 18:43

Petites corrections :

uMain.pas
- correction des references interne a Form1 -> Self
- Liberation des ressources en quittant l'application
- ajout du support des themes de couleurs

unit uMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,bass,uScanThread, ExtCtrls, StdCtrls;

type
TForm1 = class(TForm)
Label1: TLabel;
btLoadSong1: TButton;
Label2: TLabel;
btLoadSong2: TButton;
ColorDialog1: TColorDialog;
panColBack: TPanel;
panColPeak: TPanel;
panColBorder: TPanel;
panColLoopS: TPanel;
panColLoopE: TPanel;
panColPos: TPanel;
panColText: TPanel;
OpenDialog1: TOpenDialog;
ComboBox1: TComboBox;
procedure FormCreate(Sender: TObject);
procedure btLoadSong2Click(Sender: TObject);
procedure btLoadSong1Click(Sender: TObject);
procedure PanColorClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
private
fBassInit : boolean;
chan1, chan2, chan1Decode, chan2Decode : HSTREAM;
ScanThreadChan1, ScanThreadChan2 : TScanThread;
public
{ Déclarations publiques }
end;

var
Form1: TForm1;
PATH : String;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
PATH := ExtractFilePath(Application.ExeName);

fBassInit := BASS_Init(-1,44100,0,Handle,nil);
assert(fBassInit, 'Bass initialization failure.');

// on charge le son 2
panColBack.Tag := 0;
panColPeak.Tag := 1;
panColBorder.Tag := 2;
panColLoopS.Tag := 3;
panColLoopE.Tag := 4;
panColPos.Tag := 5;
panColText.Tag := 6;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if chan2 <> 0 then
begin
BASS_StreamFree(chan2);
BASS_StreamFree(chan2Decode);
ScanThreadChan2.Free;
end;

if chan1 <> 0 then begin
BASS_StreamFree(chan1);
BASS_StreamFree(chan1Decode);
ScanThreadChan1.Free;
end;

if fBassInit then
BASS_Free;
end;

procedure TForm1.btLoadSong2Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
// libère les ressources
if chan2 <> 0 then
begin
BASS_StreamFree(chan2);
BASS_StreamFree(chan2Decode);
ScanThreadChan2.Free;
end;

chan2 := BASS_StreamCreateFile(false,PChar(OpenDialog1.FileName),0,0,BASS_SAMPLE_LOOP);
BASS_ChannelPlay(chan2,TRUE);

chan2Decode := BASS_StreamCreateFile(false,PChar(OpenDialog1.FileName),0,0,BASS_STREAM_DECODE);
ScanThreadChan2 := TScanThread.Create(Self, chan2Decode, chan2, 16, 328, 593, 241);
end;
end;

procedure TForm1.btLoadSong1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
// libère les ressources
if chan1 <> 0 then begin
BASS_StreamFree(chan1);
BASS_StreamFree(chan1Decode);
ScanThreadChan1.Free;
end;

chan1 := BASS_StreamCreateFile(false,PChar(OpenDialog1.FileName),0,0,BASS_SAMPLE_LOOP);
BASS_ChannelPlay(chan1,TRUE);
// on créé une channel "décodé"
chan1Decode := BASS_StreamCreateFile(false,PChar(OpenDialog1.FileName),0,0,BASS_STREAM_DECODE);
ScanThreadChan1 := TScanThread.Create(Self, chan1Decode, chan1, 16, 72, 400, 185);
end;
end;

procedure TForm1.PanColorClick(Sender: TObject);
var Col : integer;
begin
if ColorDialog1.Execute then
begin
(Sender as TPanel).Color := ColorDialog1.Color;
Col := (Sender as TPanel).Color;
with ScanThreadChan1.SpectrumColor do
begin
case (Sender as TPanel).Tag of
0: scBack := Col;
1: scPeak := Col;
2: scBorder := Col;
3: scLoopStart := Col;
4: scLoopEnd := Col;
5: scPosition := Col;
6: scText := Col;
end;
end;
end;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
if ComboBox1.ItemIndex <> -1 then
begin
case ComboBox1.ItemIndex of
0 : ScanThreadChan1.SpectrumColor.LoadSpectrumTheme(SpectrumThemeDefault);
1 : ScanThreadChan1.SpectrumColor.LoadSpectrumTheme(SpectrumThemeSilver);
2 : ScanThreadChan1.SpectrumColor.LoadSpectrumTheme(SpectrumThemeGirly);
3 : ScanThreadChan1.SpectrumColor.LoadSpectrumTheme(SpectrumThemeArmy);
4 : ScanThreadChan1.SpectrumColor.LoadSpectrumTheme(SpectrumThemeLCD);
end;
end;
end;

end.

__________________________________________________

uScanThread.pas
- Transformation du type TSpectrumColor Record -> TPersistent
- ajout du type TSpectrumTheme
- ajout du support de TSpectrumTheme pour TSpectrumColor
- creation de 4 themes supplementaire
- correction des déclaration dans TScanThread
- correction d'indentation du code
- ajout de commentaires
- renomé Draw_Spectrum -> DrawSpectrum
- ajout du support TSpectrumColor dans TScanThread
- correction de la declaration du constructeur de TScanThread
- reordonnage des creations et definitions dans le constructeur de TScanThread
- reordonnage des destructions dans le destructeur de TScanThread
- correction de performances dans la methode Paint de fPaintBox
- correction de performances dans la methode DrawSpectrum

unit uScanThread ;

interface

uses
Windows, SysUtils,
Dialogs, Forms, Controls, StdCtrls, Classes, ExtCtrls,Graphics, bass;

type
TSpectrumTheme = packed array[0..6] of integer;

const // LoopStart, LoopEnd, Position, Background, Border, Peak, Text
SpectrumThemeDefault : TSpectrumTheme = (clBlue, clRed, clWhite, clBlack, clGray, clLime, clWhite);
SpectrumThemeSilver : TSpectrumTheme = (clBlue, clRed, clBlack, clGray, clBlack, clWhite, clBlack);
SpectrumThemeGirly : TSpectrumTheme = (clBlue, clRed, clBlack, $c080ff, clGray, $8000ff, clWhite);
SpectrumThemeArmy : TSpectrumTheme = (clBlue, clRed, clBlack, $7a9a90, clBlack, $2a4a40, clBlack);
SpectrumThemeLCD : TSpectrumTheme = ($804c46, $4c4680, $212e2c, $6a9583, $314440, $314440, $314440);

type
TSpectrumColor = class(TPersistent)
private
fColors : TSpectrumTheme;
fOnChange : TNotifyEvent;
procedure SetColor(const index: integer; const value: integer);
function GetColor(const index: integer): integer;
protected
procedure Change; virtual;
procedure AssignTo(Dest: TPersistent); override;
property OnChange : TNotifyEvent read fOnChange write fOnChange;
published
property scLoopStart : Integer index 0 read GetColor write SetColor default clBlue;
property scLoopEnd : Integer index 1 read GetColor write SetColor default clRed;
property scPosition : Integer index 2 read GetColor write SetColor default clWhite;
property scBack : Integer index 3 read GetColor write SetColor default clBlack;
property scBorder : Integer index 4 read GetColor write SetColor default clGray;
property scPeak : Integer index 5 read GetColor write SetColor default clLime;
property scText : Integer index 6 read GetColor write SetColor default clWhite;
public
constructor Create;
procedure LoadSpectrumTheme(const ColorTheme: TSpectrumTheme);
procedure LoadFromResource(Instance: THandle; const ResName: string);
procedure LoadFromResourceID(Instance: THandle; ResID: integer);
procedure LoadFromStream(Stream: TStream);
procedure SaveToStream(Stream: TStream);
procedure LoadFromFile(const FileName: string);
procedure SaveToFile(const FileName: string);
end;

type
TScanThread = class(TThread)
private
fPaintBox : TPaintBox;
fdecoder : DWORD; // le canal "decode" -> GetLevel
fChannel : DWORD; // le canal en cours -> Position
fKillScan : boolean; // Switch de démarrage et arret du scan
fBPP : DWORD; // Relation Temps/Longueur
fWaveBufL : array of smallint; // Level sonore Gauche
fWaveBufR : array of smallint; // Level sonore Droit
fWidth : integer; // Taille en X
fHeight : integer; // Taille en Y
fBufferBitmap : TBitmap; // le bitmap ou on va dessiner desus
fNbLoopSync : DWORD; // indice pr la procedure LoopSyncProc
fSpectrumColor : TSpectrumColor; // Couleur de la visualisation du spectre
fLoopStart : DWORD; // Debut de la boucle
fLoopEnd : DWORD; // Fin de la boucle
fPosition : DWORD; // Position en cours
fNeedRedraw : boolean; // Switch pour redessiner le Spectre

procedure SetSpectrumColor(Value: TSpectrumColor);

protected
procedure ScanPeaks; dynamic; // Récuperation des Levels
procedure DrawSpectrum; dynamic; // Dessin du spectre
procedure ThreadProcedure; // Procedure principale du Thread
procedure Execute; override; // Execution du Thread

procedure DoSpectrumColorChange(Sender: TObject);

// Les <> méthodes relatives au TPaintBox : Paint , onMouseDown , onMouseMove
procedure PaintBoxPaint(Sender: TObject);
procedure PaintBoxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure PaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

published
property BPP : DWORD read fBPP;
property LoopStart : DWORD read fLoopStart write fLoopStart default 0;
property LoopEnd : DWORD read fLoopEnd write fLoopEnd default 0;
property Position : DWORD read fPosition write fPosition default 0;
property SpectrumColor : TSpectrumColor read fSpectrumColor write SetSpectrumColor;

public
procedure ReDraw;
procedure ReScan;

constructor Create(AOwner: TWinControl; const ADecoder, AChannel,
ALeft, ATop, AWidth, AHeight : DWORD);
destructor Destroy;override;
end;

procedure LoopSyncProc(handle: HSYNC; channel, data: DWORD; user: Pointer); stdcall;

var
NbLoopSync : DWORD = 0;
GlobalLoopStart : array[0..1000] of DWORD;
fLoopSync : array[0..1000] of HSYNC;

implementation

procedure LoopSyncProc(handle: HSYNC; channel, data: DWORD; user: Pointer); stdcall;
var
i : integer;
begin
for i:= 0 to NbLoopSync do
if handle = fLoopSync[i] then
if not BASS_ChannelSetPosition(channel,GlobalLoopStart[i],BASS_POS_BYTE) then
BASS_ChannelSetPosition(channel,0,BASS_POS_BYTE);
end;

//------------------------------------------------------------------------------

{ TScanThread }

constructor TScanThread.Create(AOwner: TWinControl; const ADecoder, AChannel,
ALeft, ATop, AWidth, AHeight : DWORD);
begin
inherited Create(false);

if NbLoopSync >= 1000 then
NbLoopSync := 0;

fNeedRedraw := True;
fNbLoopSync := NbLoopSync;
fLoopEnd := 0;
fLoopStart := 0;
fPosition := 0;
fKillScan := false;
GlobalLoopStart[fNbLoopSync] := fLoopStart;

// Create internal objects
fSpectrumColor := TSpectrumColor.Create;
fSpectrumColor.OnChange := DoSpectrumColorChange;

fBufferBitmap := TBitmap.Create;
fBufferBitmap.PixelFormat := pf32bit;

Assert(AOwner <> nil, 'Error TScanThread.Create : AParent must not be null.');
fPaintBox := TPaintBox.Create(AOwner);
// fPaintBox settings
fPaintBox.Parent := AOwner;
fPaintBox.Parent.DoubleBuffered := True;
fPaintBox.SetBounds(ALeft, ATop, AWidth, AHeight);
fPaintBox.OnPaint := PaintBoxPaint;
fPaintBox.OnMouseDown := PaintBoxMouseDown;
fPaintBox.OnMouseMove := PaintBoxMouseMove;

fWidth := fPaintBox.Canvas.ClipRect.Right;
fHeight := fPaintBox.Canvas.ClipRect.Bottom;

fDecoder := ADecoder;

fBPP := BASS_ChannelGetLength(ADecoder,BASS_POS_BYTE) div fWidth;
if (fBPP < BASS_ChannelSeconds2Bytes(ADecoder,0.02)) then // minimum 20ms per pixel (BASS_ChannelGetLevel scans 20ms)
fBPP := BASS_ChannelSeconds2Bytes(ADecoder,0.02);

SetLength(fWaveBufL, fWidth);
SetLength(fWaveBufR, fWidth);

Priority := tpNormal;
FreeOnTerminate := false;

fChannel := AChannel;
fLoopSync[fNbLoopSync]:= BASS_ChannelSetSync(fChannel,BASS_SYNC_POS or BASS_SYNC_MIXTIME,fLoopEnd,LoopSyncProc,nil);
NbLoopSync := NbLoopSync+1;
end;

destructor TScanThread.Destroy;
begin
fPaintBox.Free;
fBufferBitmap.Free;
fSpectrumColor.Free;
inherited Destroy;
end;

procedure TScanThread.SetSpectrumColor(Value: TSpectrumColor);
begin
Value.AssignTo(fSpectrumColor);
end;

procedure TScanThread.DoSpectrumColorChange(Sender: TObject);
begin
fNeedRedraw := true;
DrawSpectrum;
end;

procedure TScanThread.ReDraw;
begin
fNeedRedraw := true;
end;

procedure TScanThread.ReScan;
begin
fKillScan := false;
end;

procedure TScanThread.PaintBoxPaint(Sender: TObject);
var LSD, LED, PSD : integer;
begin
LSD := fLoopStart div fBPP;
LED := fLoopEnd div fBPP;
PSD := fPosition div fBPP;

with fPaintBox.Canvas do
begin
Draw(0, 0, fBufferBitmap);

Pen.Color := fSpectrumColor.scLoopStart;
MoveTo(LSD, 0);
LineTo(LSD, fHeight);

Pen.Color := fSpectrumColor.scLoopEnd;
MoveTo(LED, 0);
LineTo(LED, fHeight);

Pen.Color := fSpectrumColor.scPosition;
MoveTo(PSD, 0);
LineTo(PSD, fHeight);

Font.Color := fSpectrumColor.scText;
Brush.Color:= fSpectrumColor.scBack;
TextOut(LSD+7, 12, IntToStr(Round(BASS_ChannelBytes2Seconds(fDecoder, fLoopStart))));
TextOut(LED+7, 12, IntToStr(Round(BASS_ChannelBytes2Seconds(fDecoder, fLoopEnd))));
TextOut(PSD+7, 12, IntToStr(Round(BASS_ChannelBytes2Seconds(fDecoder, fPosition))));
end;
end;

procedure TScanThread.PaintBoxMouseDown(Sender: TObject;Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if ssLeft in shift then
begin
fLoopStart := DWORD(X)*fBPP;
GlobalLoopStart[fNbLoopSync] := fLoopStart;
end
else if ssRight in shift then begin
fLoopEnd :=DWORD(X)*fBPP;
BASS_ChannelRemoveSync(fChannel,fLoopSync[fNbLoopSync]); // remove old sync
fLoopSync[fNbLoopSync]:= BASS_ChannelSetSync(fChannel,BASS_SYNC_POS or BASS_SYNC_MIXTIME,fLoopEnd,LoopSyncProc,nil);
// set new sync
end else if ssMiddle in shift then
BASS_ChannelSetPosition(fChannel,DWORD(X)*fBPP,BASS_POS_BYTE);
end;

procedure TScanThread.PaintBoxMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
if ssLeft in shift then begin
fLoopStart := DWORD(X)*fBPP;
GlobalLoopStart[fNbLoopSync]:=fLoopStart;
end
else
if ssRight in shift then
begin
fLoopEnd := DWORD(X)*fBPP;
BASS_ChannelRemoveSync(fChannel,fLoopSync[fNbLoopSync]); // remove old sync
fLoopSync[fNbLoopSync] := BASS_ChannelSetSync(fChannel,BASS_SYNC_POS or BASS_SYNC_MIXTIME,fLoopEnd,LoopSyncProc,nil);
// set new sync
end
else
if ssMiddle in shift then
BASS_ChannelSetPosition(fChannel, DWORD(X)*fBPP,BASS_POS_BYTE);
end;

procedure TScanThread.Execute;
begin
ScanPeaks;
repeat
synchronize(ThreadProcedure);
sleep(20);
until Terminated;
end;

procedure TScanThread.ThreadProcedure;
begin
//ScanPeaks ; //-> normalement inutile , car déjà scanné
if fNeedRedraw then
DrawSpectrum;
fPosition := BASS_ChannelGetPosition(fChannel,BASS_POS_BYTE);
fPaintBox.Invalidate;
end;

procedure TScanThread.DrawSpectrum;
var
i, ht : integer;
rt : single;
begin
rt := (1/32768);

fBufferBitmap.Width := fPaintBox.Width;
fBufferBitmap.Height := fPaintBox.Height;

with fBufferBitmap.Canvas do
begin
// clear background
Brush.Color := fSpectrumColor.scBack;
FillRect(ClipRect);

Pen.Color := fSpectrumColor.scBorder;
Rectangle(1, 0, fWidth, ClipRect.Bottom);

//draw peaks
ht := fHeight shr 1;
Pen.Color := fSpectrumColor.scPeak;
for i := 0 to length(fWaveBufL)-1 do
begin
MoveTo(i, ht-trunc((fWaveBufL[i]*rt)*ht));
LineTo(i, ht+trunc((fWaveBufR[i]*rt)*ht)+1);
end;
Pen.Color := fSpectrumColor.scBack;
MoveTo(0, ht);
LineTo(fWidth, ht);
end;
fNeedRedraw := false;
end;

procedure TScanThread.ScanPeaks;
var
cpos, level : DWord;
peak : array[0..1] of DWORD;
position : DWORD;
counter : integer;
begin
cpos := 0;
peak[0] := 0;
peak[1] := 0;
counter := 0;

while not fKillscan do
begin
level := BASS_ChannelGetLevel(fDecoder); // scan peaks

if peak[0] < LOWORD(level) then
peak[0] := LOWORD(level); // set left peak

if peak[1] < HIWORD(level) then
peak[1] := HIWORD(level); // set right peak

if BASS_ChannelIsActive(fDecoder) <> BASS_ACTIVE_PLAYING then
begin
position := cardinal(-1); // reached the end
end
else
position := BASS_ChannelGetPosition(fDecoder,BASS_POS_BYTE) div fBPP;

if position > cpos then
begin
inc(counter);
if counter <= length(fWaveBufL)-1 then
begin
fWaveBufL[counter] := peak[0];
fWaveBufR[counter] := peak[1];
end;

if position >= DWORD(fWidth) then
fKillscan := true;

cpos := position;
end;
peak[0] := 0;
peak[1] := 0;
end;
end;

//------------------------------------------------------------------------------

{ TSpectrumColor }

constructor TSpectrumColor.Create;
begin
inherited Create;
fColors := SpectrumThemeDefault;
end;

function TSpectrumColor.GetColor(const index: integer): integer;
begin
result := fColors[index];
end;

procedure TSpectrumColor.LoadFromFile(const FileName: string);
var Stream : TFileStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end;

procedure TSpectrumColor.LoadFromResource(Instance: THandle; const ResName: string);
var Stream : TResourceStream;
begin
Stream := TResourceStream.Create(Instance, ResName, RT_RCDATA);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end;

procedure TSpectrumColor.LoadFromResourceID(Instance: THandle; ResID: integer);
var Stream : TResourceStream;
begin
Stream := TResourceStream.CreateFromID(Instance, ResID, RT_RCDATA);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end;

procedure TSpectrumColor.LoadFromStream(Stream: TStream);
begin
assert(Stream <> nil, 'Error TSpectrumColor.LoadFromStream : '+#13#10+
'Stream must not be null.');
Stream.Read(fColors, SizeOf(fColors));
Change;
end;

procedure TSpectrumColor.SaveToFile(const FileName: string);
var Stream : TFileStream;
begin
Stream := TFileStream.Create(FileName, fmCreate);
try
SaveToStream(Stream);
finally
Stream.Free;
end;
end;

procedure TSpectrumColor.SaveToStream(Stream: TStream);
begin
assert(Stream <> nil, 'Error TSpectrumColor.SaveToStream : '+#13#10+
'Stream must not be null.');
Stream.Write(fColors, SizeOf(fColors));
end;

procedure TSpectrumColor.SetColor(const index, value: integer);
begin
if fColors[index] <> Value then
begin
fColors[index] := Value;
Change;
end;
end;

procedure TSpectrumColor.AssignTo(Dest: TPersistent);
begin
if Dest is TSpectrumColor then
TSpectrumColor(Dest).LoadSpectrumTheme(Self.fColors)
else
inherited AssignTo(Dest);
end;

procedure TSpectrumColor.Change;
begin
if Assigned(fOnChange) then
fOnChange(Self);
end;

procedure TSpectrumColor.LoadSpectrumTheme(
const ColorTheme: TSpectrumTheme);
begin
if not CompareMem(@fColors, @ColorTheme, SizeOf(TSpectrumTheme)) then
begin
fColors := ColorTheme;
Change;
end;
end;

end.

Nicolas___ Messages postés 992 Date d'inscription jeudi 2 novembre 2000 Statut Membre Dernière intervention 24 avril 2013 1
8 juin 2009 à 12:31

PS : Forcement si cette unité s'appele uScanThread, c'est que le fonctionnement derrière fonctionne avec ... un Thread :) ;)

Nico

SCAN THREAD : BASS

Votre réponse

Discussions similaires