1 //baAmpShell.pas
2 unit baAmpShell;
3
4 interface
5 uses
6 Bass,Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, ExtCtrls, ComCtrls, StdCtrls ,
8 acrString, acrInIFile, acrFiles, acrMessage ,InIFiles, Slider,
9 baSong;
10
11 function amAmpDir:string;
12 function amAmpPlaylistDir:string;
13
14 function amCreateAmpInI:TInIFile;
15
16 procedure amDistroyBass(Channel:DWORD);
17 function amDialogFilter : string;
18
19 function amGetPLSFiles(Ext:string):TStringlist;
20
21 function amLoadPlaylist(LBox:TListBox;ffName:string):TStrings;
22
23 procedure amInitBass;
24
25 implementation
26 //------------------------------------------------------------------------------
27 //------------------------------------------------------------------------------
28 //------------------------------------------------------------------------------
29 //------------------------------------------------------------------------------
30 //------------------------------------------------------------------------------
31 //------------------------------------------------------------------------------
32 //...öffnet die Playliste "ffName" und zeigt den Inhalt in der ListBox
33 // "LBox" an u. liefert die Pfade der Songs in einer Stringliste
34 // zurück
35 function amLoadPlaylist(LBox:TListBox;ffName:string):TStrings;
36 var i:integer; str :TStringlist;
37 begin
38 result := nil;
39 if ffName = '' then Exit;
40 str := TStringlist.Create;
41 LBox.Clear;
42 str.LoadFromFile(ffName);
43 for i := 0 to str.Count -1 do LBox.Items.Add(Purname(str[i]));
44 result := str;
45 end;
46 //------------------------------------------------------------------------------
47 //...liefert alle Playlistendatein in einer Stringliste zurück.
48 // mit "Ext" wird die Dateierweiterung übergeben z.B. ( *.tpl )
49 function amGetPLSFiles(Ext:string):TStringlist;
50 var sL :TStringlist; P :string;
51 begin
52 result := nil;
53 if Ext = '' then Exit;
54 sL := TStringlist.Create;
55 P := amAmpPlaylistDir;
56 ScanFiles(P + Ext,sL,false,false);
57 result := sL;
58 end;
59 //------------------------------------------------------------------------------
60 //...liefert die Extensionen ( Filter )für ein OpendiDialog
61 // *.mp3 usw.
62 function amDialogFilter : string;
63 begin
64 result := 'mp1/mp2/mp3/wav/ogg/mod/s3m/it/umx/mo3/mtm/xm|*.mp1;*.mp2;*.mp3;*.wav;*.ogg;*.mod;*.s3m;*.it;*.umx;*.mo3;*.mtm;*.xm|'
65 + 'Streams (mp1/mp2/mp3/wav/ogg)|*.mp1;*.mp2;*.mp3;*.wav;*.ogg|'
66 + 'Trackers (mod/s3m/it/umx/mo3/mtm/xm)|*.mod;*.s3m;*.it;*.umx;*.mo3;*.mtm;*.xm';
67 end;
68 //------------------------------------------------------------------------------
69 //...liefert die CPU - Auslastung String zurück.
70 function amCPULastAsStr:string;
71 begin
72 result := FloatToStrF(BASS_GetCPU, ffFixed, 4, 2)+ '% CPU';
73 end;
74 //------------------------------------------------------------------------------
75 //...liefert den Path für den Playlistenordner zurück,
76 // sollte dieser noch nicht existieren so wird ein Ordner mit
77 // dem Namen " Playlisten" angelegt u. zurückgeliefert.
78 function amAmpPlaylistDir:string;
79 var Path, nfo :string;
80 begin
81 Path := ExtractFilePath(Application.ExeName);
82 nfo := 'Der Ordner ' + #10 +Path + 'Playlisten' + #10 +
83 'ist nicht vorhanden, soll der jetzt erstellt werden ?' ;
84 if not DirectoryExists(Path +'Playlisten\') then
85 begin
86 if acrMessage.YesNoConfirm(nfo) = mryes then begin
87 ForceDirectories(Path +'Playlisten\');
88 result := Path +'Playlisten\';
89 end;
90 end else begin
91 result := Path +'Playlisten\';
92 end;
93 end;
94 //------------------------------------------------------------------------------
95 //...liefert das Verzeichnis der Application zurück.
96 function amAmpDir:string;
97 var Path:string;
98 begin
99 Path := ExtractFilePath(Application.ExeName);
100 result := Path;
101 end;
102 //------------------------------------------------------------------------------
103 //...wird im OnFromCreate der Application eingebunden
104 // nitiallisiert die BASS_SDK
105 procedure amInitBass;
106 begin
107 //BASS_Init(-1, 44100, BASS_DEVICE_LEAVEVOL, Application.Handle); //for DLL 1.8
108 BASS_Init(1, 44100, 0, Application.Handle, nil);
109 BASS_Start;
110 end;
111 //------------------------------------------------------------------------------
112 //...gibt den belgten Speicher von "Channel" u. der Bass SDK frei.
113 procedure amDistroyBass(Channel:DWORD);
114 begin
115 BASS_MusicFree(Channel);
116 BASS_Free;
117 end;
118 //------------------------------------------------------------------------------
119 //...erzeugt eine Inidatei mit dem Namen der Application
120 // in dem Ordner der Application
121 function amCreateAmpInI:TInIFile;
122 var Name, NameOExt, Path,f:string; InIDatei :TInIFile;
123 begin
124 Name := ExtractFileName(Application.ExeName);
125 Path := ExtractFilePath(Application.ExeName);
126 NameOExt := Purname(Name);
127 F := Path+NameOExt+'.ini';
128 InIDatei:= TInIFile.Create(F);
129 result := InIDatei;
130 end;
131
132 end.
133
134
135
136
137 //baEQ.pas
138 unit baEQ; //26.06.04, 20.07.04 ,23.07.04
139
140 interface
141 uses
142 Bass,Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
143 Dialogs, ExtCtrls, ComCtrls, acrString, acrInIFile, InIFiles, Slider,
144 baSong, baAmpShell;
145
146 type TSlidersData = array[0..9] of integer;
147
148 Type
149 TSoundEffects = set of (Flanger, Echo, Reverb);
150 TEqPreset = array [0..9] of Integer;
151
152
153 const
154 NumEQBands = 10;
155 FLABUFLEN = 350;
156
157
158 var
159 EqParam : array [0..9] of HFX;
160 EQBands : array [0..9] of Integer;
161
162 // Variables for DSP (flanger effect) implementation
163 flabuf : array[0..FLABUFLEN-1, 0..2] of SmallInt; // buffer
164 flapos : Integer; // cur.pos
165 flas, flasinc : FLOAT; // sweep pos/min/max/inc
166 fladspHandle : HDSP; //effect Handle
167 EchoHandle : HFX;
168 ReverbHandle : HFX;
169 EchoParam : BASS_FXECHO;
170 ReverbParam : BASS_FXREVERB;
171 SoundEffect : TSoundEffects;
172 EqP : BASS_FXPARAMEQ;
173
174 CurPreset : TEqPreset;
175 EqPreset : TEqPreset;
176
177
178 //-----------------------
179
180 procedure eqCreateEqualyzer(aChannel:DWORD);
181 function eqChkOfBoundetPreset(TitelName:string;chn:DWord):boolean;
182
183 procedure eqEqualizerOnOff(EQOn:boolean;S1,S2,S3,S4,S5,S6,S7,S8,S9,S10:TSlider);
184
185
186 procedure eqResetEqualizer;
187
188 procedure eqInitEqualizerBands;
189
190 function eqLoadBoundetPreset(SongName:string;chn:DWord):TSlidersData;
191
192 procedure eqMackBountPreset(SongName:string;chn:DWord;SLDArray:TSlidersData);
193
194 procedure eqRemoveBoundetPreset(TitelName:string;chn:DWord);
195
196 procedure eqSetEqualizer;
197 procedure eqSetSoundEffect(Value : TSoundEffects;Channel:DWORD;
198 FEchoLevel, FReverbLevel :integer);
199
200 procedure eqUpdateEq (aEqPreset : TEqPreset);
201 procedure epUpdateSliders(Sender: TObject;S1,S2,S3,S4,S5,S6,S7,S8,S9,S10:TSlider);
202
203
204
205
206 //++++++++++++++++InterneProceduren+++++++++++++++++++++++++++++++++++++++++
207 //++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
208 procedure Flange(handle: HSYNC; channel: DWORD; buffer: Pointer; length, user: DWORD); stdcall;
209 function fmod(a, b: FLOAT): FLOAT;
210
211
212 implementation
213 //------------------------------------------------------------------------------
214 //------------------------------------------------------------------------------
215 //------------------------------------------------------------------------------
216 //------------------------------------------------------------------------------
217 //...prüft ob das Lied "TitelName" ein BoundetPreset
218 // besitzt oder nicht.
219 function eqChkOfBoundetPreset(TitelName:string;chn:DWord):boolean;
220 var SongLen, NameLen, SongIDCode:integer;
221 SectionName,SongName, nfo :string; SetInI :TInIFile;
222 begin
223 if TitelName = '' then Exit;
224 SongLen := soSongLen(chn);
225 NameLen := Length(Purname(TitelName));
226 SongIDCode := SongLen + NameLen;
227 SectionName := intToStr(SongIDCode);
228 SetInI := TInIFile.Create(amAmpDir + 'BoundPrestet.set');
229 result := SetInI.SectionExists(SectionName);
230 SetInI.Free;
231 end;
232 //------------------------------------------------------------------------------
233 //...löschen des BoundetPreset, daß dem Lied "TitelName"
234 // zugeordnet ist (wenn vorhanden). "chn" ist der Channel des Songs.
235 procedure eqRemoveBoundetPreset(TitelName:string;chn:DWord);
236 var SongLen, NameLen, SongIDCode:integer;
237 SectionName,SongName, nfo :string; SetInI :TInIFile;
238 begin
239 if TitelName = '' then Exit;
240 SongLen := soSongLen(chn);
241 NameLen := Length(Purname(TitelName));
242 SongIDCode := SongLen + NameLen;
243 SectionName := intToStr(SongIDCode);
244 SetInI := TInIFile.Create(amAmpDir + 'BoundPrestet.set');
245 SongName := SetInI.ReadString(SectionName,'Song',Purname(TitelName));
246
247 if SongName = '' then Exit;
248 if SetInI.SectionExists(SectionName) then begin
249 nfo :='Das BoundedSet für '+ SongName + ' wirklich löschen ?';
250 if MessageDlg(nfo,mtConfirmation,[mbYes,mbNo],0)= mrYes then
251 begin
252 SetInI.EraseSection(SectionName);
253 eqLoadBoundetPreset(Purname(TitelName),chn);
254 end;
255 end;
256 SetInI.Free;
257 end;
258 //------------------------------------------------------------------------------
259 //...laden des BoundetPreset xxx wenn vorhanden, daß dem
260 // Lied "SongName" zugeordnet ist. "chn" ist der Channel des Songs
261 // der abgespiel wird. Rückgabewert ist ein Array of TSlidersData.
262 // type TSlidersData = array[0..9] of integer;
263 function eqLoadBoundetPreset(SongName:string;chn:DWord):TSlidersData;
264 var SongLen, NameLen, SongIDCode,i:integer;
265 SectionName:string; SetInI :TInIFile;
266 SLDDataArray :TSlidersData;
267 begin
268 if SongName = '' then Exit;
269 SongLen := soSongLen(chn);
270 if SongLen < 0 then Exit;
271 NameLen := Length(Purname(SongName));
272 SongIDCode := SongLen + NameLen;
273 SectionName := intToStr(SongIDCode);
274 SetInI := TInIFile.Create(amAmpDir + 'BoundPrestet.set');
275 if SetInI.SectionExists(SectionName) then begin
276 for i := 0 to 9 do
277 SLDDataArray[i] := SetInI.ReadInteger(SectionName,'Slider'+intToStr(i),0);
278 end else begin
279 for i := 0 to 9 do SLDDataArray[i]:= 0;
280 end;
281 result := SLDDataArray;
282 SetInI.Free;
283 end;
284 //------------------------------------------------------------------------------
285 //...erzeugt u. bindet das BoundetPreset an den Song "SongName"
286 // in "chn" wird der Channel des Songs übergeben u. mit
287 // "SLDArray" die Integerwerte der TSlider.
288 // "SLDArray" ist ein Array of TSlidersData
289 // type TSlidersData = array[0..9] of integer;
290 procedure eqMackBountPreset(SongName:string;chn:DWord;SLDArray:TSlidersData);
291 var SongLen, NameLen, SongIDCode,i:integer;
292 SectionName :string; SetInI :TInIFile; nfo :string;
293 begin
294 SongLen := soSongLen(chn);
295 if (SongLen < 0) or (SongName = '') then Exit;
296 NameLen := Length(Purname(SongName));
297 SongIDCode := SongLen + NameLen;
298 SectionName := intToStr(SongIDCode);
299 SetInI := TInIFile.Create(amAmpDir + 'BoundPrestet.set');
300 if SetInI.SectionExists(SectionName) then SetInI.EraseSection(SectionName);
301 SetInI.WriteString(SectionName,'Song',Purname(SongName));
302 for i := 0 to 9 do
303 SetInI.WriteInteger(SectionName,'Slider'+intTostr(i),SLDArray[i]);
304 SetInI.Free;
305 nfo :='Die EQ -Einstellung wurde an den Song '+ Purname(SongName) + ' gebunden !';
306 MessageDLG(nfo,mtInformation,[mbOK],0);
307 end;
308 //------------------------------------------------------------------------------
309 //...den Equalizer ein oder ausschalten, wird "EQOn" auf true gesetzt
310 // so ist der Equalizer aktive andernfalls ist er aus.
311 procedure eqEqualizerOnOff(EQOn:boolean;S1,S2,S3,S4,S5,S6,S7,S8,S9,S10:TSlider);
312 begin
313 if EQOn then begin
314 eqSetEqualizer;
315 EqPreset[0] := S1.Value;
316 EqPreset[1] := S2.Value;
317 EqPreset[2] := S3.Value;
318 EqPreset[3] := S4.Value;
319 EqPreset[4] := S5.Value;
320 EqPreset[5] := S6.Value;
321 EqPreset[6] := S7.Value;
322 EqPreset[7] := S8.Value;
323 EqPreset[8] := S9.Value;
324 EqPreset[9] := S10.Value;
325 eqSetEqualizer;
326 eqUpdateEq(EqPreset);
327 end else begin
328 eqResetEqualizer;
329 end;
330 end;
331 //------------------------------------------------------------------------------
332 //...im onChange von TSlider einbinden für Slider1 bis 10
333 procedure epUpdateSliders(Sender: TObject;S1,S2,S3,S4,S5,S6,S7,S8,S9,S10:TSlider);
334 begin
335 EqPreset[0] := S1.Value;
336 EqPreset[1] := S2.Value;
337 EqPreset[2] := S3.Value;
338 EqPreset[3] := S4.Value;
339 EqPreset[4] := S5.Value;
340 EqPreset[5] := S6.Value;
341 EqPreset[6] := S7.Value;
342 EqPreset[7] := S8.Value;
343 EqPreset[8] := S9.Value;
344 EqPreset[9] := S10.Value;
345
346 eqSetEqualizer;
347 eqUpdateEq(EqPreset);
348 end;
349
350 //------------------------------------------------------------------------------
351 //...erzeugt den Equalizer, aufrufen wenn ein neuer Titel abgespielt wird.
352 procedure eqCreateEqualyzer(aChannel:DWORD);
353 var i : integer;
354 begin
355 for i := 0 to 9 do
356 begin
357 EqParam[i] := BASS_ChannelSetFX(aChannel, BASS_FX_PARAMEQ);
358 EqP.fGain := 0;
359 EqP.fBandwidth := 3;
360 EqP.fCenter := EQBands[i];
361
362 if not BASS_FXSetParameters(EqParam[i], @EqP) then begin
363
364 //if BASS_ERROR_HANDLE = BASS_ErrorGetCode then showmessage('h');
365 //if BASS_ERROR_ILLPARAM = BASS_ErrorGetCode then showmessage('ill');
366 //if BASS_ERROR_UNKNOWN = BASS_ErrorGetCode then showmessage('uk');
367 //showmessage(inttostr(i));
368 end;
369 end;
370 end;
371 //------------------------------------------------------------------------------
372 //...Equalizer ausschalten
373 procedure eqResetEqualizer;
374 var aEqPreset : TEqPreset; i: Integer;
375 begin
376 for i := 0 to 9 do aEqPreset[i] := 0;
377 eqUpdateEq(aEqPreset);
378 end;
379 //------------------------------------------------------------------------------
380 //...setzt den Equalizer neu, bzw. die TSlider - Einstellungen
381 // erneut einlesen (setzen).
382 procedure eqSetEqualizer;
383 begin
384 eqUpdateEq(CurPreset);
385 end;
386 //------------------------------------------------------------------------------
387 //...Equalizer updaten
388 procedure eqUpdateEq (aEqPreset : TEqPreset);
389 var i :Integer;
390 begin
391 CurPreset := aEqPreset;
392 for i := 0 to 9 do
393 begin
394 BASS_FXGetParameters(EqParam[i],@EqP);
395 EqP.fGain:= aEqPreset[i];
396 BASS_FXSetParameters(EqParam[i],@EqP);
397 end;
398 end;
399 //------------------------------------------------------------------------------
400 //...initialiesert die EQBands, im OnCreate des Haupformulars aufrufen
401 procedure eqInitEqualizerBands;
402 var i : integer;
403 begin
404 EQBands[0] := 80;
405 EQBands[1] := 170;
406 EQBands[2] := 310;
407 EQBands[3] := 600;
408 EQBands[4] := 1000;
409 EQBands[5] := 3000;
410 EQBands[6] := 6000;
411 EQBands[7] := 10000;
412 EQBands[8] := 12000;
413 EQBands[9] := 14000;
414 for i := 0 to 9 do
415 EqParam[i] := 0;
416 end;
417 //------------------------------------------------------------------------------
418 //...setzt den mit "Value" übergebenen SoundEffect
419 procedure eqSetSoundEffect(Value : TSoundEffects;Channel:DWORD;
420 FEchoLevel, FReverbLevel :integer);
421 // MaxWert fur FEchoLevel u. FReverbLevel = 32
422 begin
423 if Flanger in Value then
424 begin
425 if fladspHandle = 0 then
426 begin
427 FillChar(flabuf, SizeOf(flabuf), 0);
428 flapos := 0;
429 flas := FLABUFLEN /2;
430 flasinc := 0.002;
431 fladspHandle := BASS_ChannelSetDSP(Channel, Flange, 0,0);
432 end;
433 end
434 else
435 if fladspHandle <> 0 then
436 if BASS_ChannelRemoveDSP(Channel, fladspHandle) then
437 fladspHandle := 0;
438
439 if Echo in Value then
440 begin
441 if EchoHandle = 0 then
442 EchoHandle := BASS_ChannelSetFX(Channel, BASS_FX_ECHO);
443 if EchoHandle <> 0 then
444 begin
445 if BASS_FXGetParameters(EchoHandle, @EchoParam) then
446 begin
447 EchoParam.fWetDryMix := FEchoLevel * 1.2{30.0};
448 EchoParam.fFeedBack := 30.0;
449 BASS_FXSetParameters(EchoHandle, @EchoParam)
450 end;
451 end;
452 end else
453 if EchoHandle <> 0 then
454 if BASS_ChannelRemoveFX(Channel, EchoHandle) then
455 EchoHandle := 0;
456
457 if Reverb in Value then
458 begin
459 if ReverbHandle = 0 then
460 ReverbHandle := BASS_ChannelSetFX(Channel, BASS_FX_REVERB);
461 if ReverbHandle <> 0 then
462 begin
463 if BASS_FXGetParameters(ReverbHandle, @ReverbParam) then
464 begin
465 ReverbParam.fInGain := 0.0;
466 ReverbParam.fReverbMix := FReverbLevel * 0.5 - 16.0;
467 ReverbParam.fReverbTime := 1000.0;
468 ReverbParam.fHighFreqRTRatio := 0.1;
469 BASS_FXSetParameters(ReverbHandle, @ReverbParam)
470 end;
471 end;
472 end else
473 if ReverbHandle <> 0 then
474 if BASS_ChannelRemoveFX(Channel, ReverbHandle) then
475 ReverbHandle := 0;
476 end;
477 //++++++++++++++++++++++Internefunctionen+++++++++++++++++++++++++++++++++++++++
478 //++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
479 function fmod(a, b: FLOAT): FLOAT;
480 begin
481 Result := a - (b * Trunc(a / b));
482 end;
483
484 function Clip(a: Integer): Integer;
485 begin
486 if a <= -32768 then
487 a := -32768
488 else if a >= 32767 then
489 a := 32767;
490 Result := a;
491 end;
492
493 procedure Flange(handle: HSYNC; channel: DWORD; buffer: Pointer; length, user: DWORD); stdcall;
494 var
495 lc, rc: SmallInt;
496 p1, p2, s: Integer;
497 d: ^DWORD;
498 f: FLOAT;
499 begin
500 d := buffer;
501 while (length > 0) do
502 begin
503 lc := LOWORD(d^); rc := HIWORD(d^);
504 p1 := (flapos + Trunc(flas)) mod FLABUFLEN;
505 p2 := (p1 + 1) mod FLABUFLEN;
506 f := fmod(flas, 1.0);
507 s := lc + Trunc(((1.0-f) * flabuf[p1, 0]) + (f * flabuf[p2, 0]));
508 flabuf[flapos, 0] := lc;
509 lc := Clip(s);
510 s := rc + Trunc(((1.0-f) * flabuf[p1, 1]) + (f * flabuf[p2, 1]));
511 flabuf[flapos, 1] := rc;
512 rc := Clip(s);
513 d^ := MakeLong(lc, rc);
514 Inc(d);
515 Inc(flapos);
516 if (flapos = FLABUFLEN) then flapos := 0;
517 flas := flas + flasinc;
518 if (flas < 0) or (flas > FLABUFLEN) then
519 flasinc := -flasinc;
520 length := length - 4;
521 end;
522 end;
523
524 end.
525
526
527 //baSong.pas
528 unit baSong;
529
530 interface
531 uses
532 Bass,Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
533 Dialogs, ExtCtrls, ComCtrls, StdCtrls,
534 acrString, acrInIFile, acrTools, InIFiles, Slider;
535 type
536 TSongData = record
537 BitRate :integer; //Bitrate des Songs
538 CurPos :integer; //aktuelle Position
539 EndOfSong :boolean;//ist true wenn der Song zu ende ist
540 Hours :integer; //Song länge in Stunden
541 LenPurMin :integer; //nur Minuten der Songlänge
542 LenPurSec :integer; //nur Sekunden der Songlänge
543 PlayerStatus :integer; //Staus des Player als intWert
544 PosPurMin :integer; //nur Minuten des Songs
545 PosPurSec :integer; //nur Sekunden des Songs
546 RestTime :integer; //Restspielzeit
547 RestPurMin :integer; //nur Minuten der Restzeit
548 RestPurSec :integer; //nur Sekunden der Restzeit
549 TotalTime:integer; //Gesammte länge
550 strSongPos :string; //Position als String
551 strSongLen :string; //Lange als String
552 strSongRest :string; //Restzeit als String
553 strPlayerStatus :string; //Playerstatus als String
554 VURight :integer; //rechter Kanal
555 VULeft :integer; //linker Kanal
556 end;
557 //----------------------------------------------------
558 function soBitrate(Channel:DWORD) : integer;
559
560 procedure soDrawPlaylistItems(Control: TWinControl;Index: Integer; Rect: TRect;
561 State: TOwnerDrawState;
562 clBalken,
563 clTextHighLight,
564 clLBoxColor,
565 clText :TColor;
566 ChannelFile:string;
567 Numbers,
568 ViewVerticalBar,
569 SelTextBold,
570 isShowTimes:boolean;
571 sL:TStringlist);
572
573 function soHourAtPos(Channel:DWORD):integer;
574
575 procedure soInitBass;
576
577 procedure soPosMinSec(var fMin,fSec:integer;Channel:DWORD);
578 function soPosAsString(Channel:DWORD):string;
579 procedure soPause(CH:DWord);
580
581 function soPlayFile(FF :string):DWORD;
582 function soPlayTime(Song:string):string;
583 procedure soPlay(CH:DWord);
584 function soPlayNext(LBox:TListBox;FL:TStrings;var chn:DWord):String;
585 function soPlayPrev(LBox:TListBox;FL:TStrings;var chn:DWord):String;
586 procedure soPlaySongEndlos(chn:DWord);
587 function soPlayedListEndlos(LBox:TListBox;FL:TStrings;var chn:DWord):String;
588
589 procedure soRestPosMinSec(var fMin,fSec:integer; Channel:DWORD);
590 function soRestPosAsString(Channel:DWORD):string;
591
592 function soSongDatas(Channel:DWORD):TSongData;
593 function soSongHour(Channel:DWORD):integer;
594 function soSongHourAtPos(Channel:DWORD) : Integer;
595 function soSongLenAsString(Channel:DWORD):string;
596 function soSongLen(Channel:DWORD) : Integer;
597 procedure soSongLenMinSec(var fMin,fSec:integer; Channel:DWORD);
598 function soSongOfEnd(Channel:DWORD):boolean;
599 function soSongPos(Channel:DWORD) : Integer;
600 function soSongRestPos(Channel:DWORD):integer;
601 procedure soStop(CH:DWord);
602
603
604 function soSetPlayPosition(Channel:DWORD;Pos:int64):integer;
605
606 //Intern
607 function GetFilePlayTime(Song:string):string;
608
609
610
611 var SongDatas :TSongData;
612 const SonglistBoxRand =' ';
613
614 implementation
615 //------------------------------------------------------------------------------
616 //------------------------------------------------------------------------------
617 //------------------------------------------------------------------------------
618 //------------------------------------------------------------------------------
619 //...spielt eine Playliste die in "LBox" geladen wurde endlos ab,
620 // "FL" ist ein Stingliste mit den Pfaden zu den Songs,
621 // der Channel des aktuellen Songs wird in "chn" zurückgeliefert.
622 // Der Path des aktuellen Songs wird als Funktionsergebnis zurückgeliefert.
623 function soPlayedListEndlos(LBox:TListBox;FL:TStrings;var chn:DWord):String;
624 begin
625 if soSongOfEnd(chn) then
626 result := soPlayNext(LBox,FL, chn)
627 else result := '';
628 end;
629 //------------------------------------------------------------------------------
630 //...spielt einen Song endlos ab.
631 procedure soPlaySongEndlos(chn:DWord);
632 var erg :boolean;
633 begin
634 erg := soSongOfEnd(chn);
635 if erg then soPlay(chn);
636 end;
637 //------------------------------------------------------------------------------
638 //...spielt den nächsten Song in der Playliste "LBox" ab.
639 // "FL" ist ein Stingliste mit den Pfaden zu den Songs,
640 // der Channel des aktuellen Songs wird in "chn" zurückgeliefert.
641 // der Path des aktuellen Songs wird als Funktionsergebnis zurückgeliefert.
642 //------------------------------------------------------------------------------
643 function soPlayNext(LBox:TListBox;FL:TStrings;var chn:DWord):String;
644 var index, Anz, pPos :integer; S:string;
645 begin
646 index := LBox.ItemIndex;
647 Anz := LBox.Items.Count -1;
648 inc(index);
649 if index > Anz then index := 0;
650 LBox.ItemIndex := index;
651 pPos := Pos('°',FL.Strings[index]);
652 if pPos >0 then begin
653 S := FL.Strings[index];
654 result := copy(S,0,pos('°',S)-1);
655 end else begin
656 result := FL.Strings[index];
657 end;
658 chn := soPlayFile(result);
659 end;
660 //------------------------------------------------------------------------------
661 //...spielt den vorherigen Song in der Playliste "LBox" ab.
662 // "FL" ist ein Stingliste mit den Pfaden zu den Songs,
663 // der Channel des aktuellen Songs wird in "chn" zurückgeliefert.
664 // der Path des aktuellen Songs wird als Funktionsergebnis zurückgeliefert.
665 function soPlayPrev(LBox:TListBox;FL:TStrings;var chn:DWord):String;
666 var index, Anz, pPos :integer; S :String;
667 begin
668 index := LBox.ItemIndex;
669 Anz := LBox.Items.Count -1;
670 dec(index);
671 if index < 0 then index := Anz;
672 LBox.ItemIndex := index;
673 pPos := Pos('°',FL.Strings[index]);
674 if pPos >0 then begin
675 S := FL.Strings[index];
676 result := copy(S,0,pos('°',S)-1);
677 end else begin
678 result := FL.Strings[index];
679 end;
680 chn := soPlayFile(result);
681 end;//------------------------------------------------------------------------------
682 //...spiel den Song ab oder weiter wenn der Song im
683 // Pausenzustand wahr
684 //------------------------------------------------------------------------------
685 procedure soPlay(CH:DWord);
686 begin
687 BASS_ChannelResume(ch);
688 if BASS_ChannelIsActive(ch) <> BASS_ACTIVE_PLAYING then
689 begin
690 Bass_Start;
691 BASS_StreamPlay(ch, true, 0);
692 end;
693 end;
694 //------------------------------------------------------------------------------
695 //...wenn der Song abgespielt wird, so wird er in den Pausenzustand
696 // versetzt, andernfalls wird er ab der aktuellen Position weiter
697 // abgespielt.
698 procedure soPause(CH:DWord);
699 begin
700 if BASS_ChannelIsActive(ch) = BASS_ACTIVE_PLAYING then
701 BASS_ChannelPause(ch) else BASS_ChannelResume(ch);
702 end;
703 //------------------------------------------------------------------------------
704 //...den aktuellen Song stoppen
705 procedure soStop(CH:DWord);
706 begin
707 BASS_ChannelStop(ch);
708 end;
709 //------------------------------------------------------------------------------
710 //...setzt die mit "Pos" übergebene Position im Song
711 // u. liefert die Position zurück;
712 function soSetPlayPosition(Channel:DWORD;Pos:int64):integer;
713 var SongPos : int64;
714 begin
715 SongPos := BASS_ChannelSeconds2Bytes(Channel,Pos / 1000);
716 BASS_ChannelSetPosition(Channel, SongPos);
717 result := SongPos;
718 end;
719 //------------------------------------------------------------------------------
720 //...liefert die Restzeit des aktuellen Songs als formatierten String zurück
721 function soRestPosAsString(Channel:DWORD):string;
722 var Min, Sec :string; //Channel ist vom Typ = DWORD;
723 SongPos,SongLength : DWORD; MilliSec : Integer; FloatPos,FloatPos1 : FLOAT;
724 begin
725 result :='';
726 SongLength := BASS_StreamGetLength(Channel);
727 FloatPos1 := BASS_ChannelBytes2Seconds(Channel, SongLength);
728
729 SongPos := BASS_ChannelGetPosition(Channel);
730 FloatPos := BASS_ChannelBytes2Seconds(Channel, SongPos);
731 MilliSec := Trunc(1000 * (FloatPos1 - FloatPos));
732 if MilliSec < 0 then MilliSec := 0;
733
734 Min:= FormatDateTime ('nn', MilliSec / (1000 * 24 * 60 * 60));
735 Sec:= FormatDateTime ('ss', MilliSec / (1000 * 24 * 60 * 60));
736 result := Min + ':'+Sec;
737 end;
738 //------------------------------------------------------------------------------
739 //...liefert die Position des Songs als formatierten String zurück
740 function soPosAsString(Channel:DWORD):string;
741 var Min, Sec :string; //Channel ist vom Typ = DWORD;
742 SongPos : DWORD; MilliSec : Integer; FloatPos : FLOAT;
743 begin
744 result :='';
745 SongPos := BASS_ChannelGetPosition(Channel);
746 FloatPos := BASS_ChannelBytes2Seconds(Channel, SongPos);
747 MilliSec := Trunc(1000 * FloatPos);
748 if MilliSec < 0 then MilliSec := 0;
749 Min:= FormatDateTime ('nn', MilliSec / (1000 * 24 * 60 * 60));
750 Sec:= FormatDateTime ('ss', MilliSec / (1000 * 24 * 60 * 60));
751 result := Min + ':'+Sec;
752 end;
753 //------------------------------------------------------------------------------
754 //....liefer die Integerwerte einzelnd in fMin u. fSec zurück
755 procedure soPosMinSec(var fMin,fSec:integer;Channel:DWORD);
756 var Min, Sec :string;
757 SongPos : DWORD; MilliSec : Integer; FloatPos : FLOAT;
758 begin
759 SongPos := BASS_ChannelGetPosition(Channel);
760 FloatPos := BASS_ChannelBytes2Seconds(Channel, SongPos);
761 MilliSec := Trunc(1000 * FloatPos);
762 if MilliSec < 0 then MilliSec := 0;
763
764 Min:= FormatDateTime ('nn', MilliSec / (1000 * 24 * 60 * 60));
765 Sec:= FormatDateTime ('ss', MilliSec / (1000 * 24 * 60 * 60));
766 fMin := StrToInt(Min);
767 fSec := StrToInt(Sec);
768 end;
769 //------------------------------------------------------------------------------
770 //...liefer die Integerwerte einzelnd in fMin u. fSec zurück.
771 procedure soRestPosMinSec(var fMin,fSec:integer; Channel:DWORD);
772 var Min, Sec :string;
773 SongPos,SongLength : DWORD; MilliSec : Integer; FloatPos,FloatPos1 : FLOAT;
774 begin
775 SongLength := BASS_StreamGetLength(Channel);
776 FloatPos1 := BASS_ChannelBytes2Seconds(Channel, SongLength);
777
778 SongPos := BASS_ChannelGetPosition(Channel);
779 FloatPos := BASS_ChannelBytes2Seconds(Channel, SongPos);
780 MilliSec := Trunc(1000 * (FloatPos1 - FloatPos));
781 if MilliSec < 0 then MilliSec := 0;
782
783 Min:= FormatDateTime ('nn', MilliSec / (1000 * 24 * 60 * 60));
784 Sec:= FormatDateTime ('ss', MilliSec / (1000 * 24 * 60 * 60));
785 fMin := StrToInt(Min);
786 fSec := StrToInt(Sec);
787 end;
788 //------------------------------------------------------------------------------
789 //...liefert die Restspielzeit des aktuellen Songs zurück
790 function soSongRestPos(Channel:DWORD):integer;
791 var SongPos,SongLength : DWORD; MilliSec : Integer; FloatPos,FloatPos1 : FLOAT;
792 begin
793 SongLength := BASS_StreamGetLength(Channel);
794 FloatPos1 := BASS_ChannelBytes2Seconds(Channel, SongLength);
795 SongPos := BASS_ChannelGetPosition(Channel);
796 FloatPos := BASS_ChannelBytes2Seconds(Channel, SongPos);
797 MilliSec := Trunc(1000 * (FloatPos1 - FloatPos));
798 if MilliSec < 0 then MilliSec := 0;
799 result := MilliSec;
800 end;
801 //------------------------------------------------------------------------------
802 //...spiel des Song FF ab u. liefert den Channel für
803 // für die BASS_SDK bzw. Application zurück.
804 function soPlayFile(FF :string):DWORD;
805 var
806 Channel :DWORD;
807 begin
808 result := 0;
809 if FF = '' then Exit;
810 Bass_Stop;
811 Channel := BASS_StreamCreateFile(FALSE, PChar(FF), 0, 0, 0);
812 Bass_Start;
813 BASS_StreamPlay(Channel, true, 0);
814 result := Channel;
815 end;
816 //------------------------------------------------------------------------------
817 //...liefer die Integerwerte einzelnd in fMin u. fSec zurück
818 procedure soSongLenMinSec(var fMin,fSec:integer; Channel:DWORD);
819 var MilliSec : Integer; FloatPos : FLOAT; Min, Sec:string;
820 SongLength : integer;
821 begin //liefer die Integerwerte einzelnd in fMin u. fSec zurück
822 SongLength := BASS_StreamGetLength(Channel);
823 FloatPos := BASS_ChannelBytes2Seconds(Channel, SongLength);
824 MilliSec := Trunc(1000 * FloatPos);
825 if MilliSec < 0 then MilliSec := 0;
826
827 Min:= FormatDateTime ('nn', MilliSec / (1000 * 24 * 60 * 60));
828 Sec:= FormatDateTime ('ss', MilliSec / (1000 * 24 * 60 * 60));
829 fMin := StrToInt(Min);
830 fSec := StrToInt(Sec);
831 end;
832 //------------------------------------------------------------------------------
833 //...liefert die Länge des Songs in einem frormatierten String zurück
834 // in der Form nn:ss
835 function soSongLenAsString(Channel:DWORD) : string;
836 var MilliSec, SongLength : Integer; FloatPos : FLOAT;
837 SongLeange :string;
838 begin
839 result :='';
840 SongLength := BASS_StreamGetLength(Channel);
841 FloatPos := BASS_ChannelBytes2Seconds(Channel, SongLength);
842 MilliSec := Trunc(1000 * FloatPos);
843 if MilliSec < 0 then MilliSec := 0;
844 SongLeange := FormatDateTime ('nn:ss', MilliSec / (1000 * 24 * 60 * 60));
845 result := SongLeange;
846 end;
847 //------------------------------------------------------------------------------
848 //...liefert die Länge des Songs in Stunden 1,2,3 usw
849 function soSongHour(Channel:DWORD):integer;
850 var Hour :string;
851 SLength : DWORD; MilliSec : Integer; FloatPos : FLOAT;
852 begin
853 SLength := BASS_StreamGetLength(Channel);
854 FloatPos := BASS_ChannelBytes2Seconds(Channel, SLength);
855 MilliSec := Trunc(1000 * FloatPos);
856 if MilliSec < 0 then MilliSec := 0;
857 //result := MilliSec;
858 Hour:= FormatDateTime ('nn', MilliSec / (1000 * 24 * 60 *60 )/60);
859 result := StrToInt(Hour);
860 end;
861
862 //------------------------------------------------------------------------------
863 //...liefert die aktuelle Spielposition in Stunden zurück
864 function soSongHourAtPos(Channel:DWORD) : Integer;
865 var SongPos : DWORD; MilliSec : Integer; FloatPos : FLOAT;
866 begin
867 SongPos := BASS_ChannelGetPosition(Channel);
868 FloatPos := BASS_ChannelBytes2Seconds(Channel, SongPos);
869 MilliSec := Trunc(1000 * FloatPos);
870 if MilliSec < 0 then MilliSec := 0;
871
872 result:= strToInt(FormatDateTime ('nn', MilliSec / (1000 * 24 * 60 *60 )/60));
873 // result := MilliSec;
874 end;
875 //------------------------------------------------------------------------------
876 //...liefert die aktuelle Spielposition zurück
877 function soSongPos(Channel:DWORD) : Integer;
878 var SongPos : DWORD; MilliSec : Integer; FloatPos : FLOAT;
879 begin
880 SongPos := BASS_ChannelGetPosition(Channel);
881 FloatPos := BASS_ChannelBytes2Seconds(Channel, SongPos);
882 MilliSec := Trunc(1000 * FloatPos);
883 if MilliSec < 0 then MilliSec := 0;
884 result := MilliSec;
885 end;
886 //------------------------------------------------------------------------------
887 //...liefert die Bitrate des Songs zurück;
888 function soBitrate(Channel:DWORD) : integer;
889 var ByteLen : DWORD;
890 SongLength,
891 Bitrate :integer;
892 begin
893 SongLength := BASS_StreamGetLength(Channel);
894 ByteLen := BASS_ChannelSeconds2Bytes(Channel, SongLength);
895 Bitrate := Trunc((ByteLen / (2 * 8 * soSongLen(Channel))));
896 Result := Bitrate;
897 end;
898 //------------------------------------------------------------------------------
899 //...liefert zu dem Lied das in "Song" übergeben wird die gesamte
900 // Spielzeit in einem formatierten String zurück un der Form hh:mm:ss
901 function soPlayTime(Song:string):string;
902 var Tmp :string; MilliSec : Integer; FloatPos : FLOAT;
903 SongLen : integer; dChannel :DWORD;
904 begin
905 if Song = '' then Exit;
906 soInitBass;
907 dChannel := BASS_StreamCreateFile(FALSE, PChar(Song), 0, 0, 0);
908 SongLen := BASS_StreamGetLength(dChannel);
909 FloatPos := BASS_ChannelBytes2Seconds(dChannel, SongLen);
910 BASS_StreamFree(dChannel);
911
912 MilliSec := Trunc(1000 * FloatPos);
913 if MilliSec < 0 then MilliSec := 0;
914 Tmp := FormatDateTime ('hh:nn:ss', MilliSec / (1000 * 24 * 60 * 60));
915 result := Tmp;
916 end;
917 //------------------------------------------------------------------------------
918 //...liefert die länge des Songs als integer zurück.
919 function soSongLen(Channel:DWORD) : Integer;
920 var MilliSec : Integer; FloatPos : FLOAT;
921 SongLength : integer;
922 begin
923 SongLength := BASS_StreamGetLength(Channel);
924 FloatPos := BASS_ChannelBytes2Seconds(Channel, SongLength);
925 MilliSec := Trunc(1000 * FloatPos);
926 if MilliSec < 0 then MilliSec := 0;
927 result := MilliSec;
928 end;
929 //------------------------------------------------------------------------------
930 //...liefer den Integerwerte der Songlänge in Stunden in Abhägigkeit von
931 // der SongPosition ist die SongPosition unter 1ner Minute ist der Wert 0
932 // ansonsten entspechend der Stunden 1,2,3 usw.
933 function soHourAtPos(Channel:DWORD):integer;
934 var Hour :string; //liefer den Integerwerte der Songlänge in Stunden
935 SPos : DWORD; MilliSec : Integer; FloatPos : FLOAT;
936 begin
937 SPos := BASS_ChannelGetPosition(Channel);
938 FloatPos := BASS_ChannelBytes2Seconds(Channel, SPos);
939 MilliSec := Trunc(1000 * FloatPos);
940 if MilliSec < 0 then MilliSec := 0;
941 //result := MilliSec;
942 Hour:= FormatDateTime ('nn', MilliSec / (1000 * 24 * 60 *60 )/60);
943 result := StrToInt(Hour);
944 end;
945 //------------------------------------------------------------------------------
946 //...prüft ob ein Song der gerade spielt, am Ende angekommen ist.
947 function soSongOfEnd(Channel:DWORD):boolean;
948 begin
949 if BASS_ChannelGetPosition(Channel) = BASS_StreamGetLength(Channel)
950 then result := true
951 else result := false;
952 end;
953 //------------------------------------------------------------------------------
954 //...initiallisiert die BASS_SDK
955 //Wird im OnFromCreate der Application eingebunden
956 procedure soInitBass;
957 begin
958 //BASS_Init(-1, 44100, BASS_DEVICE_LEAVEVOL, Application.Handle); //for DLL 1.8
959 BASS_Init(1, 44100, 0, Application.Handle, nil);
960 BASS_Start;
961 end;
962 //------------------------------------------------------------------------------
963 //...liefert alle relevanten Daten zu einem spielenden Song in einem
964 // Record zurück
965 function soSongDatas(Channel:DWORD):TSongData;
966 var SongPos, VUCH : DWORD;
967 MilliSec, Bitrate, ByteLen, Min, Sec : Integer;
968 FloatPos, FloatPos1 : FLOAT;
969 sMin, sSec :string;
970 begin
971 //CurPos
972 SongDatas.CurPos := soSongPos(Channel);//MilliSec;
973 //EndOfSong
974 SongDatas.EndOfSong := soSongOfEnd(Channel);
975 //SongTime Stunden
976 SongDatas.Hours := soHourAtPos(Channel);
977 //TotalTime
978 FloatPos := BASS_ChannelBytes2Seconds(Channel, soSongLen(Channel));//SongLength);
979 MilliSec := Trunc(1000 * FloatPos);
980 if MilliSec < 0 then MilliSec := 0;
981 SongDatas.TotalTime := MilliSec;
982 //RestTime
983 FloatPos1 := BASS_ChannelBytes2Seconds(Channel, soSongLen(Channel));//SongLength);
984 SongPos := BASS_ChannelGetPosition(Channel);
985 FloatPos := BASS_ChannelBytes2Seconds(Channel, SongPos);
986 MilliSec := Trunc(1000 * (FloatPos1 - FloatPos));
987 if MilliSec < 0 then MilliSec := 0;
988 SongDatas.RestTime :=MilliSec;
989 //Bitrate
990 ByteLen := BASS_ChannelSeconds2Bytes(Channel, soSongLen(Channel));//SongLength);
991 Bitrate := Trunc((ByteLen / (2 * 8 * soSongLen(Channel))));
992 SongDatas.BitRate := Bitrate;
993 //VURight
994 VUCH := BASS_ChannelGetLevel(Channel);
995 SongDatas.VULeft := LOWORD(VUCH);
996 SongDatas.VURight := HIWORD(VUCH);
997 //PosPurMin
998 FloatPos := BASS_ChannelBytes2Seconds(Channel, BASS_ChannelGetPosition(Channel));
999 MilliSec := Trunc(1000 * FloatPos);
1000 if MilliSec < 0 then MilliSec := 0;
1001 Min:= StrToInt(FormatDateTime ('nn', MilliSec / (1000 * 24 * 60 * 60)));
1002 Sec:= StrToInt(FormatDateTime ('ss', MilliSec / (1000 * 24 * 60 * 60)));
1003 SongDatas.PosPurMin := Min;
1004 SongDatas.PosPurSec := Sec;
1005 //LenPurMin
1006 FloatPos := BASS_ChannelBytes2Seconds(Channel, soSongLen(Channel));//SongLength);
1007 MilliSec := Trunc(1000 * FloatPos);
1008 if MilliSec < 0 then MilliSec := 0;
1009 Min:= StrToInt(FormatDateTime ('nn', MilliSec / (1000 * 24 * 60 * 60)));
1010 Sec:= StrToInt(FormatDateTime ('ss', MilliSec / (1000 * 24 * 60 * 60)));
1011 SongDatas.LenPurMin := Min;
1012 SongDatas.LenPurSec := Sec;
1013 //RestPurMin
1014 FloatPos1 := BASS_ChannelBytes2Seconds(Channel, soSongLen(Channel));//SongLength);
1015 SongPos := BASS_ChannelGetPosition(Channel);
1016 FloatPos := BASS_ChannelBytes2Seconds(Channel, SongPos);
1017 MilliSec := Trunc(1000 * (FloatPos1 - FloatPos));
1018 if MilliSec < 0 then MilliSec := 0;
1019 sMin:= FormatDateTime ('nn', MilliSec / (1000 * 24 * 60 * 60));
1020 sSec:= FormatDateTime ('ss', MilliSec / (1000 * 24 * 60 * 60));
1021 SongDatas.RestPurMin := StrToInt(sMin);
1022 songDatas.RestPurSec := StrToInt(sSec);
1023 //PlayerStatus
1024 case BASS_ChannelIsActive(Channel) of
1025 0: begin SongDatas.PlayerStatus := BASS_ACTIVE_STOPPED; end; //0
1026 1: begin SongDatas.PlayerStatus :=BASS_ACTIVE_PLAYING; end; //1
1027 2: begin SongDatas.PlayerStatus :=BASS_ACTIVE_STALLED; end; //2
1028 3: begin SongDatas.PlayerStatus :=BASS_ACTIVE_PAUSED; end; //3
1029 end;
1030 //strSongPos
1031 SongPos := BASS_ChannelGetPosition(Channel);
1032 FloatPos := BASS_ChannelBytes2Seconds(Channel, SongPos);
1033 MilliSec := Trunc(1000 * FloatPos);
1034 if MilliSec < 0 then MilliSec := 0;
1035 sMin:= FormatDateTime ('nn', MilliSec / (1000 * 24 * 60 * 60));
1036 sSec:= FormatDateTime ('ss', MilliSec / (1000 * 24 * 60 * 60));
1037 SongDatas.strSongPos:= sMin + ':'+sSec;
1038 //strSongLen
1039 FloatPos := BASS_ChannelBytes2Seconds(Channel, soSongLen(Channel));//SongLength);
1040 MilliSec := Trunc(1000 * FloatPos);
1041 if MilliSec < 0 then MilliSec := 0;
1042 SongDatas.strSongLen := FormatDateTime ('nn:ss', MilliSec / (1000 * 24 * 60 * 60));
1043 //strSongRest
1044 FloatPos1 := BASS_ChannelBytes2Seconds(Channel, soSongLen(Channel));//SongLength);
1045 SongPos := BASS_ChannelGetPosition(Channel);
1046 FloatPos := BASS_ChannelBytes2Seconds(Channel, SongPos);
1047 MilliSec := Trunc(1000 * (FloatPos1 - FloatPos));
1048 if MilliSec < 0 then MilliSec := 0;
1049 sMin:= FormatDateTime ('nn', MilliSec / (1000 * 24 * 60 * 60));
1050 sSec:= FormatDateTime ('ss', MilliSec / (1000 * 24 * 60 * 60));
1051 SongDatas.strSongRest := sMin + ':'+sSec;
1052 //strPlayerStatus
1053 if BASS_ChannelIsActive(Channel) = BASS_ACTIVE_STOPPED then
1054 SongDatas.strPlayerStatus := 'Stop'; //0
1055 if BASS_ChannelIsActive(Channel) = BASS_ACTIVE_PLAYING then
1056 SongDatas.strPlayerStatus := 'Play'; //1
1057 if BASS_ChannelIsActive(Channel) = BASS_ACTIVE_STALLED then
1058 SongDatas.strPlayerStatus :='Standby'; //2
1059 if BASS_ChannelIsActive(Channel) = BASS_ACTIVE_PAUSED then
1060 SongDatas.strPlayerStatus :='Pause'; //3
1061 result := SongDatas;
1062 end;
1063 //------------------------------------------------------------------------------
1064 //...zeichnet die Items einer TListBox die als Playliste
1065 // verwendet werden soll farbig. Verwendung im OnDrawItemEvent !
1066 //------------------------------------------------------------------------------
1067 procedure soDrawPlaylistItems(Control: TWinControl;Index: Integer; Rect: TRect;
1068 State: TOwnerDrawState;
1069 clBalken,
1070 clTextHighLight,
1071 clLBoxColor,
1072 clText :TColor;
1073 ChannelFile:string;
1074 Numbers,
1075 ViewVerticalBar,
1076 SelTextBold,
1077 isShowTimes:boolean;
1078 sL:TStringlist);
1079
1080 var i, z, MaxWidth : Integer; Tmp, PlSel, ChFile,m : String; OldTextColor:TColor;
1081 begin
1082 OldTextColor := clTextHighLight;
1083 with (control as TListbox).Canvas do
1084 begin
1085 FillRect(Rect);
1086 for i := 0 to ((control as TListbox).Items).Count -1 do begin
1087 z := i + 1;
1088 if z <10 then m :='0'+intToStr(z) else m := intToStr(z);//Nummern zusammen basteln
1089 PlSel := m + SonglistBoxRand + (control as TListbox).Items[Index];
1090 ChFile := m + SonglistBoxRand + Purname(ChannelFile);
1091 if ChFile = PlSel then begin
1092 Font.Color := clTextHighLight;
1093 if SelTextBold then Font.Style := [fsBold]
1094 else Font.Style := [];
1095 end;
1096 end;
1097
1098 end;
1099
1100 with (control as TListbox) do begin
1101 Font.Color := clText;
1102 Color := clLBoxColor;
1103 canvas.brush.style:=bssolid;
1104
1105 if odselected in state then begin
1106
1107 if (clTextHighLight = clBalken) then clTextHighLight := not clBalken
1108 else clTextHighLight := OldTextColor;
1109
1110 canvas.Font.Color := clTextHighLight;
1111 if ((control as TListbox).Selected[Index]) or (odselected in state) then begin
1112 canvas.brush.color:= clBalken;
1113 end else begin
1114 canvas.brush.color := clLBoxColor;
1115 end;
1116 end;
1117
1118
1119 canvas.fillrect(rect);
1120 if not Numbers then canvas.Textout(Rect.left + 5, Rect.top, Items[index])
1121 else canvas.Textout(Rect.left + 5, Rect.top, IntToStr(Index + 1) + ' ' + Items[Index]);
1122
1123 if isShowTimes then begin
1124 Tmp := getFileplayTime( sL[Index]);
1125 canvas.Textout(Rect.left + (control as TListbox).Width - 80, Rect.top, Tmp);
1126 end;
1127
1128 if odFocused in state then canvas.DrawFocusRect(rect);
1129 end;
1130
1131 if ViewVerticalBar then begin
1132 with (control as TListbox) do begin
1133 MaxWidth := 0;
1134 for i := 0 to Items.Count - 1 do
1135 if MaxWidth < Canvas.TextWidth(Items.Strings[i]) then
1136 MaxWidth := Canvas.TextWidth(Items.Strings[i]);
1137 SendMessage(Handle, LB_SETHORIZONTALEXTENT, MaxWidth+100, 0);
1138 end;
1139 end;
1140 end;
1141
1142 //interne Funktion
1143 function GetFilePlayTime(Song:string):string;
1144 var Tmp :string; MilliSec : Integer; FloatPos : FLOAT;
1145 SongLen : integer; dChannel :DWORD;
1146 begin
1147 if Song = '' then Exit;
1148 BASS_Init(1, 44100, 0, Application.Handle, nil);
1149 BASS_Start;
1150 dChannel := BASS_StreamCreateFile(FALSE, PChar(Song), 0, 0, 0);
1151 SongLen := BASS_StreamGetLength(dChannel);
1152 FloatPos := BASS_ChannelBytes2Seconds(dChannel, SongLen);
1153 BASS_StreamFree(dChannel);
1154
1155 MilliSec := Trunc(1000 * FloatPos);
1156 if MilliSec < 0 then MilliSec := 0;
1157 Tmp := FormatDateTime ('hh:nn:ss', MilliSec / (1000 * 24 * 60 * 60));
1158 result := Tmp;
1159 end;
1160 end.
1161
1162
1163
1164 //baTools.pas
1165 unit baTools; //25.06.04
1166
1167 interface
1168 uses
1169 Bass,Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
1170 Dialogs, ExtCtrls, ComCtrls, acrString, acrInIFile, InIFiles, Slider,
1171 baSong, VrLcd, StdCtrls;
1172
1173
1174
1175 type TPlayerStatus = (psStop, psPause, psPlay, psStill, psEndOfSong);
1176
1177 TFFTData = array [0..512] of Single;
1178 TWaveData = array [ 0..2048] of DWORD;
1179
1180 type TSpulRichtung = (srBack,srNext);
1181
1182
1183 //-------------------------------------------------
1184
1185
1186 procedure toBalance(Channel:DWORD;SliderPos:integer);
1187
1188 procedure toDisplyedTimesInitZero(PlayedTime,TotalTime,RestTime:TVrClock);
1189 procedure toDisplyedTimes(PlayedTime,TotalTime,RestTime:TVrClock; chn:DWord);
1190
1191 procedure toFadeInOut(Fade:boolean;FadeTime,DevVolume:single;chn:DWord);
1192 function toFFTData(aChannel:DWORD) : TFFTData;
1193
1194 procedure toGetVULevelLr(Channel:DWORD;var R, L : Integer);
1195 function toGetVolume : integer;
1196 procedure toGetHintOnMouseMove(QellCon:TControl;StB:TStatusbar;PanNr:integer);
1197
1198 function toPlayerStatus(Channel:DWORD):TPlayerStatus;
1199 function toPlayerStatusAsString(Channel:DWORD):string;
1200
1201 procedure toSpulen(aChannel:DWord;Richtung:TSpulRichtung;Step:DWord);
1202 procedure toSetMainVolume(Vol: Integer);
1203 function toSetPlaypositonAtMousePos(cH :DWord;x:integer;cCon:TControl):integer;
1204 function toSetVolAtMousePos(ch:DWord;X:integer;cCon:TControl):integer;
1205
1206 function toSongNumber(LBox:TListBox):string;
1207
1208 function toWaveData(aChannel:DWord) : TWaveData;
1209
1210 //------------
1211 var Ch :DWord;
1212 NullWave : TWaveData;
1213
1214
1215
1216 implementation
1217 //------------------------------------------------------------------------------
1218 //------------------------------------------------------------------------------
1219 //------------------------------------------------------------------------------
1220 //------------------------------------------------------------------------------
1221 //------------------------------------------------------------------------------
1222 //------------------------------------------------------------------------------
1223 //...den Channel "aChannel" um "Step" Position spulen,
1224 // mit der Richtung "Richtung"
1225 // "Richtung" kann auf srBack oder srNext gesetzt werden.
1226 procedure toSpulen(aChannel:DWord;Richtung:TSpulRichtung;Step:DWord);
1227 var X,P : int64;
1228 begin
1229 if (Step <=0) then Step := 1;
1230 P := Step * 100000;
1231 case Richtung of
1232 srBack : begin
1233 X := Bass_ChannelGetPosition(aChannel) - P;
1234 Bass_ChannelSetPosition(aChannel, X);
1235 end;
1236 srNext : begin
1237 X := Bass_ChannelGetPosition(aChannel) + P;
1238 Bass_ChannelSetPosition(aChannel, X);
1239 end;
1240 end;
1241 end;
1242 //------------------------------------------------------------------------------
1243 //...automatisches ein u. ausblenden eines Songs
1244 // Vorbereitung im onFormCreate z.b mit
1245 // FadeTime := 5000;
1246 // Fade := true;
1247 // if Fade then DevVolume := 100;
1248 // if not Fade then DevVolume := 0;
1249 // u. im OnTimerEvent eines Timers der Aufruf mit
1250 // toFadeInOut(Fade,FadeTime,DevVolume,CH);
1251 //
1252 procedure toFadeInOut(Fade:boolean;FadeTime,DevVolume:single;chn:DWord);
1253 begin
1254 if (Fade ) and (soSongLen(chn) - soSongPos(chn) < FadeTime) then
1255 DevVolume := 100 * ((soSongLen(chn) - soSongPos(chn)) / FadeTime);
1256
1257 if (Fade) and (soSongPos(chn) < FadeTime) then
1258 DevVolume := 100 * (soSongPos(chn) / FadeTime);
1259
1260 if DevVolume > 100 then DevVolume := 100;
1261 if DevVolume < 0 then DevVolume := 0;
1262
1263 BASS_ChannelSetAttributes(chn, -1, Trunc(DevVolume), -1);
1264 end;
1265 //------------------------------------------------------------------------------
1266 //...liefert den aktuell selectierten Index eines Songs
1267 // in einer ListBox als formatierten string zurück.
1268 // in der Form : " 1 von 199"
1269 function toSongNumber(LBox:TListBox):string;
1270 begin
1271 if LBox <> nil then begin
1272 result := intToStr(1 + LBox.ItemIndex)+' von '+ intToStr(LBox.Items.Count);
1273 end else result := '0 von 0';
1274 end;
1275 //------------------------------------------------------------------------------
1276 //...initialisiert die Zeitanzeigen von ( PlayTime, Total, Rest ) mit 0
1277 // Die Controls "PlayedTime" "TotalTime" "RestTime" vom Type TVrClock.
1278 // siehe auch "toDisplyedTimes"
1279 procedure toDisplyedTimesInitZero(PlayedTime,TotalTime,RestTime:TVrClock);
1280 begin
1281 PlayedTime.Hours := 0;
1282 PlayedTime.Minutes := 0;
1283 PlayedTime.Seconds := 0;
1284 TotalTime.Hours := 0;
1285 TotalTime.Minutes := 0;
1286 TotalTime.Seconds := 0;
1287 RestTime.Hours := 0;
1288 RestTime.Minutes := 0;
1289 RestTime.Seconds := 0;
1290 end;
1291 //------------------------------------------------------------------------------
1292 //...zeigt die Zeiten ( PlayTime, Total, Rest ) in den Controls
1293 // "PlayedTime" "TotalTime" "RestTime" vom Type TVrClock an
1294 procedure toDisplyedTimes(PlayedTime,TotalTime,RestTime:TVrClock; chn:DWord);
1295 var Min,Sec,Min1,Sec1,Min2,Sec2 :integer;
1296 begin
1297 PlayedTime.ShowSeconds := true;
1298 TotalTime.ShowSeconds := true;
1299 RestTime.ShowSeconds := true;
1300
1301 soPosMinSec(Min,Sec,chn);
1302 PlayedTime.Hours := soHourAtPos(chn);
1303 PlayedTime.Minutes := Min;
1304 PlayedTime.Seconds := Sec;
1305 //--------------------------------
1306 soSongLenMinSec(Min1,Sec1,chn);
1307 TotalTime.Hours := soSongHour(chn);
1308 TotalTime.Minutes := Min1;
1309 TotalTime.Seconds := Sec1;
1310 //-------------------------------
1311 if soHourAtPos(chn) <=0 then
1312 RestTime.Hours := soSongHour(chn)
1313 else RestTime.Hours := 0;
1314
1315 soRestPosMinSec(Min2,Sec2,chn);
1316 RestTime.Minutes := Min2;
1317 RestTime.Seconds := Sec2;
1318 end;
1319 //------------------------------------------------------------------------------
1320 //...liefert das Hint von "QellCon" an die Statusbar "StB" in das
1321 // Panel "PanNr" zurück. "QellCon" ist ein beliebiges Control,
1322 // natürlich muß die Eigenschaft Hint von "QellCon" auch belegt sein.
1323 procedure toGetHintOnMouseMove(QellCon:TControl;StB:TStatusbar;PanNr:integer);
1324 begin
1325 if (QellCon <> nil) and (StB <> nil) then
1326 StB.Panels[PanNr].Text := QellCon.Hint
1327 else begin
1328 if (StB <> nil) then StB.Panels[PanNr].Text :=' ';
1329 end;
1330
1331 end;
1332 //------------------------------------------------------------------------------
1333 //...wird die Mause über das Control "cCon" gezogen, wird die Lautstärke
1334 // auf die Position der Mause gesetzt.
1335 function toSetVolAtMousePos(ch:DWord;X:integer;cCon:TControl):integer;
1336 var Vol :integer;
1337 begin
1338 if cCon = nil then Exit;
1339 if X > cCon.Width - 5 then X := cCon.Width;
1340 Vol := Trunc (100 * X / cCon.Width);
1341 toSetMainVolume(Vol);
1342 result := Vol;
1343 end;
1344 //------------------------------------------------------------------------------
1345 //...wird die Mause über das Control "cCon" geschoben, wird die
1346 // Playposition auf die Position des MauseCursor gesetzt.
1347 // Verwendung im OnMauseMove_Event von "cCon". "cH" ist der
1348 // active Channel
1349 function toSetPlaypositonAtMousePos(cH :DWord;x:integer;cCon:TControl):integer;
1350 var pPos :integer;
1351 begin
1352 if cCon = nil then Exit;
1353 pPos := (Trunc (soSongLen(Ch) * X / cCon.Width));
1354 soSetPlayPosition(cH,pPos);
1355 result := pPos;
1356 end;
1357 //------------------------------------------------------------------------------
1358 //...liefert die Pegel für den linken u. rechten Kanal in
1359 // "R" für rechts u. in "L" für links zurück.
1360 procedure toGetVULevelLr(Channel:DWORD;var R, L : Integer);
1361 var VUCH : DWORD;
1362 begin
1363 VUCH := BASS_ChannelGetLevel(Channel);
1364 L := LOWORD(VUCH);
1365 R := HIWORD(VUCH);
1366 end;
1367 //------------------------------------------------------------------------------
1368 //...setzt die Balance des aktiven Channels, "SliderPos" ist der
1369 // Wert der mit einem beliebigen Slider, TrackBar usw.
1370 // eingestell werden kann.
1371 procedure toBalance(Channel:DWORD;SliderPos:integer);
1372 var
1373 freq, volume: Integer; time: DWORD;
1374 begin
1375 freq :=-1;
1376 volume :=100;
1377 Time :=0;
1378 BASS_ChannelSlideAttributes(Channel,Freq, volume, SliderPos,Time);
1379 end;
1380 //------------------------------------------------------------------------------
1381 //...liefert die WaveDatas für den aktive Channel zurück.
1382 function toWaveData(aChannel:DWord) : TWaveData;
1383 var BuffLen : Integer; WaveData : TWaveData;
1384 begin
1385 BuffLen := 2048;
1386 if BASS_ChannelIsActive(aChannel) <> BASS_ACTIVE_PLAYING then begin
1387 Result := NullWave;
1388 end else begin
1389 BASS_ChannelGetData(aChannel, @WaveData, BuffLen);
1390 result := WaveData;
1391 end;
1392 end;
1393 //------------------------------------------------------------------------------
1394 //...liefert die FFTDatas des aktive Channels zurück.
1395 function toFFTData(aChannel:DWORD) : TFFTData;
1396 var FFTData ,NullFFT: TFFTData;
1397 begin
1398 if BASS_ChannelIsActive(aChannel) <> BASS_ACTIVE_PLAYING then Result := NullFFT
1399 else begin
1400 BASS_ChannelGetData(aChannel, @FFTData, BASS_DATA_FFT1024);
1401 result := FFTData;
1402 end;
1403 end;
1404
1405 //------------------------------------------------------------------------------
1406 //...liefert den Playerstatus als String zurück.
1407 function toPlayerStatusAsString(Channel:DWORD):string;
1408 begin
1409 result :='';
1410 if BASS_ChannelIsActive(Channel) = BASS_ACTIVE_STOPPED then result :='Stop'; //0
1411 if BASS_ChannelIsActive(Channel) = BASS_ACTIVE_PLAYING then result :='Play'; //1
1412 if BASS_ChannelIsActive(Channel) = BASS_ACTIVE_STALLED then result :='Standby'; //2
1413 if BASS_ChannelIsActive(Channel) = BASS_ACTIVE_PAUSED then result :='Pause'; //3
1414 end;
1415 //------------------------------------------------------------------------------
1416 //...liefert den Playerstatus zurück.
1417 function toPlayerStatus(Channel:DWORD):TPlayerStatus;
1418 begin //return values 0 = stop, 1 = play ,2 = stalled ,3 = paused
1419 //TPlayerStatus = (psStop, psPause, psPlay, psStill, psNotReady);
1420 if soSongOfEnd(Channel) then begin
1421 result := psEndOfSong;
1422 Exit;
1423 end;
1424
1425
1426 case BASS_ChannelIsActive(Channel) of
1427 0: begin result := psStop; end; //0
1428 1: begin result := psPlay; end; //1
1429 2: begin result := psStill; end; //2
1430 3: begin result := psPause; end; //3
1431 end;
1432 end;
1433
1434 //------------------------------------------------------------------------------
1435 //...liefert die aktuelle Lautstärke zurück.
1436 function toGetVolume : integer;
1437 begin
1438 result := Bass_GetVolume;
1439 end;
1440 //------------------------------------------------------------------------------
1441 //...setzt die mit "Vol" übergebene Lautstärke
1442 // 100 = Vollelautstärke, 20 = 20%, 10 = 10% usw.
1443 procedure toSetMainVolume (Vol : Integer);
1444 begin
1445 BASS_SetVolume(Vol);
1446 end;
1447
1448
1449 end.
1450