main.~pas

超级播放器 -- 软件特点 -- 功能齐全 操作简便 绿色环保

           canvas.Font.Color :=clyellow;
         end
         else
         begin
           if not mnulistBack.Checked then
             canvas.Brush.Color :=clNavy;
            //系统已经默认选取字体颜色 为白
           canvas.Font.Color :=clWhite;
         end;
        end
      else   //未选取的行
      begin
         if (ARow=PlayItem+1) and (playerstate<>psClosed) and (uppercase(GetGridCell('全名',ARow))=uppercase(playfilename)) then
         begin
           if not mnulistBack.Checked then
             Canvas.Brush.Color :=clolive;
           canvas.Font.Color :=cllime;
         end
         else
           canvas.Font.Color :=clblack;
      end;
    end;
    Canvas.FillRect(Rect);

    canvas.Pen.Color :=clbtnface;
    canvas.Pen.Width :=2;
    canvas.Pen.style :=psDashdotdot;
    if (ARow=0)  then  //or (Acol=0)
    begin  //画右竖线
      canvas.MoveTo(rect.Right,rect.top);
      canvas.LineTo(rect.Right,rect.Bottom);
    end;

    if (pos(cells[ACol,0] , 'No. '+'类型 '+'时间 '+'出版年 '+'流派 ')<>0)
      or (ARow=0) then
      //居中
      DrawText(Canvas.Handle, PChar(cells[acol,arow]), Length(cells[acol,arow]), Rect,  DT_CENTER or DT_SINGLELINE or DT_VCENTER)
    else
      //居左
      DrawText(Canvas.Handle, PChar(cells[acol,arow]), Length(cells[acol,arow]), Rect,   DT_SINGLELINE or DT_VCENTER);
    if gdFocused in State then
      Canvas.DrawFocusRect(Rect);
  end;
end;
Function TMainFrm.Lese_ID3Tag(var ID3Tag:TID3Tag;FileName:string):boolean;
var
  Buffer:Array[1..128] of char;
  F:File;
begin
  Result:=true;
  try
    AssignFile(F,Filename);
    Reset(F,1);
    Seek(F,FileSize(F)-128);
    BlockRead(F, Buffer, SizeOf(Buffer));
    CloseFile(F);
    with ID3Tag do begin
      ID:=copy(Buffer,1,3);
      if ID='TAG' then
      begin
        Title:=copy(Buffer,4,30);
        Artist:=copy(Buffer,34,30);
        Album:=copy(Buffer,64,30);
        Year:=copy(Buffer,94,4);
        Comment:=copy(Buffer,98,30);

        Genre:=ord(Buffer[128]);
      end
      else
      begin
        Title:='';
        Artist:='';
        Album:='';
        Year:='';
        Comment:='无MP3标识';
        Genre:=0;
      end;
    end;
  except
    on e:exception do
      Result:=false;
  end;
end;
Function TMainFrm.Lese_ID3Tag2(var ID3Tag:TID3Tag2;FileName:string):boolean;
var
   filestream:TFilestream;
begin
  result:=true;
  filestream:=TFilestream.Create(filename,fmopenRead);
  try
  try
    filestream.Position :=filestream.Size -128;
    filestream.Read(ID3Tag,sizeof(ID3Tag)) ;
    if ID3Tag.ID <>'TAG' then
    begin
        id3tag.Title:='';
        id3tag.Artist:='';
        id3tag.Album:='';
        id3tag.Year:='';
        id3tag.Comment:='无MP3标识';
        id3tag.Genre:=0;
    end;
    except
      on e:exception do
        Result:=false;
    end;
  finally
    filestream.Destroy;
  end;
end;
procedure TMainFrm.ReloadMusicInfoMnuClick(Sender: TObject);
var ID3Tag:TID3Tag2;
   i,seltop,selbottom:integer;
begin
  if listbox1.Items.Count =0 then exit;
  screen.Cursor :=crHourGlass;

  seltop :=sglist.Selection.Top;
  selbottom:=sglist.Selection.Bottom;
  for i:=seltop to selbottom do
  begin
    if uppercase(GetGridCell('类型',i)) <>'MP3' then
    begin
      Application.MessageBox(pchar(GetGridCell('全名',i)+#13+#13+'不是MP3文件.'),pchar(application.Title),mb_ok+mb_iconInformation);
      continue;
    end;
    //正在播放的进行读取，会出错。
    if GetGridCell('全名',i)= playFIlename then
    begin
       Application.MessageBox('正在播放的不能读取.',pchar(application.Title),mb_ok+mb_iconInformation);
       continue;
    end;
    if Lese_ID3Tag2(ID3Tag,GetGridCell('全名',i)) then
    begin
      SetGridCell('标题',ID3Tag.Title,i);
      SetGridCell('艺术家',ID3Tag.Artist,i);
      SetGridCell('专辑',ID3Tag.Album,i);
      SetGridCell('出版年',ID3Tag.Year,i);
      SetGridCell('评论',ID3Tag.Comment,i);
      SetGridCell('流派',GetGenreName(ID3Tag.Genre),i);
    end
    else
    begin
      SetGridCell('标题','',i);
      SetGridCell('艺术家','',i);
      SetGridCell('专辑','',i);
      SetGridCell('出版年','',i);
      SetGridCell('评论','*读取出错*',i);
      SetGridCell('流派','',i);
    end;
    ListChged:=true;
  end;
  screen.Cursor :=crDefault;
end;

procedure TMainFrm.RadioButton4Click(Sender: TObject);
begin
  if sender = Radiobutton4 then
  begin
    notebook1.ActivePage :='list1';
    if self.Visible and listbox1.visible then
      listbox1.SetFocus;
  end
  else if sender =radiobutton5 then
  begin
    notebook1.ActivePage :='list2';
    if self.Visible and sglist.Visible then
      sglist.SetFocus;
  end
  else
  begin
    notebook1.ActivePage :='screenform';
    if self.Visible and PYEdit.Visible then
      PYEdit.SetFocus;
  end;

end;

procedure TMainFrm.sglistDblClick(Sender: TObject);
begin
  if listbox1.Items.count<=0 then
    exit;

  playItem :=sglist.row-1;
  PlayBtnClick(nil);
end;

procedure TMainFrm.sglistKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if listbox1.Items.count<=0 then
    exit;
  if key=vk_return then
  begin
    playItem :=sglist.row-1;
    playbtnclick(nil);
  end;

end;

procedure TMainFrm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if (key=84) and (ssAlt in Shift) then  //Alt+T
     LblSelSongDblClick(nil)
  else if (key=vk_left) and (ssCtrl in shift) then
     PrevBtnClick(PrevBtn)
  else if (key=vk_right) and (ssCtrl in shift) then
     NextBtnClick(NextBtn)
  else if (key=vk_prior) and (ssCtrl in shift) then
     StepBtnClick(backBtn)
  else if (key=vk_next) and (ssCtrl in shift) then
     StepBtnClick(stepBtn);

end;

procedure TMainFrm.TitleBarMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (Button=mbLeft) then
  begin  //进入移动状态
       SendMessage(self.Handle,WM_LBUTTONUP,0,0);
       SendMessage(self.Handle,WM_NCLBUTTONDOWN,HTCaption,0);
  end;
 
end;

procedure TMainFrm.SpeedButton1Click(Sender: TObject);
begin
  close;
end;

procedure TMainFrm.SpeedButton2Click(Sender: TObject);
begin
 self.Hide;
end;

procedure TMainFrm.TitleSignDblClick(Sender: TObject);
begin
  if (self.Width <>screen.Width) or (self.Height<>screen.Height-2)
    or (self.left<>0) or (self.top<>0) then
  begin //进入最大化
    winWidth:=self.Width ;
    winHeight:=self.Height;
    winTop:=self.Top;
    winLeft:=self.Left;
    self.Top :=0;
    self.Left :=0;
    self.Width :=screen.Width;
    self.Height :=screen.Height-2;

    big2.Visible :=true;
    big1.Visible :=false;
  end
  else
  begin  //还原原来状态
    self.Top :=winTop;
    self.Left :=winLeft;
    self.Width :=winWidth;
    self.Height :=winHeight;

    big1.Visible :=true;
    big2.Visible :=false;
  end;
end;

procedure TMainFrm.updateTimerBar;
var
  mLen,mPos:Longint;
  i,sF,sM:integer;
  sStr:string;
begin
   mLen:=filelength ;
   for i:=1 to 5 do
   begin
      mPos := mLen * i div 5;
      sF := Round(mPos div 60000);
      sM :=Round((mPos-sF*60000) div 1000);
      sStr:=formatstr(inttostr(sF),2,true,false)+':'+formatstr(inttostr(sM),2,true,false);
      (findcomponent('label'+inttostr(i+6)) as TLabel).Caption :=sStr;
   end;
end;

procedure TMainFrm.mnuShowPlaytimeClick(Sender: TObject);
begin
  (sender as TMenuItem).Checked :=true;
  if sender =mnuShowPlayTime then
    lblTime.hint :='播放时间'
  else
    lblTime.hint :='剩余时间';
end;

procedure TMainFrm.Label24MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (Button=mbLeft) then
  begin  //进入改变大小状态
      SendMessage(self.Handle,WM_LBUTTONUP,0,0);
      SendMessage(self.Handle,WM_NCLBUTTONDOWN,HTBOTTOM,0);
  end;
end;

procedure TMainFrm.Label26MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (Button=mbLeft) then
  begin  //进入改变大小状态
      SendMessage(self.Handle,WM_LBUTTONUP,0,0);
      SendMessage(self.Handle,WM_NCLBUTTONDOWN,HTRIGHT,0);
  end;

end;

procedure TMainFrm.N1Click(Sender: TObject);
var
   i,seltop,selbottom:integer;
   mLen:LongInt;
   vHou,vMin,vSec:integer;
   retstr:string;
begin
  screen.Cursor :=crHourGlass;
  try
      try
        if listbox1.Items.Count =0 then exit;
        seltop :=sglist.Selection.Top;
        selbottom:=sglist.Selection.Bottom;
        for i:=seltop to selbottom do
        begin
          if isVideoFile(i-1) then
            retstr:= OpenMultimedia(FrmDisplayScr.ScrPnl.handle,TempMedia, GetFilename(i-1),'MPEGVideo')
          else
            retstr:= OpenMultimedia(TempMedia, GetFilename(i-1),'MPEGVideo');
          mLen:=GetTotalMillisec(TempMedia);
          CloseMultimedia(TempMedia);

          vHou:=Round(mLen div 3600000) ;
          vMin:=Round((mLen-vHou*3600000) div 60000);
          vSec:=Round((mLen-vHou*3600000-vMin*60000) div 1000);
          if vhou>0 then
            SetGridCell('时间',formatstr(inttostr(vHou),2,true,false)+':'+formatstr(inttostr(vMin),2,true,false)+':'+formatstr(inttostr(vSec),2,true,false),i)
          else
            SetGridCell('时间',formatstr(inttostr(vMin),2,true,false)+':'+formatstr(inttostr(vSec),2,true,false),i);

           listChged:=true;
        end;
      except
         on e:exception do
          showinformation(e.Message);
      end;
  finally
    screen.Cursor :=crDefault;
  end;
end;

function TMainFrm.GetColIndex(strgrid:Tstringgrid;vTitle:String):integer;
var i,colCount:integer;
begin
   Result:=-1;
   colCount:=strgrid.ColCount ;
   for i:=0 to colCount-1 do
   begin
     if strgrid.Rows[0][i]=vTitle then
       begin
         result:=i;
         break;
       end;
   end;
end;
procedure TMainFrm.EjectBtnClick(Sender: TObject);
begin
  if openCdDoor then
  begin
    openCdDoor:=false;
    mcisendstring('set cdaudio door open',nil,0,handle);
  end
  else
  begin
    openCdDoor:=true;
    mcisendstring('set cdaudio door closed',nil,0,handle);
  end;
end;

procedure TMainFrm.N7Click(Sender: TObject);
begin
  MySetAudio((sender as TMenuItem).Tag);
end;

procedure TMainFrm.lblTimeClick(Sender: TObject);
begin
  popupmenu2.Popup(mouse.CursorPos.x,mouse.CursorPos.Y);
end;

procedure TMainFrm.lbSoundLRClick(Sender: TObject);
begin
  if lbSoundLR.Caption ='立体声' then
     N7Click(n8)
  else if lbSoundLR.caption= '左声道' then
     N7Click(n9)
  else if lbSoundLR.caption= '右声道' then
     N7Click(n10)
  else if lbSoundLR.caption= '静音' then
     N7Click(n7)
end;

procedure TMainFrm.dotMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    if (button=mbleft) and (not PressDot) then
    begin
      if playerState <>psClosed then
      begin
        BeforepressDotState:=playerState;
        if ModeString.caption ='playing' then
          timer2.Enabled :=false;
        playerState :=psStopped;
        pressDot:=true;
        pd_X:=x;
      end;
    end;
end;

procedure TMainFrm.dotMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    if (playerState=psStopped) and pressDot then
    begin
      if button=mbleft then
      begin
        pressDot:=false;
        MoveMedia((dot.Left-bar.Left ) * framelength div (bar.width-dot.Width));
        if BeforepressDotState=psPlaying then
        begin
          MyPlay;
          timer2.Enabled :=true;
        end
        else if BeforepressDotState=psPaused then
        begin
          MyPlay;
          MyPause;
        end;
      end;
    end;
end;

procedure TMainFrm.dotMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin