main.~pas

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

         end
         else
         begin
           for j:=i 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-1);
       end;
  end;

  if cantdelfile<>'' then
  begin
    application.MessageBox(pchar('不能删除文件：'+#13+#13+cantdelfile+#13+'  或文件不存在,正在播放的播完即删除！'),pchar(application.Title),mb_ok+mb_iconinformation);
  end;
end;
procedure TMainFrm.Savelist;
var
  fs1     : TFileStream;
  s      : String;
  i,m,l  : Integer;
begin
  fs1 := TFileStream.Create(extractfiledir(application.ExeName)+'\playList.lst', fmCreate ); //or fmOpenWrite
  with fs1 do
  begin
    try
      m:= listbox1.Items.Count;
      write (m, Sizeof(Integer));

      write (SIG_MYFILE,length(SIG_MYFILE));

      for i:=0 to m-1 do
      begin
         s:= listbox1.Items[i];
         l:= Length(s) ;
         write (l,sizeof(Integer));
         write (s[1], l);
      end;
    finally
      fs1.Free;
    end;
  end;
end;
procedure TMainFrm.Readlist;
var
  fs     : TFileStream;
  s      : String;
  i,m,l  : Integer;
begin
  fs := TFileStream.Create(extractfiledir(application.ExeName)+'\playList.lst', fmOpenRead);
  with fs do
  begin
      try
        read (m, sizeof(Integer));

        setlength(s,length(SIG_MYFILE));
        read (s[1],length(SIG_MYFILE));
        if CompareText(S, SIG_MYFILE) <> 0 then
          raise Exception.Create('文件标志不匹配！');
        
        for i:=0 to m-1 do
        begin
          read (l,sizeof(Integer));

          setlength(s,l);
          read (s[1],l);

          listbox1.Items.Add(s);
        end;
      finally 
        free;
      end;
  end;
end;
procedure TMainFrm.SaveSBtnClick(Sender: TObject);
begin
 if filenamechg then
 begin
    application.MessageBox('请先更名！',pchar(application.title),mb_ok+mb_iconwarning);
    exit;
 end;
 if listChged then
    if application.MessageBox('确定要保存曲目清单？',pchar(application.title),mb_okcancel+mb_iconQuestion)=mrok then
    begin
      Savelist;
      Savelist2;
      listchged:=false;
    end;
end;

procedure TMainFrm.LoadSBtnClick(Sender: TObject);
var i,j:integer;
begin
  listChged:=false;
  listbox1.Items.Clear;
  Readlist;
  if ListBox1.Items.Count >0 then
    listbox1.selected[0]:=true;

//Reset sglist
  for i:=1 to sglist.RowCount-1 do
    for j:=0 to sglist.ColCount -1 do
      sglist.Cells[j,i]:='';
  for i:=1 to HideColGrid.RowCount-1 do
    for j:=0 to HideColGrid.ColCount -1 do
      HideColGrid.Cells[j,i]:='';

  ReadList2;
end;
procedure TMainFrm.Savelist2;
var
  fs1     : TFileStream;
  s ,f     : String;
  i,m,l  : Integer;
begin
  fs1 := TFileStream.Create(extractfiledir(application.ExeName)+'\playList2.lst', fmCreate ); //or fmOpenWrite
  with fs1 do
  begin
    try
      try
        m:= listbox1.Items.Count;
        write (m, Sizeof(Integer));

        write (SIG_MYFILE,length(SIG_MYFILE));
         f:='0';
        for i:=1 to m do
        begin   
           //write whole name
           s:= GetGridCell('全名',i);

           l:= Length(s) ;
           write (l,sizeof(Integer));
           write (s[1], l);
           f:='1';
           //write time
           s:= GetGridCell('时间',i);
           l:= Length(s) ;
           write (l,sizeof(Integer));
           write (s[1], l);
           //write Comment
           s:=GetGridCell('评论',i);
           l:= Length(s) ;
           write (l,sizeof(Integer));
           write (s[1], l);
           f:='2';
           if (uppercase(GetGridCell('类型',i))='MP3') and (s<>'*读取出错*') and (s<>'无MP3标识') then
           begin
             //write title
             s:=GetGridCell('标题',i);
             l:= Length(s) ;
             write (l,sizeof(Integer));
             write (s[1], l);
             f:='3';
             //write Artist
             s:=GetGridCell('艺术家',i);
             l:= Length(s) ;
             write (l,sizeof(Integer));
             write (s[1], l);
             f:='4';
             //write Ablum
             s:= GetGridCell('专辑',i);
             l:= Length(s) ;
             write (l,sizeof(Integer));
             write (s[1], l);
             f:='5';
             //write year
             s:=GetGridCell('出版年',i);
             l:= Length(s) ;
             write (l,sizeof(Integer));
             write (s[1], l);
             f:='6';
             l:=GetGenreIndex(GetGridCell('流派',i));
             write (l,sizeof(Integer));
             f:='7';
           end;
        end;
      except
        on e:exception do
        begin
          showinformation('No:'+f+', '+e.message);
        end;
      end;
    finally
      fs1.Free;
    end;
  end;
end;
procedure TMainFrm.Readlist2;
var
  fs     : TFileStream;
  s      : String;
  i,m,l,g: Integer;
begin
  fs := TFileStream.Create(extractfiledir(application.ExeName)+'\playList2.lst', fmOpenRead);
  with fs do
  begin
      try
        read (m, sizeof(Integer));

        setlength(s,length(SIG_MYFILE));
        read (s[1],length(SIG_MYFILE));
        if CompareText(S, SIG_MYFILE) <> 0 then
          raise Exception.Create('文件标志不匹配！');

        if m=0 then
          sglist.RowCount :=2
        else
          sglist.RowCount:=m+1;
        if 11-sglist.ColCount >1 then
           HideColGrid.ColCount := 11-sglist.ColCount
        else
           HideColGrid.ColCount := 1;
        if sglist.ColCount <>11 then
          HideColGrid.rowcount :=sglist.RowCount ;
             
        for i:=1 to m do  //m
        begin
          SetGridCell('No.',inttostr(i),i);

          //Read Whole name
          read (l,sizeof(Integer));
          setlength(s,l);
          read (s[1],l);

            SetGridCell('全名',s,i);

            //Get file ext
            SetGridCell('类型',copy(extractfileext(s),2,length(extractfileext(s))-1),i);
            //Get file simple name
            SetGridCell('名称',copy(extractfilename(s),1,length(extractfilename(s))-length(extractfileext(s))),i);

          //Read time
          read (l,sizeof(Integer));
          setlength(s,l);
          read (s[1],l);
          SetGridCell('时间',s,i);

          //Read Comment
          read (l,sizeof(Integer));
          setlength(s,l);
          read (s[1],l);
          SetGridCell('评论',s,i);

          if (uppercase(GetGridCell('类型',i))='MP3') and (s<>'*读取出错*') and (s<>'无MP3标识') then
          begin
            //Read Comment
            read (l,sizeof(Integer));
            setlength(s,l);
            read (s[1],l);

            SetGridCell('标题',s,i);
            //read Artils
            read (l,sizeof(Integer));
            setlength(s,l);
            read (s[1],l);

            SetGridCell('艺术家',s,i);
            //Read Album
            read (l,sizeof(Integer));
            setlength(s,l);
            read (s[1],l);

            SetGridCell('专辑',s,i);
            //Read Year
            read (l,sizeof(Integer));
            setlength(s,l);
            read (s[1],l);

            SetGridCell('出版年',s,i);
            //Read Genre
            read (g,SizeOf(integer));

            SetGridCell('流派',GetGenreName(g),i);
          end;
        end;
      finally
        free;
      end;
  end;
end;

procedure TMainFrm.ResetNo(start:integer);
var i:integer;
begin
   for i:=start to listbox1.Items.Count-1 do
     listbox1.Items[i]:=formatstr(inttostr(i+1),4,false,true)+'.'+Getfilename(i);
end;
Function FormatStr(S:string;pLen:integer;posLeft,useSpace:boolean):string;   //将字符串射为指定长度，不够用空格(' ')或'0'替代
var
  i:integer;
  insertChar:char;
begin
  if useSpace then
    insertChar:=' '
  else
    insertChar:='0';
  for i:=1 to pLen-Length(s) do
    if posLeft then
      Insert(insertChar,S,0)
    else
      Insert(InsertChar,S,Length(s)+1);
  FormatStr:=S;
end;
//汉字与拼音的转换
function TMainFrm.GetPYIndexChar( hzchar:string):char;
var js:word;
begin
   js:=WORD(hzchar[1]) shl 8 + WORD(hzchar[2]);
  case js of
    $B0A1..$B0C4 : result := 'A';
    $B0C5..$B2C0 : result := 'B';
    $B2C1..$B4ED : result := 'C';
    $B4EE..$B6E9 : result := 'D';
    $B6EA..$B7A1 : result := 'E';
    $B7A2..$B8C0 : result := 'F';
    $B8C1..$B9FD : result := 'G';
    $B9FE..$BBF6 : result := 'H';
    $BBF7..$BFA5 : result := 'J';
    $BFA6..$C0AB : result := 'K';
    $C0AC..$C2E7 : result := 'L';
    $C2E8..$C4C2 : result := 'M';
    $C4C3..$C5B5 : result := 'N';
    $C5B6..$C5BD : result := 'O';
    $C5BE..$C6D9 : result := 'P';
    $C6DA..$C8BA : result := 'Q';
    $C8BB..$C8F5 : result := 'R';
    $C8F6..$CBF9 : result := 'S';
    $CBFA..$CDD9 : result := 'T';
    $CDDA..$CEF3 : result := 'W';
    $CEF4..$D1B8 : result := 'X';
    $D1B9..$D4D0 : result := 'Y';
    $D4D1..$D7F9 : result := 'Z';
  else
       result := char(32);
  end;


end;
function TMainFrm.chintoeng(chinese:string):string;
var
  I: Integer;
  PY: string;
  s: string;
begin
 s := '' ;
 I := 1;
 try
   while I <= Length(Chinese) do
   begin
     PY := Copy(Chinese, I , 1);
     if PY >= Chr(128) then
     begin
       Inc(I);
       PY := PY + Copy(Chinese, I , 1);
 //      if chinlist.FindRow(PY,vRow) then
  //       s := s+ chinlist.values[PY]
 //      else
         s := s + GetPYIndexChar(PY);
     end
     else
       s:=s + PY;
     Inc(I);
   end;
   result:=s;
 except
   result:='';
   raise exception.create('汉字转换失败');
 end;
end;

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

end;

procedure TMainFrm.ListBox1KeyPress(Sender: TObject; var Key: Char);
begin
  if (key<>#13) and (sglist.EditorMode=false) then
  begin
      if not pyEdit.Visible then
        pyEdit.Visible :=true;
      PYEdit.text:=key;
      PYEdit.SetFocus;
      PYEdit.selstart:=1;
      PYEdit.SelLength :=0;
  end;

end;

procedure TMainFrm.sglistDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  with Sender as TStringGrid do
  begin
    if mnulistback.Checked then
    //  if (arow>=TopRow-1) and (aCol >=LeftCol-1)
    //    and (arow<=TopRow-1+VisibleRowCount) and (aCol<=LeftCol-1+VisibleColCount) then
    begin
        Brush.Bitmap :=ListBmp;
        FillRect(Canvas.Handle,Rect , Brush.handle );
    end
    else
      Brush.Bitmap :=nil;
    if not mnulistBack.Checked then
    begin
      if (Arow=0) then   //or (ACol=0)
        Canvas.Brush.Color := fixedColor
      else
      begin
        if ARow mod 2 =0 then
          Canvas.Brush.Color := $00E0CDBA
        else
          Canvas.Brush.Color :=$00C9E0C9;
      end;
    end;

    if mnulistBack.Checked then
      canvas.Brush.Style:=bsClear
    else
      canvas.Brush.Style:=bsSolid;
      
    canvas.Font.Name :='宋体';
    canvas.Font.Size :=9;
    if ARow=0 then
      canvas.Font.Color :=clnavy
    else
    begin
      if (acol<=Selection.right) and (acol>=Selection.left) and
        (arow>=Selection.top) and (arow <=Selection.bottom) then
        begin  //选取的行
         if (ARow=PlayItem+1) and (playerstate<>psClosed) and (uppercase(GetGridCell('全名',ARow))=uppercase(playfilename)) then
         begin   //正在播放的
           if not mnulistBack.Checked then
             Canvas.Brush.Color :=clPurple;