Index » Empathy Jukebox : Blob 78c4ab / burn.pas
unit burn;

interface

uses
  windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,ComCtrls,comobj,Buttons, ExtCtrls, Gauges,Loadjpegorbmp,printers,audiocdburnxp,global;

type
  Tburncd = class(TForm)
    Panel1: TPanel;
    dplaylist: TListBox;
    dtracklist: TListBox;
    createcd: TButton;
    Button2: TButton;
    Dalbumlist: TComboBox;
    Label1: TLabel;
    tlength: TLabel;
    tcountlabel: TLabel;
    Label2: TLabel;
    tracks: TLabel;
    Shape1: TShape;
    cover: TImage;
    printjewelbut: TButton;
    progresspanel: TPanel;
    cancel: TButton;
    ProgressBar: TProgressBar;
    cancellabel: TLabel;
    Tremaininglabel: TLabel;
    capacity: TComboBox;
    Add: TButton;
    del: TButton;
    clear: TButton;
    procedure Button2Click(Sender: TObject);
    procedure DalbumlistChange(Sender: TObject);
    procedure dtracklistClick(Sender: TObject);
    procedure AddClick(Sender: TObject);
    procedure DelClick(Sender: TObject);
    procedure maketitles(albumindex : integer);
    function loadtitles(sender : TListbox; albumindex : integer) : boolean;
    procedure FormActivate(Sender: TObject);
    procedure dplaylistClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure createcdClick(Sender: TObject);
    procedure printjewelbutClick(Sender: TObject);
    procedure dtracklistDblClick(Sender: TObject);
    procedure cancelClick(Sender: TObject);
    procedure clearClick(Sender: TObject);
    procedure capacityChange(Sender: TObject);
    procedure writedisk;

  private
    { Private declarations }
  public
    { Public declarations }
  end;

  procedure extractalbumartist(st : string; var album : string; var artist : string);

var
  burncd: Tburncd;
  cdtitler : string;
  cancelop : boolean;
  total : integer;


implementation
uses main,filectrl;

var
  dcurrenttrack: integer;
  dcurrentalbumpath : string;
  tcount : integer;
  dPlayListMatrixTrk : PlayListMatrixTrk;
  dPlayListMatrixAlb : PlayListMatrixAlb;
  dPlayListMatrixAlbNumber : PlayListMatrixAlbNumber;



{$R *.DFM}


function checkforfiles(path : string) : integer;
var
searchrec : tsearchrec;
res : integer;
r : integer;
begin
result:=0;
res:=FindFirst(path+'\*.*', (faanyfile xor fadirectory), searchrec);
if res=0 then begin
           r:=messagedlg('The output folder contains files. Do you want to delete these files before proceeding?',mtConfirmation,[MbYes,MbNo,MbCancel],0);
           result:=0;
           if r=MrNo then exit;
           result:=-1;
           if r=MrCancel then exit;
           result:=0;
           if r=MrYes then r:=messagedlg('All files will be permentantly deleted. Are you really sure you want to do this?',mtWarning,[MbYes,MbNo],0);
           if r=MrNo then begin; result:=-1;exit;end;
           while res=0 do begin
           deletefile(path+'\'+searchrec.name);
           res:=FindNext(searchrec);
           end;
 end;
end;





procedure extractalbumartist(st : string; var album : string; var artist : string);
var
n : integer;
stat : integer;
s : string;
begin
s:=extractfilepath(st);
st:=copy(st,length(s)+1,length(st)-length(s)+1);
n:=1;
album:='';
artist:='';
stat:=0;
while (n<length(st)+1) do begin
if st[n]='_' then begin;stat:=stat+1;end;

if (stat<2) and (st[n]<>'_') then artist:=artist+st[n];
if (stat=2) and (st[n]<>'_') then album:=album+st[n];



inc(n);
end;
end;


procedure printjewel;
var
n : integer;
pixpercmX : real;
pixpercmY : real;
top,left,bottom,right : integer;
adraw : tpoint;
starty,startx : integer;
artist, album : string;
dtot : integer;

begin
pixpercmX := GetDeviceCaps(printer.Handle, LOGPIXELSX);
pixpercmY := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
top:=0;
left:=0;
pixpercmX:=pixpercmX / 2.54;
pixpercmY:=pixpercmY / 2.54;
right:=round(12.1*pixpercmX);
bottom:=round(12*pixpercmY);

printer.begindoc;
adraw.x:=left;
adraw.y:=top;
printer.canvas.penpos:=adraw;
printer.canvas.lineto(round(left+pixpercmX),top);

adraw.x:=left;
adraw.y:=top;
printer.canvas.penpos:=adraw;
printer.canvas.lineto(round(left),round(top+pixpercmY));

adraw.x:=right;
adraw.y:=bottom;
printer.canvas.penpos:=adraw;
printer.canvas.lineto(round(right-pixpercmX),bottom);

adraw.x:=right;
adraw.y:=bottom;
printer.canvas.penpos:=adraw;

printer.canvas.lineto(right,round(bottom-pixpercmY));


printer.canvas.font.size:=14;
printer.canvas.font.style:=[fsbold];

starty:=round(1*pixpercmY);
startx:=round(3*pixpercmX);

printer.canvas.textout( startx,starty,cdtitler);

printer.canvas.font.size:=6;
printer.canvas.font.style:=[];



starty:=round(3*pixpercmY);
startx:=round(3*pixpercmX);

for n:=0 to burncd.dplaylist.Items.count-1 do begin
extractalbumartist(dplaylistMatrixAlb[n],artist,album);


dtot:=getmp3length(dplaylistMatrixAlb[n]+'\track'+format('%.2d',[dplaylistMatrixTrk[n]])+'.mp3');

printer.canvas.textout( startx,starty,inttostr(n+1)+') '+artist+' - '+album+' - '+burncd.dplaylist.items[n]+' ['+hmsdisplay(dtot)+']');
starty:=starty+printer.canvas.textheight('AA');
end;

printer.enddoc;
end;

procedure tburncd.writedisk;
var
path,dir : string;
n : integer;
fn : string;
begin

if config.cdopt=0 then begin
dir:=config.path;
if SelectDirectory(dir,[sdAllowCreate, sdPerformCreate, sdPrompt],0)=false then exit;
//selectdirectory('Select Destination Folder for MP3 files',path,path)end;
path:=dir;
end;
if config.cdopt=1 then begin
path:=GetStagingPath;
if path='' then begin
messagedlg('Could not find a path to the CD Burning staging area. You may not have the Windows XP CD writing extentions installed',mtWarning,[mbOK],0);
exit;
end;
end;





if checkforfiles(path)=-1 then exit;
cancelop:=false;
burncd.progresspanel.visible:=true;
//burncd.progress.visible:=true;
burncd.progressbar.position:=0;
burncd.progressbar.min:=0;
burncd.progressbar.max:=burncd.dplaylist.Items.count;
screen.cursor:=crHourglass;
burncd.cancellabel.caption:='Copying files to folder';
for n:=0 to burncd.dplaylist.Items.count-1 do begin
if cancelop=true then break;
application.processmessages;
fn:=path+'\track'+format('%.2d',[n+1])+'.mp3';
copyfile(pchar(dplaylistMatrixAlb[n]+'\track'+format('%.2d',[dplaylistMatrixTrk[n]])+'.mp3'),pchar(fn),false);
filesetattr(fn,faarchive);
application.processmessages;
burncd.progressbar.position:=n+1;
end;



if cancelop=true then begin
burncd.cancellabel.caption:='Operation Cancelled. Removing Files';
n:=burncd.progressbar.position;
while (n>=0) do begin
application.processmessages;
deletefile(pchar(path+'\track'+format('%.2d',[n+1])+'.mp3'));
dec(n);
if n>0 then burncd.progressbar.position:=n;
end;
screen.cursor:=crDefault;
burncd.progresspanel.visible:=false;
exit;
end;

screen.cursor:=crDefault;
burncd.progresspanel.visible:=false;


//if config.cdopt=1 then goburn;

if messagedlg('Once you have written the files to CD click "Yes" to delete the files.'+chr(13)+chr(10)+'Delete these files now?',mtWarning,[mbYes,mbNo],0)=mrYes then
begin
n:=burncd.progressbar.position;
while (n>=0) do begin
application.processmessages;
deletefile(pchar(path+'\track'+format('%.2d',[n+1])+'.mp3'));
dec(n);
if n>0 then burncd.progressbar.position:=n;
end;
end;

end;

procedure updatetime;
var
dmin,dsec,rmin,rsec : integer;
begin;
dsec:= tcount mod 60;
dmin:= tcount div 60;
rsec:= (total-tcount) mod 60;
rmin:= (total-tcount) div 60;

burncd.tcountlabel.caption:='Used: '+inttostr(dmin)+':'+format('%.2d',[dsec])+' of ';
burncd.Tremaininglabel.caption:='Remaining: ' + inttostr(rmin)+':'+format('%.2d',[rsec])+' mins.';
//burncd.progress.progress:=tcount;
burncd.tracks.caption:=inttostr(burncd.dplaylist.items.count);
if tcount>0 then  begin; burncd.createcd.enabled:=true; burncd.printjewelbut.enabled:=true; end;
if tcount>total then begin
burncd.createcd.enabled:=false;
burncd.printjewelbut.enabled:=false;
end;
end;





function tburncd.loadtitles (sender : TListbox; albumindex : integer) : boolean;
var
content : textfile;
spp : string;
begin
  AssignFile(content,config.path+album[albumindex].path+'\title.dat');
  spp:=album[albumindex].path;
  if sender=dtracklist then dcurrentalbumpath:=config.path+spp;
 try
  Reset(content);
 except;
  result:=false;
  exit;
 end;

            sender.clear;
              While (NOT EOF(content)) do begin

                   Readln (content,spp);
                  //tracklist.items.add('['+format('%.2d',[tracknm])+'] - '+spp);
                   sender.items.add(spp);
             end;
CloseFile(content);
result:=true;


end;


procedure Tburncd.Button2Click(Sender: TObject);
begin
burncd.hide;
end;


procedure tburncd.maketitles(albumindex : integer);

var
content : textfile;
searchrec : tsearchrec;
res : integer;

begin
AssignFile(content,config.path+album[albumindex].path+'\title.dat');
rewrite(content);

res:=FindFirst(config.path+album[albumindex].path+'\*.mp3', faanyfile, searchrec);
 if res=0 then begin
           while res=0 do begin
           writeln(content,'Untitled');
           res:=FindNext(searchrec);
           end;
 end;
Closefile(content);
FindClose(SearchRec);
//if messagedlg('No title information file found for '+album[albumindex].artist+' '+album[albumindex].album+'. Enter title info now?',mtConfirmation,[MbYes,MbNo],0)=MrYes then showtitleedit(albumindex);
end;


procedure TBurncd.DalbumlistChange(Sender: TObject);
var
n : integer;
spp : string;
{playlist Style}

begin
n:=dalbumlist.itemindex+1;
  spp:=album[n].path;
  dalbumlist.hint:=dalbumlist.items[dalbumlist.itemindex];
  if loadtitles(dtracklist,n)=false then begin
  maketitles(n);
  loadtitles(dtracklist,n)
  end;

  dtracklist.itemindex:=0;
  dtracklistclick(sender);
end;

procedure TBurncd.dtracklistClick(Sender: TObject);
var
tsecs,mins,secs: integer;
o : tbitmap;
begin
o:=nil;
If dtracklist.itemindex>-1 then add.enabled:=true;
If dplaylist.itemindex>-1 then begin del.enabled:=true; clear.enabled:=true; end;

   tsecs:=getmp3length (dcurrentalbumpath+'\track'+format('%.2d',[dtracklist.itemindex+1])+'.mp3');
loadjpegbmp(dcurrentalbumpath,o);
cover.picture.bitmap.assign(o);
o.free;
secs:= tsecs mod 60;
mins:= tsecs div 60;
tlength.caption:=inttostr(mins)+':'+format('%.2d',[secs]);

end;

procedure TBurncd.AddClick(Sender: TObject);
begin

if (dtracklist.itemindex>-1) then begin
if (getmp3length (dcurrentalbumpath+'\track'+format('%.2d',[dtracklist.itemindex+1])+'.mp3')+tcount)>total then begin
application.MessageBox('Not enough space left on CD-R.', 'Cannot add track',MB_ICONINFORMATION);
exit;
end;

if (getmp3length (dcurrentalbumpath+'\track'+format('%.2d',[dtracklist.itemindex+1])+'.mp3'))=0 then begin
application.MessageBox('The file is does not exist or it corrupt.', 'Cannot add track',MB_ICONINFORMATION);
exit;
end;




dplaylist.items.add (dtracklist.items[dtracklist.itemindex]);
setlength(dplaylistMatrixAlbNumber,dplaylist.items.count+1);
dplaylistMatrixAlbNumber[dcurrenttrack]:=dalbumlist.itemindex+1;
setlength(dplaylistMatrixAlb,dplaylist.items.count+1);
dplaylistMatrixAlb[dcurrenttrack]:=dcurrentalbumpath;
setlength(dplaylistMatrixTrk,dplaylist.items.count+1);
dplaylistMatrixTrk[dcurrenttrack]:=dtrackList.itemindex+1;
dcurrenttrack:=dcurrenttrack+1;
tcount:=tcount+getmp3length (dcurrentalbumpath+'\track'+format('%.2d',[dtracklist.itemindex+1])+'.mp3');
updatetime;

if (dplaylist.Items.count>0) then begin
   clear.enabled:=true;
   if (dplaylist.itemindex>-1) then begin
      del.enabled:=true;
   end;
   end;


end;



end;


procedure Tburncd.DelClick(Sender: TObject);
var
old : integer;
n : integer;
fn : string;
begin
if dplaylist.itemindex=-1 then exit;

dcurrenttrack:=dcurrenttrack-1;
old:=dplaylist.itemindex;

fn:=dplaylistMatrixAlb[old]+'\track';
fn:=fn+format('%.2d',[dplaylistMatrixTrk[old]]);
fn:=fn+'.mp3';
tcount:=tcount-getmp3length (fn);


dplaylist.Items.delete(dplaylist.itemindex);


for n:=old to dplaylist.Items.count do begin
dplaylistMatrixAlb[n]:=dplaylistMatrixAlb[n+1];
dplaylistMatrixTrk[n]:=dplaylistMatrixTrk[n+1];
end;

If dplaylist.Items.count > 0 then begin
If old<=dplaylist.Items.count-1 then dplaylist.itemindex:=old else begin
dplaylist.itemindex:=old-1;
end;
end;
if dplaylist.Items.count=0 then begin; del.enabled:=false; createcd.enabled:=false; clear.enabled:=false;printjewelbut.enabled:=false;end;
updatetime;
end;

procedure Tburncd.FormActivate(Sender: TObject);

begin
dalbumlist.items:=mainform.dalbumlist.items;
dalbumlist.itemindex:=mainform.albumlist.itemindex;
dalbumlistchange(sender);
dtracklist.itemindex:=mainform.tracklist.itemindex;
dtracklistclick(sender);
//progress.maxvalue:=total;

updatetime;
end;



procedure Tburncd.dplaylistClick(Sender: TObject);
var
fn : string;
dtot,dsec,dmin : integer;
begin
if dplaylist.itemindex>-1 then begin del.enabled:=true; clear.enabled:=true;end;
if dplaylist.itemindex=-1 then exit;
fn:=dplaylistMatrixAlb[dplaylist.itemindex]+'\track'+format('%.2d',[dplaylistMatrixTrk[dplaylist.itemindex]])+'.mp3';

dtot:= getmp3length(fn);
dsec:= dtot mod 60;
dmin:= dtot div 60;

dplaylist.hint:=fn+' - Length:'+inttostr(dmin)+':'+format('%.2d',[dsec]);
end;

procedure Tburncd.FormCreate(Sender: TObject);
begin
tcount:=0;
tracks.caption:='0';
total:=74*60;
capacity.itemindex:=0;
end;

procedure Tburncd.createcdClick(Sender: TObject);
begin
if messagedlg('Create CD.'+chr(13)+chr(10)+chr(13)+chr(10)+'Are you Sure?',mtConfirmation,[mbYes,MbNo],0)=mryes then writedisk;
end;

procedure Tburncd.printjewelbutClick(Sender: TObject);
begin
if InputQuery('Create Jewel Case Inlay','Enter title for CD Jewel Case:', cdtitler)=false then exit;
printjewel;
end;

procedure Tburncd.dtracklistDblClick(Sender: TObject);
begin
addclick(sender);
end;

procedure Tburncd.cancelClick(Sender: TObject);
begin
cancelop:=true;
end;

procedure Tburncd.clearClick(Sender: TObject);
begin
dplaylist.items.clear;
tcount:=0;
tracks.caption:='';
updatetime;
setlength(dPlayListMatrixTrk,0);
setlength(dPlayListMatrixAlb,0);
setlength(dPlayListMatrixAlbNumber,0);
dcurrenttrack:=0;
end;

procedure Tburncd.capacityChange(Sender: TObject);
begin
case capacity.itemindex of
0 : total:=74*60;
1 : total:=80*60;
2 : total:=99*60;
end;
updatetime;
//progress.maxvalue:=total;

end;

end.