main.pas

来自「mp3 播放器 delphi 源码」· PAS 代码 · 共 1,262 行 · 第 1/5 页

  ButtonID3Tag.SetBounds(ButtonSelect.Left+i1,1,i1,ButtonExit.Height);
  ButtonPassword.SetBounds(ButtonID3Tag.Left+i1,1,i1,ButtonExit.Height);
  ButtonOptions.SetBounds(ButtonPassword.Left+i1,1,i1,ButtonExit.Height);
  ButtonAbout.SetBounds(ButtonOptions.Left+i1,1,i1,ButtonExit.Height);
end;

procedure TMainForm.PlayerPanel_OnResize(Sender: TObject);
begin
  ButtonSong.Width:=SongPanel.Width-ButtonSong.Left-8;
  PosPanel2.Width:=PosPanel.Width-PosFlatButton.Width-2;
  LabelInfo.Left:=PosPanel2.Width-LabelInfo.Width-8;
  ScrollBar.Width:=PosPanel2.Width-ScrollBar.Left-32;
  ScrollPosLabel.Left:=ScrollBar.Left+ScrollBar.Width+4;
end;

procedure TMainForm.MemoPanel_OnResize(Sender: TObject);
begin MemoFlatButton.Height:=MemoPanel.Height-7; Memo.SetBounds(17,3,MemoPanel.Width-19,MemoPanel.Height-6); end;

procedure TMainForm.SearchPanelLeft_OnResize(Sender: TObject);
begin SearchEditLeft.Width:=SearchPanelLeft.Width-5; end;

procedure TMainForm.SearchPanelRight_OnResize(Sender: TObject);
begin SearchEditRight.Width:=SearchPanelRight.Width-5; end;

procedure TMainForm.ButtonExit_OnClick(Sender: TObject);
begin Close; end;

procedure TMainForm.ButtonOpen_OnClick(Sender: TObject);
begin
  If (IsNowProtected)and(NeedPwForOpenPlaylist) then begin MsgNotAllowed; Exit; end;
  With OpenDialog do begin
    If FileExists(PlaylistFileCom) then begin InitialDir:=ExtractFilePath(PlaylistFileCom); Filename:=ExtractFileName(PlaylistFileCom); end
    else begin InitialDir:=StartDir; Filename:=''; end;
    If Execute then ReadPlaylistfile(ExpandFileName(Filename),true);
  end;
end;

procedure TMainForm.ButtonAdd_OnClick(Sender: TObject);
var s1, s2, s3: string; 
begin
  If (IsNowProtected)and(NeedPwForOpenPlaylist) then begin MsgNotAllowed; Exit; end;
  With AddDialog do begin
    If FileExists(PlaylistFileCom) then InitialDir:=ExtractFilePath(PlaylistFileCom) else InitialDir:=StartDir; Filename:='';
    If Execute then begin Update;
      s1:=Trim(ExpandFileName(Filename)); s2:=LowerCase(Trim(ExtractFileExt(s1)));
      If Length(s2)>0 then begin
        If (s2='.mp1')or(s2='.mp2')or(s2='.mp3')or(s2='.mp4')or(s2='.mpg')or(s2='.mpeg') then begin // add mp3-file [*.MP3]
          s3:=ExtractFileName(s1); Delete(s3,Length(s3)-Length(s2)+1,Length(s2)+1);
          Try AddToSongList(0,s1,true,s3).MakeVisible(false); Except end;
        end else ReadPlaylistfile(s1,false); // add playlistfile [*.M3U] or [*.PLS]
      end;
    end;
  end;
end;

procedure TMainForm.ButtonSave_OnClick(Sender: TObject);
var b1, b2: boolean; i1, FileKind {0=TXT 1=M3U 2=PLS 3=Html}: integer; s1, s2: string; t1: textfile; MpegFile1: TMpegAudio;
    HtmShowCaption, HtmShowHeader: boolean;
    HtmCaptionSize, HtmCaptionAlign,
    HtmMainTextcolor, HtmMainBackcolor, HtmTableTextcolor, HtmTableBackcolor, HtmHeaderTextcolor, HtmHeaderBackcolor: Tcolor;
    HtmTabBorder, HtmTabWidth, HtmTabCellspacing, HtmTabCellpadding: integer;
    HtmTabAlign, HtmTabValign, HtmTitle: string;

  function ColorToBrowserString(ThisColor: Tcolor): string;
  begin
    Result:=ColorToString(ThisColor);
    If Length(Result)>0 then If Result[1]='$' then Result[1]:='#';
    If Length(Result)>2 then If (UpCase(Result[1])='C')and(UpCase(Result[2])='L') then Delete(Result,1,2);
  end;

begin
  If (IsNowProtected)and(NeedPwForSavePlaylist) then begin MsgNotAllowed; Exit; end;
  With SaveDialog do begin
    If FileExists(PlaylistFileCom) then begin
      InitialDir:=ExtractFilePath(PlaylistFileCom);
      s1:=ExtractFileName(PlaylistFileCom); s2:=Trim(ExtractFileExt(s1)); If Length(s2)>0 then Delete(s1,Length(s1)-Length(s2)+1,Length(s2)+1);
      Filename:=s1; DefaultExt:=Filter[FilterIndex];
    end else begin InitialDir:=StartDir; Filename:=''; end;    
    If Execute then begin b2:=true; FileKind:=0;
      If (LowerCase(Trim(ExtractFileExt(Filename)))='.htm')or(LowerCase(Trim(ExtractFileExt(Filename)))='.html') then begin // save as Html-Document
        With TSaveHtmlForm.Create(Self) do Try // extended styles for Html-Documents
          LabelFile.Caption:=LowerCase(ExpandFileName(Filename));
          i1:=ShowModal;
          If i1=mrOk then begin FileKind:=3;
            HtmTitle:=EditTitle.Text; HtmShowCaption:=CheckBoxCaption.Checked;
            HtmCaptionSize:=ComboBoxCaptionSize.ItemIndex; HtmCaptionAlign:=ComboBoxCaptionAlign.ItemIndex;
            HtmMainTextcolor:=MainColorsPanel.Font.Color; HtmMainBackcolor:=MainColorsPanel.Color;
            HtmTableTextcolor:=TableColorsPanel.Font.Color; HtmTableBackcolor:=TableColorsPanel.Color;
            HtmHeaderTextcolor:=HeaderColorPanel.Font.Color; HtmHeaderBackcolor:=HeaderColorPanel.Color;
            HtmShowHeader:=CheckBoxShowHeader.Checked;
            HtmTabBorder:=TableBorderUpDown.Position; HtmTabWidth:=TableWidthUpDown.Position;
            HtmTabCellspacing:=TableCellspacingUpDown.Position; HtmTabCellpadding:=TableCellpaddingUpDown.Position;
            Case TableAlignComboBox.ItemIndex of 1: HtmTabAlign:='center'; 2: HtmTabAlign:='right'; else HtmTabAlign:='left'; end;
            Case TableValignComboBox.ItemIndex of 0: HtmTabValign:='top'; 2: HtmTabValign:='bottom'; else HtmTabValign:='center'; end;
          end;
        Finally Free; end;
        If i1<>mrOk then Exit; // abort, don't save anything
      end; 
      AssignFile(t1,ExpandFileName(Filename)); {$I-} Rewrite(t1); {$I+}
      If IoResult<>0 then begin b1:=false; MessageBox(Handle,'Can''t write the chosen file...','Write-Error',MB_IconError+MB_Ok+MB_SetForeground) end else begin
        Screen.Cursor:=crHourGlass; Gauge.Progress:=0; GaugePanel.Visible:=true; GaugePanel.Update; Self.Update; b1:=true;
        If LowerCase(Trim(ExtractFileExt(Filename)))='.m3u' then begin // EXTM3U-header
          b2:=not PlayUseID3Tags;
          FileKind:=1; PlaylistFileCom:=ExpandFileName(Filename);
          WriteLn(t1,'#EXTM3U');
        end else
        If LowerCase(Trim(ExtractFileExt(Filename)))='.pls' then begin // PLS-header
          FileKind:=2; PlaylistFileCom:=ExpandFileName(Filename);
          WriteLn(t1,'[playlist]');
        end else
        If (LowerCase(Trim(ExtractFileExt(Filename)))='.htm')or(LowerCase(Trim(ExtractFileExt(Filename)))='.html')or(FileKind=3) then begin // HTML-header
          FileKind:=3;
          WriteLn(t1,'<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">');
          WriteLn(t1,'<html>');
          WriteLn(t1,'<head>'); WriteLn(t1,'<title>'+HtmTitle+'</title>'); WriteLn(t1,'</head>');
          WriteLn(t1,'<body text="'+ColorToBrowserString(HtmMainTextcolor)+'" bgcolor="'+ColorToBrowserString(HtmMainBackcolor)+'">');
          If HtmShowCaption then begin
            Case HtmCaptionAlign of 0: WriteLn(t1,'<div align=left>'); 2: WriteLn(t1,'<div align=right>'); else WriteLn(t1,'<div align=center>'); end;
            WriteLn(t1,'  <h'+IntToStr(HtmCaptionSize+1)+'>'+HtmTitle+'</h'+IntToStr(HtmCaptionSize+1)+'>');
            WriteLn(t1,'</div>');
          end;
          WriteLn(t1,'<div align=center>');
          WriteLn(t1,'  <table border='+IntToStr(HtmTabBorder)+' cellpadding='+IntToStr(HtmTabCellpadding)+' cellspacing='+IntToStr(HtmTabCellspacing)+' width="'+IntToStr(HtmTabWidth)+'%">');
          If HtmShowHeader then begin
            WriteLn(t1,'    <tr align='+HtmTabAlign+' valign='+HtmTabValign+' bgcolor="'+ColorToBrowserString(HtmHeaderBackcolor)+'"> <td>');
            WriteLn(t1,'      <font color="'+ColorToBrowserString(HtmHeaderTextcolor)+'">');
            WriteLn(t1,'        '+HtmTitle);
            WriteLn(t1,'      </font>');
            WriteLn(t1,'    </td> </tr>');
          end;
        end else FileKind:=0; // none header for textfiles
        MpegFile1:=TMpegAudio.Create;
        Try
          For i1:=0 to pred(ListViewLeft.Items.Count) do If FileExists(ListViewLeft.Items[i1].SubItems[0]) then begin
            Gauge.Progress:=GetProcent(pred(ListViewLeft.Items.Count),i1); Gauge.Update;
            Case FileKind of
              1: Try // save as EXTM3U-Playlist
                   If b2 then WriteLn(t1,'#EXTINF:0,'+ListViewLeft.Items[i1].Caption) else begin
                     MpegFile1.Filename:=ListViewLeft.Items[i1].SubItems[0];
                     WriteLn(t1,'#EXTINF:'+FormatFloat('#000',MpegFile1.Duration)+','+ListViewLeft.Items[i1].Caption);
                   end;
                   WriteLn(t1,ListViewLeft.Items[i1].SubItems[0]);
                 Except; end;
              2: begin // save as PLS-Playlist
                   WriteLn(t1,'File'+IntToStr(i1+1)+'='+ListViewLeft.Items[i1].SubItems[0]);
                   WriteLn(t1,'Title'+IntToStr(i1+1)+'='+ListViewLeft.Items[i1].Caption);
                 end;
              3: begin // save as Html-Document
                   WriteLn(t1,'    <tr align='+HtmTabAlign+' valign='+HtmTabValign+' bgcolor="'+ColorToBrowserString(HtmTableBackcolor)+'"> <td>');
                   WriteLn(t1,'      <font color="'+ColorToBrowserString(HtmTableTextcolor)+'">');
                   WriteLn(t1,'        '+ListViewLeft.Items[i1].Caption);
                   WriteLn(t1,'      </font>');
                   WriteLn(t1,'    </td> </tr>');
                 end;
              else WriteLn(t1,ListViewLeft.Items[i1].Caption); // save as textfile
            end;
          end;
        Finally MpegFile1.Free; end;
        Case FileKind of
          2: begin // write endheader for PLS-files
               WriteLn(t1,'NumberOfEntries='+IntToStr(ListViewLeft.Items.Count)); WriteLn(t1,'Version=2');
             end;
          3: begin // write end of Html-Document
               WriteLn(t1,'  </table>'); WriteLn(t1,'</div>'); WriteLn(t1,'</body>'); WriteLn(t1,'</html>');
             end;
        end;
        GaugePanel.Visible:=false; Screen.Cursor:=crDefault;
      end;
      {$I-} CloseFile(t1); {$I+}
      If (IoResult<>0)and(b1) then MessageBox(Handle,'Can''t write into the chosen file...','Save-Error',MB_IconError+MB_Ok+MB_SetForeground);
    end;
  end;
end;

procedure TMainForm.SaveDialog_OnTypeChange(Sender: TObject);
begin If SaveDialog.FilterIndex=1 then SaveDialog.DefaultExt:='txt' else SaveDialog.DefaultExt:='m3u'; end;

procedure TMainForm.ButtonAddDir_OnClick(Sender: TObject);
var s1: string;

  procedure ReadDirContens(sDir,sName: string; ReadID3TagsForSongnames, RecursivInclSubdirs: boolean);
  var DosError: integer; tsr1: TSearchRec;
  begin
    If sDir>'' then If sDir[Length(sDir)]<>'\' then sDir:=sDir+'\';
    DosError:=FindFirst(sDir+sName,faAnyFile mod faDirectory,tsr1); // first read files
    While (DosError=0)and(not Application.Terminated) do begin
      MainForm.AddToSongList(0,sDir+tsr1.name,ReadID3TagsForSongnames,'');
      Application.ProcessMessages;
      DosError:=FindNext(tsr1);
      Application.ProcessMessages;
    end;
    FindClose(tsr1);
    If RecursivInclSubdirs then begin // than read directories if it should read recursive (incl. all subdirs)
      DosError:=FindFirst(sDir+'*.*',faDirectory,tsr1);
      While (DosError=0)and(not Application.Terminated) do begin
        If (tsr1.Attr and faDirectory=faDirectory) and (tsr1.Name[1]<>'.') then begin
          ReadDirContens(sDir+tsr1.Name,sName,ReadID3TagsForSongnames,RecursivInclSubdirs); // recursive!
        end;
        DosError:=FindNext(tsr1);
        Application.ProcessMessages;
      end;
      FindClose(tsr1);
    end;
  end;

begin
  If (IsNowProtected)and(NeedPwForAddDir) then begin MsgNotAllowed; Exit; end;
  With TAddDirForm.Create(Self) do Try If ShowModal=mrOk then begin Screen.Cursor:=crHourGlass;
    If CheckBoxClear.Checked then MainForm.ListViewLeft.Items.Clear;
    s1:=Trim(ComboBoxFilter.Text); If s1='' then s1:='*.*';
    ReadDirContens(EditDir.Text,s1,CheckBoxID3Tags.Checked,CheckBoxRecursiv.Checked);
    If CheckBoxSort.Checked then ListView_OnColumnClick(ListViewLeft,ListViewLeft.Columns[0]);    
  end; Finally Free; Screen.Cursor:=crDefault; end;
end;

procedure TMainForm.ButtonSelect_OnClick(Sender: TObject);
var tp1: TPoint;
begin
  tp1.X:=ButtonSelect.Left; tp1.Y:=ButtonSelect.Top+ButtonSelect.Height;
  tp1:=ButtonPanel1.ClientToScreen(tp1); SelectPopupMenu.Popup(tp1.X,tp1.Y);
end;

procedure TMainForm.ButtonID3Tag_OnClick(Sender: TObject);
begin
  If (IsNowProtected)and(MeedPwForViewID3Tag) then begin MsgNotAllowed; Exit; end;
  If ActiveControl=ListViewLeft then begin
    If ListViewLeft.Selected=nil then Exit else begin ID3TagForm_TitleStr:=ListViewLeft.Selected.Caption; ID3TagForm_MpgFileCom:=ListViewLeft.Selected.SubItems[0]; end;
  end else
  If ActiveControl=ListViewRight then begin
    If ListViewRight.Selected=nil then Exit else begin ID3TagForm_TitleStr:=ListViewRight.Selected.Caption; ID3TagForm_MpgFileCom:=ListViewRight.Selected.SubItems[0]; end;
  end else Exit;
  With TID3TagForm.Create(Self) do Try ShowModal; Finally Free; end;
end;

procedure TMainForm.ButtonPassword_OnClick(Sender: TObject);
var s1: string;
begin
  If (PasswordStr='') then begin
    ButtonPassword.Down:=false;
    MessageBox(Handle,PChar('None pw is given.'+#13+'Go to the Options to enter password.'),'Protection is disabled...',MB_IconInformation+MB_Ok+MB_SetForeground);
    Exit;
  end;
  If IsNowProtected then begin
    If InputQuery('Passwordprotection','Enter the whole password:',s1) then begin
      If s1=PasswordStr then begin
        ButtonPassword.Down:=false; IsNowProtected:=false;
      end else begin ButtonPassword.Down:=true; IsNowProtected:=true; end;
    end else begin ButtonPassword.Down:=true; IsNowProtected:=true; end;
  end else begin ButtonPassword.Down:=true; IsNowProtected:=true; end;
end;

procedure TMainForm.ButtonOptions_OnClick(Sender: TObject);
begin