main.pas

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

var
  mousept: TPoint;
begin
  if message.LParam = wm_lbuttonup then
  begin
    ShowWindow(Handle, SW_SHOW);
    if IsShowList then ShowWindow(form2.Handle, SW_SHOW);
    IcoDestroy;
  end;
  if message.LParam = wm_Rbuttonup then
  begin
    Getcursorpos(mousept);
    popupmenu1.popup(mousept.x, mousept.y);
  end;
end;

procedure TForm1.IcoDestroy;
begin
  //销毁托盘图标
  lpData := new(PNotifyIconDataA);
  lpData.cbSize := 88;
  lpData.Wnd := Form1.Handle;
  lpData.hIcon := Application.Icon.handle;
  lpData.uCallbackMessage := WM_ICONMESSAGE;
  lpData.uID :=0;
  lpData.szTip := 'myPlayer';
  lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
  Shell_NotifyIcon(NIM_DELETE,lpData);
  dispose(lpData);
end;

procedure TForm1.IcoCreate;
begin
  //创建托盘图标
  lpData := new(PNotifyIconDataA);             //指定lpData的长度
  lpData.cbSize := 88;//SizeOf(PNotifyIconDataA);
  lpData.Wnd := Form1.Handle;                 //取应用程序主窗体的句柄
  lpData.hIcon := Application.Icon.handle;    //指定系统状态栏显示应用程序的图标句柄
  lpData.uCallbackMessage := WM_ICONMESSAGE; //指定的窗口消息
  lpData.uID :=0;
  lpData.szTip := 'myPlayer';        //当鼠标停留在系统状态栏该图标上时出现该提示信息
  lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;//指定在该结构中uCallbackMessage、hIcon和szTip参数都有效
  Shell_NotifyIcon(NIM_ADD,lpData);          //在系统状态栏增加一个新图标
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  source := '';
  Bass_Init(-1, 44100, 0, Handle, nil);
  //BassVideo_Init();
  LoadPlugins;
  path:=ExtractFilePath(Application.ExeName);

  lstFilePath:=TStringlist.Create;
  lstTitle:=TStringList.Create;
  IsPlay:=False;
  IsPause:=false;
  OldVolume:=0;
  LoadConfig;
  self.Top:=mainPos.Y;
  self.Left:=mainPos.X;

  PanleInitialization;
  LoadSkinList(Sender);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  mainpos.Y:=self.Top;mainpos.X:=self.Left;
  playlistPos.Y:=form2.Top;playlistPos.X:=form2.Left;
  SavePlayList;
  SaveConfig;
  lstFilePath.Free;
  lstTitle.Free;
  //BassVideo_Free;
  Bass_Free;
  BASS_PluginFree(0);
end;

procedure TForm1.imgCaptureClick(Sender: TObject);
var s : widestring;
    pos : Double;
begin
 if (chan = 0) or (source='') then
 begin
  showMessage('没有视频可以截取图片');
  exit;
 end;
 //pos := BassVideo_GetPosition(chan);
 SaveDialog1.InitialDir:=path+CapturePath;
 SaveDialog1.FileName:='未命名.BMP';
 if not SaveDialog1.Execute then exit;
 s := SaveDialog1.FileName;
 //BassVideo.BassVideo_CaptureBitmap(PWideChar(source), pos, PWideChar(s), BASS_UNICODE);
end;

procedure TForm1.imgCaptureMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  painting(imgCapture,coninfo,3);
end;

procedure TForm1.imgCaptureMouseLeave(Sender: TObject);
begin
  painting(imgCapture,coninfo,1);
end;

procedure TForm1.imgCaptureMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  painting(imgCapture,coninfo,2);
end;

procedure TForm1.imgExitClick(Sender: TObject);
begin
  IcoDestroy;
  Close;
end;

procedure TForm1.imgExitMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  painting(imgexit,coninfo,3);
end;

procedure TForm1.imgExitMouseLeave(Sender: TObject);
begin
  painting(imgexit,coninfo,0);
end;

procedure TForm1.imgExitMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  painting(imgexit,coninfo,2);
end;

procedure TForm1.imgG_BarPositionMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  GuagePos.X:=X;GuagePos.Y:=Y;
end;

procedure TForm1.imgG_BarPositionMouseLeave(Sender: TObject);
begin
  Painting(imgG_BarPosition,ConInfo,1);
end;

procedure TForm1.imgG_BarPositionMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
myPos:integer;
begin
  if not(isplay) then Exit;
  Painting(imgG_BarPosition,ConInfo,0);
  if Shift=[ssleft] then
  begin
    myPos:=imgG_BarPosition.Left+(X-GuagePos.X);
    if (myPos<=imgG_Ntrack.Left) then
       imgG_BarPosition.Left:=imgG_Ntrack.Left
    else if (myPos>=imgG_Ntrack.Left+imgG_Ntrack.Width) then
       myPos:=imgG_Ntrack.Left+imgG_Ntrack.Width
    else if ((myPos>imgG_Ntrack.Left)and(myPos<imgG_Ntrack.Left+imgG_Ntrack.Width))then
      imgG_BarPosition.Left:=myPos;
    imgG_track.Width:=abs(imgG_Ntrack.Left-imgG_BarPosition.Left);
  end;
end;

procedure TForm1.imgG_BarPositionMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  var
    NowPosition:double;
begin
  NowPosition :=imgG_track.Width*(timer1.Interval)/1000;
  BASS_ChannelSetPosition(chan, BASS_ChannelSeconds2Bytes(chan, NowPosition), BASS_POS_BYTE);
end;

procedure TForm1.imgMinClick(Sender: TObject);
begin
  ShowWindow(handle, SW_HIDE);
  Nrenew.Checked:=false;
  if IsWindowVisible(form2.Handle) then ShowWindow(form2.handle, SW_HIDE);
  IcoCreate;
end;

procedure TForm1.imgMinMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  painting(imgmin,coninfo,3);
end;

procedure TForm1.imgMinMouseLeave(Sender: TObject);
begin
  painting(imgmin,coninfo,0);
end;

procedure TForm1.imgMinMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  painting(imgmin,coninfo,2);
end;

procedure TForm1.imgNextClick(Sender: TObject);
begin
  imgStopClick(Sender);

  if (playIndex+1)>(lstFilePath.Count-1) then playindex:=lstFilePath.Count-1
  else playindex:=playindex+1;

  playfile;
end;

procedure TForm1.imgNextMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  painting(imgnext,coninfo,3);
end;

procedure TForm1.imgNextMouseLeave(Sender: TObject);
begin
  painting(imgnext,coninfo,0);
end;

procedure TForm1.imgNextMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  painting(imgnext,coninfo,2);
end;

procedure TForm1.imgPanelMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  mousept:TPoint;
begin
  FramePos.X:=X;FramePos.Y:=Y;
  if Shift=[ssRight] then
  begin
    Getcursorpos(mousept);
    popupmenu1.popup(mousept.x, mousept.y);
  end;
end;

procedure TForm1.imgPanelMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Shift=[ssleft] then
  begin
    Form1.Left:=Form1.Left+(X-FramePos.X);
    Form1.Top:=Form1.Top+(Y-FramePos.Y);
    if conglutinate then
    begin
      form2.Top:=form1.Top+form1.Height;
      form2.Left:=form1.left;
    end;
  end;
end;

procedure TForm1.imgPlayClick(Sender: TObject);
begin
  playfile;
end;

procedure TForm1.imgPlayListClick(Sender: TObject);
begin
  case  IsWindowVisible(form2.Handle)  of
    false:
    begin
      form2.show;
      IsShowList:=true;
    end
    else
    begin
      form2.hide;
      IsShowList:=false
    end;
  end;
end;

procedure TForm1.imgPlayListMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  painting(imgplaylist,coninfo,3);
end;

procedure TForm1.imgPlayListMouseLeave(Sender: TObject);
begin
  painting(imgplaylist,coninfo,0);
end;

procedure TForm1.imgPlayListMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  painting(imgplaylist,coninfo,2);
end;

procedure TForm1.imgPlayMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  painting(imgplay,coninfo,3);
end;

procedure TForm1.imgPlayMouseLeave(Sender: TObject);
begin
  painting(imgplay,coninfo,0);
end;

procedure TForm1.imgPlayMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  painting(imgplay,coninfo,2);
end;

procedure TForm1.imgPreviousClick(Sender: TObject);
begin
  imgStopClick(Sender);

  if (playIndex-1)<0 then playindex:=0
  else playindex:=playindex-1;

  playfile;
end;

procedure TForm1.imgPreviousMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  painting(imgprevious,coninfo,3);
end;

procedure TForm1.imgPreviousMouseLeave(Sender: TObject);
begin
  painting(imgprevious,coninfo,0);
end;

procedure TForm1.imgPreviousMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  painting(imgprevious,coninfo,2);
end;

procedure TForm1.imgSpeakerClick(Sender: TObject);
begin
  IsWhisht:=not IsWhisht;
  if IsWhisht then
  begin
    OldVolume:=NowVolume;
    BASS_ChannelSetAttribute(chan, BASS_ATTRIB_VOL, 0.0);
    painting(imgspeaker,coninfo,3);
  end
  else
  begin
    NowVolume:=OldVolume;
    OldVolume:=0;
    BASS_ChannelSetAttribute(chan, BASS_ATTRIB_VOL, NowVolume);
    painting(imgspeaker,coninfo,0);
  end;
end;

procedure TForm1.imgSpeakerMouseLeave(Sender: TObject);
begin
if IsWhisht then
  //painting(imgspeaker,coninfo,3)
else
  painting(imgspeaker,coninfo,0);
end;

procedure TForm1.imgSpeakerMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  painting(imgspeaker,coninfo,3);
end;

procedure TForm1.imgStopClick(Sender: TObject);
begin
  StopPlay;
end;

procedure TForm1.imgStopMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  painting(imgstop,coninfo,3);
end;

procedure TForm1.imgStopMouseLeave(Sender: TObject);
begin
  painting(imgstop,coninfo,0);
end;

procedure TForm1.imgStopMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  painting(imgstop,coninfo,2);
end;

procedure TForm1.imgV_BarPositionMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  VolumePos.X:=X;VolumePos.Y:=Y;
end;