main.pas

一个delphi制作的mp3播放器！

   //本程序包含了Delphi编程过程中的许多函数和Windows API函数,    
   //多媒体等,这是我一年多来的编程技巧总结
   //在此,我要感谢我的Delphi启蒙老师蒋宏晖老师及所有帮助过我的老师和同学!
   //注：需要安装 BmpShape控件
unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,shellAPi, ExtCtrls, StdCtrls, ComCtrls, MPlayer, Menus,
  OleCtrls,Buttons, Grids,FileCtrl,StrUtils, ExtDlgs,jpeg, ValEdit,DateUtils,Registry,Math,
  BmpShape;
const
  PlayState:array[Tmpmodes] of string=('NotReady','Stop',
      'Play','Record','Seek','Pause','opne');//方便表示播放器的Mode属性而设
type
  TId3Rec=packed record
     tag:array[0..2] of char;
     Title,Artist,Album:array[0..29] of char;
     Year:array[0..3] of  char;
     Comment:array[0..29] of char;
     Genre:byte;
   end;
  TimeStr=String[10];
  DropEnum=(Form,LbName1,MoreFilNameLb1);// 得到鼠标的位置
  PlayTimesEnum=(two,four,half,quarter);//播放倍数
  TForm1=class(TForm)
    Picture:TBmpShape;
    PauseSign: TImage;
    DoagainPicture: TImage;
    AgainSign: TLabel;
    AutoPlay: TImage;
    BarIm: TImage;
    DotIm: TImage;
    Label1: TLabel;
    ImageFrom: TImage;
    LbRun: TLabel;
    PlaySbt: TSpeedButton;
    Pre: TSpeedButton;
    Open: TSpeedButton;
    StopSdb: TSpeedButton;
    OPCDDoor: TSpeedButton;
    Nex: TSpeedButton;
    MaxVolIm: TImage;
    VolIncIm: TImage;
    PlayListSdb: TSpeedButton;
    FormExit: TSpeedButton;
    Formmin: TSpeedButton;
    DoAgain: TImage;
    Screen: TImage;
    MediaPlayer1: TMediaPlayer;
    OpenDialog1: TOpenDialog;
    LbRunTimer: TTimer;
    AgainTimer: TTimer;
    AutoTimer: TTimer;
    ShowTime: TTimer;
    DotTim: TTimer;
    PopupMenu1: TPopupMenu;
    PlayOrPau: TMenuItem;
    StepPop: TMenuItem;
    BackPop: TMenuItem;
    ChangeScr: TMenuItem;
    LockScr: TMenuItem;
    HideVideo: TMenuItem;
    FulScrPop: TMenuItem;
    PreP: TMenuItem;
    NextP: TMenuItem;
    AgainPlay: TMenuItem;
    Ctrle1: TMenuItem;
    ChanLan: TMenuItem;
    LeftSound: TMenuItem;
    RightSound: TMenuItem;
    Stereo: TMenuItem;
    OpenSoundWin: TMenuItem;
    OpenHelp: TMenuItem;
    ToMainForm: TMenuItem;
    OPenCdPop: TMenuItem;
    ExitPlay: TMenuItem;
    N1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure LbRunTimerTimer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure PauseClick();
    procedure PauseSignClick(Sender: TObject);
    procedure FormNoralClick(Sender: TObject);
    procedure ScreenClick(Sender: TObject);
    procedure FormExitClick(Sender: TObject);
    procedure AgainTimerTimer(Sender: TObject);
    procedure DoAgainClick(Sender: TObject);//处理重复播放
    procedure DoagainPictureClick(Sender: TObject);
    procedure NexClick(Sender: TObject);//播放下一曲
    procedure AutoPlayClick(Sender: TObject);
    Procedure Next(sender:Tobject;NexLb:Tlistbox);
    procedure ShowTimeTimer(Sender: TObject);//静音
    procedure AutoTimerTimer(Sender: TObject);
    Procedure PlayInf(FileName:string);//显示播放 信息
    procedure StepImClick(Sender: TObject);
    procedure BackImClick(Sender: TObject);
    procedure OPCDDoorDblClick(Sender: TObject);
    procedure StepPopClick(Sender: TObject);//快进播放
    procedure BackPopClick(Sender: TObject);//后退播放
    procedure Ctrle1Click(Sender: TObject);
    procedure PictureMouseMove(Sender: TObject; Shift: TShiftState; X,y: Integer); //message Wm_dropFiles;
    procedure Button2Click(Sender: TObject);
    procedure FulScrPopClick(Sender: TObject);
    procedure NextPClick(Sender: TObject);
    Function Picture1(Name1:string):boolean;
    procedure PictureMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PictureMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DotTimTimer(Sender: TObject);
    procedure DotImMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DotImMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DotImMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure BarImDblClick(Sender: TObject);
    procedure BarImMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BarImMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BarImMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ShortCutOPenBtClick(Sender: TObject);
    procedure Label5MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure OPenMenuClick(Sender: TObject);
    procedure PlaySbtClick(Sender: TObject); //处理播放事件
    procedure FastOpenBitClick(Sender: TObject);
    procedure CtrlVolumeClick(Sender: TObject);//打开 Windows 声音窗口
    procedure LockScrClick(Sender: TObject);
    procedure ExitPlayClick(Sender: TObject);
    procedure PlayListSdbClick(Sender: TObject);
    procedure StopSdbClick(Sender: TObject);
    procedure OpenSoundWinClick(Sender: TObject);
    procedure OpenHelpClick(Sender: TObject);
    procedure ToMainFormClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure OpenClick(Sender: TObject);
    procedure StopSdbDblClick(Sender: TObject);
    procedure MaxVolImMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure  soundClick(sender:Tobject);
    procedure FormminClick(Sender: TObject);//处理是否静音
  private
    { Private declarations }
  public
     procedure DragFilePic(var messDrop:Tmessage); message Wm_dropFiles;
 end;//设置鼠标拖动窗口

  procedure VolCtrl(Pos:integer);
  Function Time(TheLength:LongInt):string;
  function SelTime(Title:string;Hint1:string):LongInt;
  Function FileFind(FileName:string):boolean;
  procedure FileId3TagInformation(TempName:string);//Title,Artist,Year,Genre,Comment:TEdit);
var
   Form1: TForm1;// deviceid:MciDeviceid
   vol:array[0..10] of LongInt;
   Volstar:dword;
   CurrentFile,SourceLen,CurrentLen:string;//CurrentFile显示当前选中的文件!
   Frame:integer;
   FlagPre,FlagNex,openMoreSign,Freq,Picx,PicY:LongINt;
   AutoStart,count1,VolStart,Wait,Times:integer;
       //PrePos,Nexpos,PrePos,curpos,Nexpos 分别标识上一曲，当前，下一曲，播放的位置  VolbarDnX
   CurPos,Foldx,Foldy,Movex,DotDownx,VolbarDnX,HaveDrag:integer;//HaveDrag:=1表示已经拖放了文件,
   OpenMore,PLayOrder,Again,Auto,doorOpen,Enter:boolean;//doorOpen标识光驱是否打开
   MovePress,VolbaPress,Fdown,TbPress,dotPress,GDragMain,PreClk:boolean; //dotPress,VolbaPress是否按调进度,声音按扭
   MousePos,DotPos,barMove:Tpoint; //PreClk=1表示按了下一曲
   DragPos:dropEnum;
   DotImPos:integer;//保存滚动条的位置
   PlayTimes:PlayTimesEnum;//播放倍数
implementation

uses playlist,mmsystem, Scren,FulScreen,ShlObj, poperty1;//,TFlatTitlebarUnit;//;, Main;

{$R *.dfm}

procedure SetVolume(VolVal:word);
var
  wave:string;
begin
     Wave:='$'+IntToHex(VolVal,4)+IntToHex(VolVal,4);
     WaveOutSetVolume(0,StrToInt(Wave));// auxSetVolume(0,StrToInt(Wave));
end;

procedure  TForm1.soundClick(sender:Tobject);
var
  wave:string;
begin
    if VolStart<>0 then
         begin
              VolStart:=0;//VolStart用来表示VolCtrl的position
              VolIncIm.Width:=0;
         end
    Else
        begin
             VolStart:=20;
             VolIncIm.Width:=20;;
        end;     
    Wave:='$'+IntToHex(VolStart,4)+IntToHex(VolStart,4);
    WaveOutSetVolume(0,StrToInt(Wave));
end;    
procedure FileId3TagInformation(TempName:string);//Title,Artist,Year,Genre,Comment:TEdit);
var
  Id3:TId3rec;
  Fmp3:TFilestream;
  f:File of byte;
  size:longint;
  i:integer;
  bytAll:array[0..127] of byte;
begin
   AssignFile(f,TempName);
   fileMode:=fmOpenRead;//值为 0 只读
   Reset(f);
   Form3.caption:=IntTostr(FileGetAttr(TempName));
   size:=FileSize(f);
   try  // $80是表示十六进制数 caption:='Filepos当前位置:'+IntTostr(Filepos(f));
     seek(f,size-128);
     for i:=0 to $7f do
         read(f,bytAll[i]);//  不要加 not  必须加 () and ()
    with form6 do
    begin
     if ((bytAll[0]<>ord('T')) and (bytAll[1]<>ord('A')) and  (bytAll[2]<>ord('G'))) then
        begin
           FileNameEd.Text:=GetFileName(TempName);
           ArtistEd.clear;
           GenreEd.clear;
           FileSizeEd.clear;
        end
     else
       begin
          move(BytAll,Id3,$80);//从 BytAll复制到Id3
          if ord(Id3.Title[0])<>32 then //注意是单个字符Id3.Title[0]比较,而不是Id3.Title<>' '
             FileNameEd.Text:=Id3.Title
          else
             FileNameEd.Text:=GetFileName(TempName);
          ArtistEd.Text:=Id3.Artist;
          GenreEd.Text:=Id3.Album;
       end;
      FileSizeEd.Text:=SizeFile(TempName);
      FilePathEd.Text:=TempName;
      Form6.show;
   end;
    except
      exit;
   end;
   closefile(f);//注意这条语句与reset 成对使用
end;
procedure VolCtrl(Pos:Integer);
begin
   
 end;
function SelTime(Title:string;Hint1:string):LongInt;
var
    HourMin:TimeStr;
    Hour,Min,Sec,SelectTime:LongInt;
begin
    SelectTime:=0;
    HourMin:=Inputbox(Title,Hint1+'总长为:'+Time(Form1.Mediaplayer1.Length),'00:00:00');
    if HourMin<>'00:00:00' then
          begin
             Hour:=StrToInt(HourMin[1]+HourMin[2]);
             Min:=StrToInt(HourMin[4]+HourMin[5]);
             Sec:=StrToInt(HourMin[7]+HourMin[8]);
             SelectTime:=Hour*3600000+Min*60000+Sec*1000;
          end;
    result:=SelectTime;
end;

Function TForm1.Picture1(Name1:string):boolean; //判断是否为有图像文件
var
   Result1:boolean;
   FileStream:TFileStream;
   F:file of byte;
begin
try
    //FileStream:=TFilestream.create(Name1,fmOpenread or fmShareDenyNone);
    Assignfile(f,Name1);//用这种方法占用内存少一些
    filemode:=fmopenread;
    reset(f); //
    if filesize(f)<9*1024*1024 then//若文件大小大于为 9 兆，则视为视频文件处理
       begin
           Result:=False;
           Form2.Visible:=Result;// 注意此语句的巧用
       end
    Else
        begin
           Result:=True;
           HideVideo.Enabled:=result; //隐藏视频窗口 , 注意此语句的巧用
           if HideVideo.Checked then
              form2.Hide
           else
           begin
              Form2.WindowState:=wsNormal; //要注意这条语句的使用
              Form2.show;
           end;
        end;
    {FileStream.Destroy;//注意别少了释放内存的语句 }
    FulScrPop.Enabled:=result;//全屏/窗口之间切换
    ChangeScr.Enabled:=result;//锁定画面比例 是否可用
finally
   closeFIle(f);//断开连接
 end;  
end;

function changeName(Name:string):string;
begin
    //a:=ExtractFilename(Name);
    {b:=ExtractFileExt(Name);
    i:=pos(b,a); var   I:integer;
    delete(a,i,length(b));}
    result:=ExtractFilename(Name);
end;

Function Time(TheLength:LongInt):string;//把文件长度转化为时间
var
  minute,second:Longint;
  L:string;
begin
     Form1.MediaPlayer1.TimeFormat:=tfmilliseconds;
     minute :=thelength mod 3600000;
     second:=minute mod 60000;
     L :=Inttostr(thelength div 3600000)+ ':';
     L :=L +Inttostr(minute div 60000) +':';
     if second mod 1000 >=500 then
        second:=(second div 1000)+1
     else
        second:=second div 1000;
     L := L +IntToStr(second);
     result:=l;
end;
Procedure Tform1.PlayInf(FileName:string);
begin
   Times:=0;
   Doagain.Visible:=True;
   MediaPlayer1.TimeFormat:=tfMilliseconds;
   LbRun.Caption:=ExtractFileName(FileName);
   if not (Label1.Visible and LbRun.Visible) then//显示时间的Label
      begin
         Label1.Visible:=True;
         LbRun.Visible:=true;
      end;
   ShowTime.Enabled:=True;
   LbRunTimer.Enabled:=True;
   DoAgain.Enabled:=True;//设置重复功能可用
   Application.hint:='渐美播放器'+'(当前播放:'+Mediaplayer1.FileName+')';
end;
Procedure TForm1.Next(sender:Tobject;NexLb:Tlistbox);
var
   ItemRect:Trect;
begin
try
  if NexLb.Items.Count=0  then
          begin  //显示相关信息
             if NexLb.Name='Lbname' then
                showmessage('"所有音乐" 列表中无文件!')