⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.~pas

📁 超级播放器 -- 软件特点 -- 功能齐全 操作简便 绿色环保
💻 ~PAS
📖 第 1 页 / 共 5 页
字号:
        bottom:=listbmp.Height;
      end;
      with rect2 do
      begin
         left:=0;top:=0;
         right:=x1;
         bottom:=y1;
      end;
      ListBmp.Canvas.CopyRect(rect1,backimg.Picture.Bitmap.canvas,rect2);
    end;
   //4
   if x1<>0 then
   begin
      with rect1 do
      begin
        left:=listbmp.Width-x1;
        top:=0;
        right:=listbmp.Width;
        bottom:=listbmp.Height-y1;
      end;
      with rect2 do
      begin
         left:=0;top:=y1;
         right:=x1;
         bottom:=listbmp.Height;
      end;
      ListBmp.Canvas.CopyRect(rect1,backimg.Picture.Bitmap.canvas,rect2);
   end;

   sglist.Brush.Bitmap :=listBmp;
end;
procedure TMainFrm.ListBox1DblClick(Sender: TObject);
begin
  if listbox1.Items.count<=0 then
    exit;

  playItem :=listbox1.ItemIndex ;
  PlayBtnClick(nil);

end;

procedure TMainFrm.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
  with listbox1 do
  begin
    //canvas.Brush.Bitmap :=Volimg.Picture.Bitmap;
    if odSelected in state then
    begin
      if  (index=playitem) and (uppercase(playfilename)=uppercase(GetGridCell('全名',index))) then
      begin//正在播放
        canvas.Font.Color :=cllime;
        canvas.Brush.Color := clpurple;
      end
      else
      begin
        canvas.Brush.Color := clNavy;
        canvas.Font.Color := clwhite;
      end;
    end
    else
    begin
      if  (index=playitem) and (uppercase(playfilename)=uppercase(GetFilename(index))) then
      begin//正在播放
        canvas.Font.Color :=cllime;
        canvas.Brush.Color := clolive;
      end
      else
      begin
        canvas.Font.Color :=clwhite;
        if (index mod 2) =0 then
          canvas.Brush.Color := clTeal
        else
          canvas.Brush.Color :=$008C8C00;// clOlive;
      end;
    end;

    canvas.FillRect(rect);
    if (odFocused in State) then
      Canvas.DrawFocusRect(Rect);
      
    DrawText(Canvas.Handle, PChar(Items[index]), Length(Items[index]), Rect, DT_SINGLELINE or DT_VCENTER);
   end;
end;

procedure TMainFrm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  volTimer.Enabled :=false;

  SaveSysInfo;//保存系统信息


{  已注册 ...

  }
end;

procedure TMainFrm.PausebtnClick(Sender: TObject);
begin
  if playerState = psClosed then
    exit;
  if playerState = psPaused then
     MyResume
  else if playerstate=psPlaying then
     MyPause;
end;

procedure TMainFrm.StopBtnClick(Sender: TObject);
begin
  if playerState=psClosed then
    exit;
  if playerstate<>psStopped then
  begin
    MyStop;
    Timer2Timer(nil);
    CloseMedia;
    if FrmDisplayScr.visible then
       FrmDisplayScr.Close;

  end  ;
end;

function TMainFrm.GetFilename(index:integer):string;
var              //从listbox1中得到文件全名
  len,pos1:integer;
begin
      len:=length(listbox1.Items[Index]);
      pos1:=pos('.',listbox1.Items[Index]);
      result:=copy( listbox1.Items[Index]
                 ,pos1+1
                 ,len-pos1);
end;
procedure TMainFrm.PlayBtnClick(Sender: TObject);
var err:string;
begin
    if listbox1.Items.count<=0 then exit;

      //关闭正在播放的
      timer2.Enabled :=false;
      if playerstate <>psClosed then
        MyClose;

      if sender=PlayBtn then //自动播放时,playItem已经设置
      begin
         if noteBook1.ActivePage ='list1' then
           playitem:=listbox1.ItemIndex
         else
           playItem:=sglist.Row-1;
      end;

      if not fileexists(GetGridCell('全名',playitem+1)) then
      begin
        Application.MessageBox(pchar('文件未找到:'+#13+#13+listbox1.Items[playitem]),pchar(application.title),mb_ok+mb_iconinformation);
        if FrmDisplayScr.visible then
          FrmDisplayScr.Close;
        exit;
      end;

{      //检测声卡
      if waveoutgetnumDevs<=0 then
      begin
        showinformation('没有发现声卡!');
        exit;
      end;
 }
      try
         err:='0:open error';
         if not MyOpen then exit;

         err:='1:updateTimerBar error';
         updateTimerBar;
         
         err:='2:play error';
         if not MyPlay then exit;
         err:='3';
         playfilename:=GetFilename(playitem);
         showfilename:=GetGridCell('No.',playitem+1)+'.'+extractfilename(playfilename);
         //初始化游动标题位置 ,即游动标题栏之后
         MovePos:=MoveTitle.width div movetitle.Canvas.TextWidth('a')+1;//+ system.length(showFileName)-11;
         listbox1.Refresh;
         sglist.Refresh;
         playerState :=psPlaying;

         err:='4';
         sglist.Row :=PlayItem+1;

      except
        on e:exception do
          showinformation('openfiel-No:'+err+', '+'E:'+e.Message);
      end;

end;

procedure TMainFrm.ListBox1Click(Sender: TObject);
var
  myRect: TGridRect;
  index:integer;
begin
  if listbox1.Items.count>0 then
  begin
    index:=listbox1.itemindex;
    listbox1.Hint :=listbox1.Items[index];
    
    if listbox1.ItemIndex <>listbox1.topindex then
      sglist.Toprow :=listbox1.TopIndex +2
    else
       sglist.Toprow :=listbox1.TopIndex +1;

    myRect.Left := 1;
    myRect.Top := listbox1.itemindex+1;
    myRect.Right := 1;
    myRect.Bottom := listbox1.itemindex+1;

    sglist.Selection := myRect;
  end;
 
end;

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

      if mnuPlyOrder.Checked or mnuPlyRepeat.Checked  then
      begin
        if playitem=-1 then
          playItem:=0
        else if PlayItem=0 then
          playitem:=listbox1.Items.Count-1
        else
        begin
          if playitem-1>listbox1.Items.Count-1 then
            playitem:=listbox1.Items.Count-1
          else
            playItem:=PlayItem-1;
        end;
      end;
      if mnuPlyRand.Checked then
         Playitem:=Random(listbox1.count) ;

      PlayBtnClick(nil);

end;

procedure TMainFrm.StepBtnClick(Sender: TObject);
var
  mPos,MoveLen:longint;
  lastMode:TPlayerState;
begin
//快进或回退20秒
  if playerState = psClosed then exit;

  LastMode:=playerState;
  timer2.Enabled :=false;

  mPos:=GetCurrentMultimediaPos(MediaAliasName);
  MoveLen:=Round(20000 / fileLength * framelength);
  if sender =StepBtn then
  begin
    if mPos +MoveLen >=framelength then
      MoveMedia(framelength)
    else
      MoveMedia(mPos+MoveLen) ;
  end
  else
  begin
    if mPos -MoveLen <0 then
      MoveMedia(1)
    else
      MoveMedia(mPos-MoveLen) ;
  end;

  timer2timer(nil);//显示下一位置的信息
  if lastMode =psPlaying then
  begin
    MyPlay;
  end
  else if lastMode =psPaused then
  begin
    MyPlay;
    MyPause;
  end;
end;

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

      if mnuPlyOrder.Checked or mnuPlyRepeat.Checked  then
      begin
        if playitem=-1 then
          playitem:=0
        else if PlayItem>=listbox1.Count-1 then
          playitem:=0
        else
          playItem:=PlayItem+1;
      end;
      if mnuPlyRand.Checked then
         Playitem:=Random(listbox1.count) ;

      PlayBtnClick(nil);

end;

procedure TMainFrm.FormResize(Sender: TObject);
begin
   if notebook1.height>2 then
   begin
      Loadsbtn.Visible :=true;
      savesbtn.Visible :=true;
      delsbtn.Visible :=true;
      addsbtn.Visible :=true;
      sortsbtn.Visible :=true;
      moveitemsbtn.Visible :=true;
      showLyricEditorSbtn.Visible :=true;
      selitem.Visible :=false;
   end
   else
   begin
      Loadsbtn.Visible :=false;
      savesbtn.Visible :=false;
      delsbtn.Visible :=false;
      addsbtn.Visible :=false;
      sortsbtn.Visible :=false;
      moveitemsbtn.Visible :=false;
      showLyricEditorSbtn.Visible :=false ;
      selitem.Visible :=true;
      selitem.Caption :='-> '+GetGridCell('全名',listbox1.itemindex+1);
   end;

   if notebook1.height >40 then
   begin
     shape2.Visible :=true;
     shape1.Visible :=true;
     shape3.Visible :=true;
     shape4.Visible :=true;
   end
   else
   begin
     shape2.Visible :=false;
     shape1.Visible :=false;
     shape3.Visible :=false;
     shape4.Visible :=false;
   end;

   updateUpDownPos;

end;

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

procedure TMainFrm.delSBtnClick(Sender: TObject);
var
  i,j,top,bottom:integer;
  answer:boolean; //是;取消
  DeleteDiskFile:boolean;
  cantdelfile:string;
begin
  if listbox1.Items.count<=0 then exit;

  cantdelfile:=''; ansWer:=false; DeleteDiskFile:=false;
  if (notebook1.ActivePage ='list1') then
  begin
    if listbox1.SelCount<=0 then exit;
    with TFrmConfirmDel.Create(self) do
    try
      if showmodal=mrok then
      begin
       answer:=true;
       DeleteDiskFile:=DeldiskFile;
      end;
    finally
      free;
    end;

    if not answer then exit;

    for i:=listbox1.Items.Count-1 downto 0 do
      if  listbox1.Selected[i] then
      begin
        if DeleteDiskFile then //删除磁盘文件
        begin
          setfileattr(Getfilename(i),faHidden or fareadonly or fasysfile,false);

          if (not deletefile(Getfilename(i))) then
            cantdelfile:=cantdelfile+Getfilename(i)+#13;
        end;
        listbox1.Items.Delete(i);
        listChged:=true;

        if (i=0) and (listbox1.Items.Count=0) then
        begin
          for j:=0 to sglist.ColCount-1 do
            sglist.Rows[1][j]:='';
          for j:=0 to HideColGrid.ColCount-1 do
            HideColGrid.Rows[1][j]:='';  
        end
        else
        begin
          for j:=i+1 to sglist.RowCount-2 do
          begin
             sglist.Rows[j]:=sglist.Rows[j+1];
             HideColGrid.Rows[j]:=HideColGrid.Rows[j+1];

             SetGridCell('No.',inttostr(j),j);
          end;
        end;
        if sglist.RowCount >2 then
        begin
          sglist.RowCount :=sglist.RowCount -1;
          HideColGrid.RowCount :=HideColGrid.RowCount - 1;
        end;
        ResetNo(i);
      end
  end
  else
  begin
     top :=sglist.Selection.Top;
     bottom:=sglist.Selection.Bottom;

     with TFrmConfirmDel.Create(self) do
     try
       if showmodal=mrok then
       begin
        answer:=true;
        DeleteDiskFile:=DeldiskFile;
       end;
     finally
       free;
     end;

     if not answer then exit;
       for i:=bottom downto top do
       begin
         if DeleteDiskFile then //删除磁盘文件
         begin
           setfileattr(Getfilename(i-1),faHidden or fareadonly or fasysfile,false);
           if (not deletefile(Getfilename(i-1))) then
             cantdelfile:=cantdelfile+Getfilename(i-1)+#13;
         end;
         listbox1.Items.Delete(i-1);
         listChged:=true;

         if (i=1) and (sglist.RowCount=2) then
         begin
           for j:=0 to sglist.ColCount-1 do
             sglist.Rows[1][j]:='';
           for j:=0 to HideColGrid.ColCount-1 do
             HideColGrid.Rows[1][j]:='';

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -