main.pas

delphi2007写的播放器源码。效果类似于千千静听。

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ExtCtrls, StdCtrls,ComFunction,ComVariable,PlayList
  ,shellApi,bass{,bassvideo},circle_vis,osc_vis,spectrum_vis,video,StrUtils
  ,Lyric,EditLyric;


const
  //自定义消息，用于处理用户在图标上点击鼠标的事件
  WM_ICONMESSAGE=WM_USER+$100;


type
  TForm1 = class(TForm)
    imgPanel: TImage;
    imgPlay: TImage;
    imgPrevious: TImage;
    imgStop: TImage;
    imgNext: TImage;
    imgSpeaker: TImage;
    imgMin: TImage;
    imgExit: TImage;
    imgG_Ntrack: TImage;
    imgG_Track: TImage;
    imgG_BarPosition: TImage;
    imgV_Ntrack: TImage;
    imgV_Track: TImage;
    imgV_BarPosition: TImage;
    imgPlayList: TImage;
    imgNowTime: TImage;
    lbltime: TLabel;
    BackImage: TImage;
    PaintFrame: TPaintBox;
    imgRightSpeaker: TImage;
    imgLeftSpeaker: TImage;
    TimerRender: TTimer;
    PopupMenu1: TPopupMenu;
    Nrenew: TMenuItem;
    N8: TMenuItem;
    NskinMenu: TMenuItem;
    Visual1: TMenuItem;
    N5: TMenuItem;
    N4561: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N4: TMenuItem;
    Nexit: TMenuItem;
    Timer1: TTimer;
    imgCapture: TImage;
    SaveDialog1: TSaveDialog;
    Timer2: TTimer;
    N9: TMenuItem;
    N10: TMenuItem;
    imgTagTitle: TImage;
    Timer3: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure imgPanelMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure imgPanelMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure imgG_BarPositionMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure imgG_BarPositionMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure imgG_BarPositionMouseLeave(Sender: TObject);
    procedure imgG_BarPositionMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure imgV_BarPositionMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure imgV_BarPositionMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure imgV_BarPositionMouseLeave(Sender: TObject);
    procedure imgNextClick(Sender: TObject);
    procedure imgNextMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure imgNextMouseLeave(Sender: TObject);
    procedure imgNextMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure imgStopClick(Sender: TObject);
    procedure imgStopMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure imgStopMouseLeave(Sender: TObject);
    procedure imgStopMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure imgPreviousClick(Sender: TObject);
    procedure imgPreviousMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure imgPreviousMouseLeave(Sender: TObject);
    procedure imgPreviousMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure imgPlayListClick(Sender: TObject);
    procedure imgPlayListMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure imgPlayListMouseLeave(Sender: TObject);
    procedure imgPlayListMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure imgMinClick(Sender: TObject);
    procedure imgMinMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure imgMinMouseLeave(Sender: TObject);
    procedure imgMinMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure imgExitMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure imgExitMouseLeave(Sender: TObject);
    procedure imgExitMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure imgExitClick(Sender: TObject);
    procedure NrenewClick(Sender: TObject);
    procedure imgPlayClick(Sender: TObject);
    procedure imgPlayMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure imgPlayMouseLeave(Sender: TObject);
    procedure imgPlayMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TimerRenderTimer(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Visual1Click(Sender: TObject);
    procedure imgSpeakerClick(Sender: TObject);
    procedure imgCaptureMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure imgCaptureMouseLeave(Sender: TObject);
    procedure imgCaptureMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure imgCaptureClick(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure imgSpeakerMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure imgSpeakerMouseLeave(Sender: TObject);
    procedure Timer3Timer(Sender: TObject);
  private
    FramePos:TPoint;
    GuagePos,VolumePos:TPoint;
    lpData: PNotifyIconDataa;
    IsPause:boolean;
    IsWhisht:Boolean;
    OldVolume:float;
    source:WideString;
    TX:Integer;

    function PanleInitialization:boolean;
    procedure ResetTime;
    procedure burshTime(bmpTemp:TBitmap;X,Y:integer;Index,Num:integer);
    procedure ShowTime;
    function ShowFormat(Second:Double):string;
    procedure LoadSkinList(Sender: TObject);
    procedure LoadSkin(Sender: TObject);
    procedure WMBarIcon(var Message:TMessage);message WM_ICONMESSAGE;
    procedure IcoCreate;
    procedure IcoDestroy;
    function ReplaceFile:boolean;
    procedure TrackPeak;
    function InitializtionStream(FileName:string):Boolean;
    procedure LoadPlugins;
  public
    procedure PlayFile;
    procedure StopPlay;
  end;

var
  Form1: TForm1;
implementation

uses Visual;

{$R *.dfm}

procedure TForm1.LoadPlugins;
var
  fd: TWin32FindData;
  fh: THandle;
  plug: HPLUGIN;
  Info: ^Bass_PluginInfo;
  s: string;
  a: integer;
begin
  OpenFilter :=
    'BASS built-in (*.mp3;*.mp2;*.mp1;*.ogg;*.wav;*.aif)\0*.mp3;*.mp2;*.mp1;*.ogg;*.wav;*.aif' + '|'
    + '*.mp3;*.mp2;*.mp1;*.ogg;*.wav*;*.aif';
  OpenDirFilter:='*.mp3;*.mp2;*.mp1;*.ogg;*.wav;*.aif';
  fh := FindFirstFile(PChar(path + 'bass*.dll'), fd);
  if (fh <> INVALID_HANDLE_VALUE) then
  try
    repeat
      plug := BASS_PluginLoad(fd.cFileName, 0);
      if Plug <> 0 then
      begin
        Info := pointer(BASS_PluginGetInfo(Plug));
        for a := 0 to Info.formatc - 1 do
        begin
          OpenFilter := OpenFilter + '|' + Info.Formats[a].name + ' ' + '(' +
            Info.Formats[a].exts + ') , ' + fd.cFileName + '|' + Info.Formats[a].exts;
          OpenDirFilter:=OpenDirFilter+Info.formats[a].exts;
        end;
      end;
    until FindNextFile(fh, fd) = false;
  finally
    Windows.FindClose(fh);
  end;
end;
procedure UniteTag;
begin
  if Trim(FileTag.Artist)<>'' then
    TagTitle.Caption:=FileTag.Artist;
  if Trim(FileTag.Title)<>'' then
    TagTitle.Caption:=TagTitle.Caption+'-'+FileTag.Title;
  if Trim(FileTag.Album)<>'' then
    TagTitle.Caption:=TagTitle.Caption+'-'+FileTag.Album;
  if Trim(FileTag.Comment)<>'' then
    TagTitle.Caption:=TagTitle.Caption+'-'+FileTag.Comment;
end;
{
function myVideoProc(Handle : DWORD; Action, param1, param2 : DWORD; user : Pointer): BOOL; stdcall;
var R : TRect;
begin
 result := TRUE; // handle all event my self
 case Action of
  BassVideo_FoundVideo :
    begin
      R := frmVideo.ClientRect;
      R.Left := 0;
      R.Top := 0;
      BASSVideo_SetVideoWindow(Handle, frmVideo.Handle, R, 0);
    end;
  BassVideo_EndStream :
  begin
    IsPlay:=False;
  end;
 end;
end;}


function TForm1.InitializtionStream(FileName:string):Boolean;
var
  temp:string;
begin

  if not(FileExists(filename)) then
  begin
    showmessage(filename+#10#13+'文件不存在');
    Result:=false;
    exit;
  end;
  
  if chan<>0 then
  begin
    BASS_ChannelStop(chan);
    Bass_StreamFree(chan);
  end;

  chan := Bass_StreamCreateFile(false,PChar(FileName), 0, 0,BASS_SAMPLE_FLOAT);

  if chan=0 then
  begin
    Result:=False;
    Exit;
  end;

  //if not IsWhisht then
    //BASS_ChannelSetAttribute(chan, BASS_ATTRIB_VOL, NowVolume);

  FullTime :=Round(BASS_ChannelBytes2Seconds(chan, BASS_ChannelGetLength(chan, BASS_POS_BYTE)));
  Time_G_Bar:= Trunc((FullTime * 1000)/G_length);
  Timer1.Interval:=Time_G_Bar;

  temp:=GetTag(FileName);
  if trim(FileTag.Title)<>'' then
  begin
    UniteTag;
    form2.PlayListBox.Items[PlayIndex]:=temp;
    lstTitle[PlayIndex]:=temp;
  end
  else
    TagTitle.Caption:=form2.PlayListBox.Items[PlayIndex];
  TX:=10;
  form3.FindLyric(lstFilePath[playindex],form2.PlayListBox.Items[playindex]);
end;

procedure TForm1.StopPlay;
begin
  BASS_ChannelStop(chan);
  isplay:=false;
  ispause:=false;
  imgG_barposition.Left:=imgG_ntrack.Left;
  imgG_track.Width:=abs(imgG_BarPosition.Left-imgG_ntrack.Left);
  coninfo[imgplay.Tag].Image:=play;
  painting(imgplay,coninfo,0);
  form3.paintbox1.Canvas.FillRect(form3.paintbox1.ClientRect);
  form3.Timer1.Enabled:=false;
  Timer2.Enabled:=false;
  Timer1.Enabled:=false;
  TimerRender.Enabled:=false;
  ResetTime;
end;

procedure TForm1.PlayFile;
var
  H,W:integer;
begin
  if PlayIndex>(lstFilePath.Count-1) then PlayIndex:=0;
  if lstFilePath.Count<=0 then exit;
  isplay:=not(isplay);
  if Isplay then
  begin
    if not(IsPause) then
      if not(InitializtionStream(lstFilePath[PlayIndex]))then
      begin
        IsPlay:=false;
        Exit;
      end;

     Bass_ChannelPlay(chan,false);
     source := lstFilePath[PlayIndex];
     {BassVideo_GetVideoInfo(chan, H, W);
     if H>0 then
     begin
      frmVideo.Top:=0;
      frmVideo.Height:=H;frmVideo.Width:=W;
      frmVideo.Left:=trunc(screen.Width/2- frmVideo.Width/2);
      frmVideo.Show;
      frmVideo.Timer_Show_Text.Enabled:=True;
     end
     else
     begin
      frmVideo.Hide;
      source := '';
      frmVideo.Timer_Show_Text.Enabled:=False;
     end;}

    Timer1.Enabled:=true;
    Timer2.Enabled:=true;
    TimerRender.Enabled:=true;
    form2.PlayListBox.ItemIndex:=playindex;
    Play:=coninfo[imgplay.Tag].Image;
    coninfo[imgplay.Tag].Image:=Pause;
    painting(imgplay,coninfo,0)
  end
  else
  begin
    BASS_ChannelPause(chan);
    coninfo[imgplay.Tag].Image:=Play;
    painting(imgplay,coninfo,0);
    IsPause:=true;
    TimerRender.Enabled:=false;
    Timer1.Enabled:=false;
    Timer2.Enabled:=false;
  end;
end;

procedure tform1.TrackPeak;
var
  Level: Cardinal;
  LeftPeakValue,RightPeakValue,temp,LNum,RNum:integer;
begin
  temp:=3276;//(MAXWORD div 2) div 10;
  Level := BASS_ChannelGetLevel(chan); {其低16位为左声道峰值; 高16位为右声道峰值}
  LeftPeakValue := LoWord(Level);
  RightPeakValue:= HiWord(Level);
  LNum:=LeftPeakValue div temp;
  RNum:=RightPeakValue div temp;
  if LNum>9 then LNum:=9;
  if RNum>9 then RNum:=9;
  
  imgleftspeaker.Picture:=nil;
  painting(imgLeftSpeaker,coninfo,LNum);
  imgRightSpeaker.Picture:=nil;
  painting(imgRightSpeaker,coninfo,RNum);
end;

procedure TForm1.Visual1Click(Sender: TObject);
begin
  form4.Left:=form1.Left;
  form4.Top:=form1.Top;
  form4.Show;
end;

function TForm1.ReplaceFile:boolean;
begin
  result:=true;
  if(playIndex+1)>(lstFilePath.Count-1)then Result:=false
  else
  begin
    playindex:=playindex+1;
    BASS_ChannelStop(chan);
    Bass_StreamFree(chan);
  end;
end;

procedure TForm1.WMBarIcon(var Message: TMessage);