and can you give me your project to fix??? to throw the code project fully written by me only corrected you!? please please!
So I fixed about what you said!
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Windows,SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls, ComCtrls, bass, types;
type
{ TForm1 }
TForm1 = class(TForm)
bPlay: TButton;
bPrev: TButton;
bNext: TButton;
bStop: TButton;
eRepeatCount: TEdit;
lbl1: TLabel;
lblCurRepeat: TLabel;
lst1: TListBox;
udRepeatCount: TUpDown;
procedure bNextClick(Sender: TObject);
procedure bPlayClick(Sender: TObject);
procedure bPrevClick(Sender: TObject);
procedure bStopClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure lst1DblClick(Sender: TObject);
procedure lst1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
State: TOwnerDrawState);
procedure udRepeatCountChangingEx(Sender: TObject;
var AllowChange: Boolean; NewValue: Integer; Direction: TUpDownDirection
);
private
FStream:HSTREAM;
FRepeatCount:integer;
FCurRepeat:integer;
FCurTrack:integer;
function GetRepeatCount: integer;
procedure SetRepeatCount(const Value: integer);
procedure SetCurTrack(const Value: Integer);
procedure SetCurRepeat(const Value: Integer);
procedure UpdateCurRepeat;
procedure ListToListbox;
{ private declarations }
public
FList:TStringList;
function Playing:Boolean;
procedure Stop;
procedure Play;
procedure Prev;
procedure Next;
function TrackCount:integer;
property CurTrack:Integer read FCurTrack write SetCurTrack;
property RepeatCount:integer read GetRepeatCount write SetRepeatCount;
property CurRepeat:Integer read FCurRepeat write SetCurRepeat;
procedure WMChannelEnd(var Msg: TMessage);// message WM_CHANNEL_END;
{ public declarations }
end;
const
WM_CHANNEL_END = WM_USER + 101;
var
Form1: TForm1;
var
CallingForm: TForm;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.lst1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
if index=FCurTrack then
lst1.Canvas.Font.Color:=clRed
else
lst1.Canvas.Font.Color:=clWindowText;
lst1.Canvas.TextRect(Rect,rect.Left+3, rect.Top+3, lst1.items[index]);
end;
procedure TForm1.bPlayClick(Sender: TObject);
begin
play;
lst1.Invalidate;
end;
procedure TForm1.bPrevClick(Sender: TObject);
begin
Prev;
Play;
lst1.Invalidate;
end;
procedure TForm1.bStopClick(Sender: TObject);
begin
stop;
lst1.Invalidate;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
if (HIWORD(BASS_GetVersion) <> BASSVERSION) then
begin
MessageBox(0,'An incorrect version of BASS.DLL was loaded',nil,MB_ICONERROR);
Halt;
end;
if not BASS_Init(-1, 44100, 0, Handle, nil) then
raise exception.Create('Error initializing audio!');
FRepeatCount := udRepeatCount.Position;
Flist:=TStringLIST.Create;
Flist.Add('Track1.mp3');
Flist.Add('Track2.mp3');
Flist.Add('Track3.mp3');
ListToListbox();
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FList.Free;
bass_free;
end;
procedure TForm1.lst1DblClick(Sender: TObject);
begin
if lst1.ItemIndex<>-1 then
CurTrack:=lst1.ItemIndex;
end;
procedure TForm1.bNextClick(Sender: TObject);
begin
next;
Play;
lst1.Invalidate;
end;
procedure TForm1.udRepeatCountChangingEx(Sender: TObject;
var AllowChange: Boolean; NewValue: Integer; Direction: TUpDownDirection);
begin
FRepeatCount:=NewValue;
end;
function TForm1.GetRepeatCount: integer;
begin
Result := FRepeatCount;
if Result=0 then
result :=1;
end;
procedure TForm1.SetRepeatCount(const Value: integer);
begin
if udRepeatCount.Position<>value then
udRepeatCount.Position:=value;
FRepeatCount := udRepeatCount.Position;
end;
procedure TForm1.SetCurTrack(const Value: Integer);
begin
if (Value>=0)and(Value<TrackCount) then
begin
if Value<>FCurTrack then
begin
Stop;
CurRepeat:=0;
FCurTrack := Value;
end;
end;
lst1.Invalidate;
end;
procedure TForm1.SetCurRepeat(const Value: Integer);
begin
FCurRepeat := Value;
updateCurrepeat;
end;
procedure TForm1.UpdateCurRepeat;
begin
lblCurRepeat.Caption := 'Repeat now: '+inttostr(CurRepeat+1);
end;
procedure TForm1.ListToListbox;
begin
lst1.Items.Assign(FList);
end;
function TForm1.Playing: Boolean;
begin
result := BASS_ChannelIsActive(FStream)<>BASS_ACTIVE_STOPPED;
end;
procedure TForm1.Stop;
begin
if Playing then
BASS_ChannelStop(FStream);
end;
procedure EndTrackHandler(handle: HSYNC; channel, Data: DWORD; user: Pointer); stdcall;
begin
// signal callingform that the channel has ended
SendMessage(Callingform.Handle, WM_CHANNEL_END, 0, 0);
end;
{procedure EndTrackHandler(handle: HSYNC; channel, data: DWORD; user: Pointer); stdcall;
begin
Form1.CurRepeat:=Form1.CurRepeat+1;
Form1.Stop;
if Form1.CurRepeat>=Form1.RepeatCount then
Form1.Next;
if Form1.CurRepeat<Form1.RepeatCount then
Form1.play;
end; }
procedure TForm1.Play;
var s:string;
begin
UpdateCurRepeat;
s:= ExtractFilePath(ParamStr(0))+ FList[FCurTrack];
Fstream:= Bass_streamcreatefile(false, PChar(s),0,0,BASS_UNICODE or BASS_STREAM_AUTOFREE);
Callingform := Self;
BASS_ChannelSetSync(fstream, BASS_SYNC_END, 0, @EndTrackHandler, nil);
//BASS_ChannelSetSync(FStream, BASS_SYNC_END,0, @EndTrackHandler,nil);
Bass_channelplay(Fstream,false);
end;
procedure TForm1.Prev;
begin
CurTrack:=CurTrack-1;
end;
procedure TForm1.Next;
begin
CurTrack:=CurTrack+1;
end;
function TForm1.TrackCount: integer;
begin
result := Flist.Count;
end;
procedure TForm1.WMChannelEnd(var Msg: TMessage);
begin
CurRepeat := CurRepeat + 1;
Stop;
if CurRepeat >= RepeatCount then Next;
if CurRepeat < RepeatCount then play;
end;end.
Recent
