playlist.~pas

一个delphi制作的mp3播放器！

unit Playlist;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons,  MPlayer, ExtCtrls, ComCtrls, Gauges,
  Menus, ColorGrd, ActnList, Grids, DBGrids, CheckLst,mmsystem,
  jpeg, ImgList,shellapi, StdActns;

const
    TFormat:array[0..1] of  string=('dat','avi');
  type
    TForm3 = class(TForm)
    AddFileSpb: TSpeedButton;
    DelSpb: TSpeedButton;
    ClearSpb: TSpeedButton;
    LbName: TListBox;
    LbPath: TListBox;
    MoreFilPathLb: TListBox;
    ComboBox1: TComboBox;
    MoreFilNameLb: TListBox;
    ReNameed: TEdit;
    ActionList1: TActionList;
    FileSaveAs1: TFileSaveAs;
    PopupMenu1: TPopupMenu;
    PlayList: TMenuItem;
    ReName: TMenuItem;
    DelIndex: TMenuItem;
    Copy: TMenuItem;
    ScanFile: TMenuItem;
    Poperty1: TMenuItem;
    AddFilesSpb: TSpeedButton;
    AddFolderSpb: TSpeedButton;
    ShowDelSpb: TSpeedButton;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    AddFilePop: TMenuItem;
    AddFolderPop: TMenuItem;
    N2: TMenuItem;
    DelOnePop: TMenuItem;
    DelAllPop: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure LbNameDblClick(Sender: TObject);
    procedure MoreFilPathLbClick(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure LbNameMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ReNameClick(Sender: TObject);//自定义改名的
    procedure ReNameEdKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure LbNameMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure LbNameDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure ReNameEdExit(Sender: TObject);//改名
    procedure ReNameEdChange(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure Poperty1Click(Sender: TObject);
    procedure MoreFilNameLbMouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure MoreFilNameLbExit(Sender: TObject);
    procedure LbNameExit(Sender: TObject);
    procedure MoreFilNameLbClick(Sender: TObject);
    procedure DeleteDefine(LbNameDel,LbPathDel:Tlistbox);//自定义的 删除文件过程
    procedure KeyDown(LbNameKey,LbPathKey:Tlistbox;key:word;Shift: TShiftState);
    procedure LbNameKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure MoreFilNameLbKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DelSpbClick(Sender: TObject);
    procedure ClearSpbClick(Sender: TObject);
    procedure CloseSpbClick(Sender: TObject);//隐藏播放列表
    procedure AddFolderSpbClick(Sender: TObject);
    procedure AddFilePopPopup(Sender: TObject);
    procedure AddFilesSpbClick(Sender: TObject);
    procedure AddFolderDef(InsertPos1:word;DragLbName,DragLbPath:Tlistbox;FolderSel:string;msg:Tmessage);
    procedure AddFileSpbClick(Sender: TObject);
    procedure ReNameedMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure CopyClick(Sender: TObject);
    procedure SaveFile(SaveLbName,SaveLbPath:Tlistbox);
    procedure MoreFilNameLbMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);//自定义添加文件夹
    procedure ScanFileClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormResize(Sender: TObject);
    procedure ShowDelSpbClick(Sender: TObject);//浏览文件所在目录
  private  //拖动文件插入到指定的位置 InsertPos1
    moveName,MovePath,ListboxName:Tlistbox;//保存mousemove时的listbox 
  public
    //拖动文件添加处理
    procedure WmDragFile(var message:Tmessage); message Wm_dropFiles;
    procedure CanAccept(var DragMsg:tmessage);
  end;
  procedure  AddFile(TLbName,Tlbpath:Tlistbox;StartPos,Endpos:integer;var message:Tmessage);
  procedure NameClick(TName,TPath:Tlistbox); //自定义的单击过程
  procedure NameDbclick(TNameDb,TPathDb:Tlistbox);
  function GetFileName(Name:string):string;//得到文件名
  function  SizeFile(SizeFile:string):string;//计算文件大小
  //procedure AddFilesSpbClick(Sender: TObject);//添加文件
var
  Form3: TForm3;  //currentFile CursorPos,
  FilePath,OldName,NewName,MoudnFile:string;//MoudnFile标识mousedown时选择的文件
  Select,CanDrag,EdMouseDn,ClickLb,EdChange,
     MouDn,GDragLbNamLb,GDragMorFilLb:boolean;
  m,j,possel,Startx,Starty,PosPlay,HeightFrm,WidthFrm,
     OldIndex,dbclick:integer;//dbclick=1表示双击了LbName
     //HeightFrm,WidthFrm表示Form3原有的属性
  NewIndex,OldInd,MouDnIndex,gCanAccept,MouDnPos:integer;//gCanAccept表示是否拖砂动文件
  LbNameMou,MoreFilLbMou:Tpoint;//OldInd表示第一次选的ItemIndex   MouDnPos为鼠标按下时的位置
  SeaRec: TSearchRec;//拖动的是文件结构
implementation

uses main, scren,poperty1,FileCtrl,commctrl;//调用 shellexecute,selectdirectory
//分别要用 shellApi,Filectrl单元

{$R *.dfm}
function  SizeFile(SizeFile:string):string;//计算文件大小
const//得到文件的大小
  MB=1024*1024;
var
  f:FIle of byte;
begin
try
   AssignFile(f,SizeFile);
   Reset(f);
   if Filesize(f)>=MB then
      result:=Format('%.2f MB',[Filesize(f)/Mb])
   Else
      result:=Format('%.2f KB',[Filesize(f)/1024]);//输出整型数要用 'd'
except
  exit;                                                    
 end;
  closefile(f);//注意这条语句与reset 成对使用,
end;
function GetFileName(Name:string):string ;
var
  i:integer;
  FileName1,FileExt:string;
begin
    FileName1:=ExtractFilename(Name);
    FileExt:=ExtractFileExt(Name);
    i:=pos(FileExt,FileName1);//得到文件的名字
    delete(FileName1,i,length(FileExt));
    result:=FileName1;
end;

procedure  AddFile(TLbName,Tlbpath:Tlistbox;StartPos,Endpos:integer;var message:Tmessage);
var
   i:integer;
   //message:Tmessage;
   p1:array[0..254] of char;
begin
try
      For i:=startpos to  endpos do
            begin
              DragQueryFile(message.WParam,(i-startPos),p1,255);
                CurrentFile:=strPas(p1);
                if  pos(lowercase(ExtractFileExt(CurrentFile)),'.mp3.wav.asf.dat.avi.wma.mid.')>0 then
                    if  TLbName.Items.Count=0  then
                        begin
                           TLbName.Items.Add(GetFileName(currentFile));
                           TLbPath.Items.add(currentFile);
                        end
                    Else
                        if (TLbPath.Items.IndexOf(CurrentFile)=-1) then
                            begin
                               TLbName.Items.Insert(i,GetFileName(CurrentFile));
                               TLbPath.Items.Insert(i,currentFile);
                            end;
            end;
except
  exit;
 end;
end;

procedure TForm3.CanAccept(var DragMsg:tmessage);
var
  DragFileNum,i:word;
  p:pchar;
begin
   if DragMsg.Msg<>wm_dropFiles then Exit;
    DragFileNum:=DragQueryFile(DragMsg.WParam,$fffffff,nil,0);
    for i:=0 to DragFileNum do
       begin
            DragQueryFile(DragMsg.WParam,i,p,0);
            strpas(p);
            if pos(lowercase(ExtractFileExt(p)),'.mp3.wav.asf.dat.avi.wma.mid')>0 then
                begin
                    dragAcceptFiles(form3.Lbname.Handle,true);//gCanAccept:=1;
                    dragAcceptFiles(Form3.MoreFilNameLb.Handle,true);
                end;
       end;

end;
//自定义的 删除指定文件过程
procedure TForm3.DeleteDefine(LbNameDel,LbPathDel:Tlistbox);//
var
  LbPathIndex:integer;//保存所选的项,注意 ItemIndex 是时刻变化的
begin
try
  if Lbnamedel.ItemIndex<>-1 then
     begin
         lbPathIndex:=LbnameDel.ItemIndex;//
         LbNameDel.Items.delete(LbnameDel.ItemIndex);
         LbPathDel.Items.Delete(LbPathIndex);
         if lbPathIndex<LbNameDel.Items.Count then//判断所选的项是否为末项
             LbNameDel.Selected[lbPathIndex+1]:=True;//注意此处不能用 ItemIndex=-1
     end;
except
    Exit;
  end;
end;

procedure TForm3.WmDragFile(var message:Tmessage);
var
    FileNum,insertPos:word;
    p:array[0..254] of char;
    Sender:Tobject;
    dragFile:string;
    i:integer;
    DragLbName1,DragLbPath1:Tlistbox;//为拖放文件时用
begin
     inherited;
     if message.Msg=wm_dropfiles then
        begin
            if Dragpos=LbName1 then
                begin
                   //LbName.hint:='托放文件添加到鼠标所在位置';
                   DragLbName1:=Form3.LbName;
                   DragLbPath1:=Form3.LbPath; //显示"所有音乐"的列表';取得鼠标所在的Item
                end
             else
                begin
                   //MoreFilNameLb.hint:='托放文件添加到鼠标所在位置';
                   DragLbName1:=Form3.MoreFilNameLb;
                   DragLbPath1:=Form3.MoreFilPathLb;
                   if Combobox1.ItemIndex<>0 then//显示'正在播放'的列表
                      begin
                         Combobox1.ItemIndex:=0;
                         Form3.ComboBox1Change(sender);//显示相应的播放列表
                      end;   
                end;
          DragQueryFile(message.WParam,0,p,255);
          dragFile:=strpas(p);
          InsertPos:=DragLbName1.ItemAtPos(MoreFilLbMou,False);
          FileNum:=DragQueryFile(message.WParam,$FFFFFFFF,nil,0);
          for i:=0 to FileNum-1 do//注意for 语句 变量的初始值为0
            begin
               DragQueryFile(message.WParam,i,p,255);
               dragFile:=strpas(p);// 用 DirectoryExists 比FileGetAttr 更保险
               if not DirectoryExists(dragFile) then//   then//判断是否为文件夹
                  begin //是文件则添加
                     if pos(lowercase(ExtractFileExt(dragFile)),'*.*.mp1.mp2.mp3.au.wav.asf.dat.avi.wma.mid.wmv.rmi')>=4 then
                         begin//注意pos 函数后半部分的控制,当为 '.mp3.wav'时，返回值为1,未找到则为 0
                            DragLbPath1.Items.Insert(InsertPos,dragFile);
                            DragLbName1.Items.Insert(InsertPos,GetFileName(dragFile));//得到文件名
                         end;
                  end// 结束添加文件
               else // 添加文件夹
                  AddFolderDef(InsertPos,DragLbName1,DragLbPath1,dragFile,message);
            end;//结束 for语句
          if Form1.MediaPlayer1.Mode<>mpplaying  then//如果不是正在播放,则开始播放
             begin
                HaveDrag:=1;
                currentFile:=DragLbPath1.Items.Strings[InsertPos];//播放添加的第一个文件  dragFIle可能是目录
                Form1.PlaySbtClick(Sender);
             end;
          end;
     Form3.Show;     
end;

procedure NameDbclick(TNameDb,TPathDb:Tlistbox);
begin
try
    DbClick:=1;//双击了LbName
    //NameClick(TNameDb,TPathDb);避免反应速度太慢
    CurrentFile:=TPathDb.Items.Strings[TNameDb.ItemIndex];
    With Form1 do
     begin
         if FileFind(CurrentFile) then //判断文件是否存在
             begin
                 MediaPlayer1.FileName:=CurrentFile;
                 MediaPlayer1.Open;
                 Form1.Picture1(currentFile);
                 mediaPlayer1.Play;
                 playInf(currentFile);
                 Curpos:=TNameDb.ItemIndex;
              end;
     end;
Except
   begin
       showmessage('不能播放此格式!');
        Exit;
   end;
end;
end;

procedure TForm3.FormCreate(Sender: TObject);
var