main.pas

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

      MeedPwForViewID3Tag: boolean = false;
      MeedPwForEditID3Tag: boolean = true;
      NeedPwForAddSel: boolean = false;
      NeedPwForAddAll: boolean = false;
      NeedPwForRemoveSel: boolean = false;
      NeedPwForRemoveAll: boolean = false;
      NeedPwForPlay: boolean = false;
      NeedPwForPause: boolean = false;
      NeedPwForStop: boolean = false;
      NeedPwForBack: boolean = false;
      NeedPwForNext: boolean = false;
      // Main
      singleinstance: boolean = true;
      mainwindowstate: integer = 0;
      mainzoom: boolean = true;
      maincenter: boolean = false;

function BoolToStr(BooleanWert: boolean): string;
function MilliSecondsToString(MilliSeconds: integer): string;
function GetProcent(BigInt, SmallInt: longint): integer;
function FileIsReadOnly(FileCom: string): boolean;
function ExpandFileCom(var FileCom: string; var Parameter: string): integer;
function GetLinesCount(OfTextFile: string): integer;

IMPLEMENTATION

uses AddDir, SaveHtml, ID3tag, Settings, SelGroup, About;

{$R *.DFM}          

function BoolToStr(BooleanWert: boolean): string;
begin If BooleanWert then Result:='1' else Result:='0'; end;
  
function MilliSecondsToString(MilliSeconds: integer): string;
var i1, i2: integer;
begin i1:=(MilliSeconds div 1000) div 60; i2:=(MilliSeconds div 1000)-(i1*60); Result:=FormatFloat('00',i1)+':'+FormatFloat('00',i2); end;

function GetProcent(BigInt, SmallInt: longint): integer;
var ExtReal1, ExtReal2: extended;
begin Try ExtReal1:=BigInt; ExtReal2:=SmallInt; Result:=Round((ExtReal2 * 100) / ExtReal1); Except Result:=0; end; end; 

function FileIsReadOnly(FileCom: string): boolean;
var tsr1: TSearchRec;
begin
  If FindFirst(FileCom,faAnyFile,tsr1)=0 then Result:=(tsr1.Attr and faReadOnly > 0) else Result:=false;
  FindClose(tsr1);
end;


// Expands an relative file-/directory-/Parameter-name
// Results are:
//   0 = Error: file/dir unknown
//   1 = Successfull: file found
//   2 = Successfull: directory found
//   3 = Successfull: Commandlineparams found (result in var Parameter: string)
function ExpandFileCom(var FileCom: string; var Parameter: string): integer;
var i1: integer; s1, s2, s3: string;
begin
  Result:=0; Parameter:=''; s1:=Trim(FileCom); If s1='' then Exit else If s1[1]='\' then Delete(s1,1,1);
  If FileExists(s1) then begin Result:=1; FileCom:=ExpandFileName(s1); end else
  If DirectoryExists(s1) then begin Result:=2; FileCom:=ExpandFileName(s1) end else
  If FileExists(ExtractFilePath(ParamStr(0))+s1) then begin Result:=1; FileCom:=ExtractFilePath(ParamStr(0))+s1; end else
  If DirectoryExists(ExtractFilePath(ParamStr(0))+s1) then begin Result:=2; FileCom:=ExtractFilePath(ParamStr(0))+s1; end else
  If FileExists(ParamStr(0)[1]+':\'+s1) then begin Result:=1; FileCom:=ParamStr(0)[1]+':\'+s1 end else
  If DirectoryExists(ParamStr(0)[1]+':\'+s1) then begin Result:=2; FileCom:=ParamStr(0)[1]+':\'+s1 end else begin
    i1:=Pos('|',s1); If i1<1 then Result:=0 else begin
    s2:=copy(s1,1,i1); If s2>'' then begin If s2[Length(s2)]='|' then Delete(s2,Length(s2),1); ExpandFileCom(s2,s3); end;
    Delete(s1,1,i1); If s1>'' then begin If s1[1]='|' then Delete(s1,1,1); ExpandFileCom(s1,s3); end;
    FileCom:=s2; Parameter:=s1; Result:=3;
  end; end;
end;

function GetLinesCount(OfTextFile: string): integer;
var file1: textfile;
begin
  Result:=-1; AssignFile(file1,OfTextFile); {$I-} Reset(file1); {$I+}
  If IoResult=0 then begin Result:=0; While not Eof(file1) do begin ReadLn(file1); inc(Result); end; end;
  {$I-} CloseFile(file1); {$I+}
end;

procedure TMainForm.WMSysCommand(var Message: TMessage);
begin
  Case Message.WParam of
    SC_MINIMIZE: If mainwindowstate=2 then TrayMinimized else If mainzoom then ZoomMinimized else inherited;
    SC_CLOSE: Close;
    else inherited;
  end;
end;

procedure TMainForm.ZoomMinimized;
begin Application.NormalizeTopMosts; SetActiveWindow(Application.Handle); SetWindowPos(Application.Handle,HWND_BOTTOM,Left,Top,Width,0,SWP_NOACTIVATE); ShowWindow(Application.Handle,SW_MINIMIZE); end;

procedure TMainForm.ZoomRestore;
begin SetActiveWindow(Application.Handle); ShowWindow(Application.Handle,SW_RESTORE); SetWindowPos(Application.Handle,HWND_TOP,Screen.Width div 2,Screen.Height div 2,0,0,SWP_NOACTIVATE); Application.RestoreTopMosts; end;

procedure TMainForm.TrayMinimized;
begin Visible:=false; Update; end;

procedure TMainForm.TrayRestore(MakeVisibleTrue: boolean);
begin If MakeVisibleTrue then Visible:=true; Application.BringToFront; SetActiveWindow(Application.Handle); Update; end;

procedure TMainForm.WndProc(var Message: TMessage);
begin
  With Message do Case Msg of
    WM_SYSTRAY: Case LParam of
                  WM_LBUTTONDOWN: If Visible then TrayMinimized else TrayRestore(true);
                  WM_RBUTTONDOWN: TrayRestore(not Visible);
                end
    else Result:=DefWindowProc(TrayIconHandle,Msg,wParam,lParam);
  end;
end;

procedure TMainForm.AppMessage(var Msg: TMsg; var Erledigt: Boolean);
begin
  Case Msg.Message of
    WM_SYSCOMMAND: Case Msg.wParam of
                     SC_RESTORE: If mainwindowstate=2 then begin TrayRestore(true); Erledigt:=true; end else
                                 If mainzoom then begin ZoomRestore; Erledigt:=true; end else Erledigt:=false;
                     SC_MINIMIZE: If mainwindowstate=2 then begin TrayMinimized; Erledigt:=true; end else
                                  If mainzoom then begin ZoomMinimized; Erledigt:=true; end else Erledigt:=false;
                   end;
    WM_PAINT: If mainwindowstate=2 then ShowWindow(Application.Handle,SW_HIDE); // for the trayicon (hide appsymbol)
  end;
end;

procedure TMainForm.MsgNotAllowed;
begin MessageBox(Handle,'Need first to deactivate the pw-protection.','Not allowed...',MB_IconStop+MB_Ok+MB_SetForeground); end;

// the fontstring is: "<fontcolor:integer>;<fontsize:integer>;<fontbold:bool>;<fontitalic:bool>;<fontunderline:bool>;<fontstrikeout:bool>;<fontname:string>"
function TMainForm.FontToString(ThisFont: TFont): string;
begin
  Result:=IntToStr(ThisFont.Color)+';'+IntToStr(ThisFont.Size)+';'+
          BoolToStr(fsBold in ThisFont.Style)+';'+
          BoolToStr(fsItalic in ThisFont.Style)+';'+
          BoolToStr(fsUnderline in ThisFont.Style)+';'+
          BoolToStr(fsStrikeOut in ThisFont.Style)+';'+
          ThisFont.Name;
end;

function TMainForm.StringToFont(ThisString: string; var ToThisFont: TFont): boolean;
var b1: boolean; i1, i2, i3, i4: integer; s1: string;
begin
  Result:=false; ThisString:=Trim(ThisString); If ThisString='' then Exit; i1:=1;
  Repeat
    i2:=Pos(';',ThisString);
    If i2>0 then begin s1:=copy(ThisString,1,i2-1); delete(ThisString,1,i2); ThisString:=Trim(ThisString); end else s1:=ThisString;
    b1:=true;
    Case i1 of
      1: begin Val(s1,i3,i4); If i4=0 then ToThisFont.Color:=i3; end;
      2: begin Val(s1,i3,i4); If i4=0 then ToThisFont.Size:=i3; end;
      3: begin Val(s1,i3,i4); If i4=0 then Case i3 of 0: ToThisFont.Style:=[]; 1: ToThisFont.Style:=[fsBold]; end; end;
      4: begin Val(s1,i3,i4); If i4=0 then If i3=1 then ToThisFont.Style:=ToThisFont.Style+[fsItalic]; end;
      5: begin Val(s1,i3,i4); If i4=0 then If i3=1 then ToThisFont.Style:=ToThisFont.Style+[fsUnderline]; end;
      6: begin Val(s1,i3,i4); If i4=0 then If i3=1 then ToThisFont.Style:=ToThisFont.Style+[fsStrikeOut]; end;
      7: If s1>'' then ToThisFont.Name:=s1; 
      else b1:=false;
    end;
    If b1 then inc(i1);
  until (ThisString='')or(i1>7);
  Result:=i1>7;
end;

function TMainForm.AddToSongList(ToListKind {0=leftlist 1=rightlist insertfirst 2=rightlist append}: integer; Mp3file: string; GetSongnameFromID3Tag: boolean; UseThisSongname: string): TListItem;
var b1: boolean; s1, s2: string; li1: TListItem;
begin
  Result:=nil; If not FileExists(Mp3file) then Exit; b1:=false;
  If GetSongnameFromID3Tag then begin MpgAudio.FileName:=Mp3file;
    If MpgAudio.IsValid then If MpgAudio.isTagged then begin s1:=Trim(MpgAudio.Artist);
      If (s1>'')and(Trim(MpgAudio.Title)>'') then s1:=s1+' - '+Trim(MpgAudio.Title) else
      If (s1='')and(Trim(MpgAudio.Title)>'') then s1:=Trim(MpgAudio.Title);
      If Length(s1)>0 then b1:=true;
  end; end;
  If not b1 then begin If UseThisSongname>'' then s1:=UseThisSongname else begin    
    s1:=ExtractFileName(Mp3file); s2:=ExtractFileExt(s1);
    If Length(s2)>0 then Delete(s1,Length(s1)-Length(s2)+1,Length(s2));
  end; end;
  Case ToListKind of 1: li1:=ListViewRight.Items.Insert(0); 2: li1:=ListViewRight.Items.Add; else li1:=ListViewLeft.Items.Add; end;
  li1.Caption:=s1; li1.SubItems.Add(Mp3file); Result:=li1;
  Application.ProcessMessages;
end;

procedure TMainForm.SetFontOrColor(SetNr: integer; SetThisFont: TFont; SetThisColor: TColor);
var font1: TFont;
begin
  Case SetNr of
    10: begin font1:=TFont.Create; Try // default fonts
          font1.Name:='MS Sans Serif'; font1.Size:=8; font1.Color:=clWindowText; font1.Style:=[];
          Font:=font1; ListViewLeft.Font:=font1; ListViewRight.Font:=font1; Memo.Font:=font1;
        Finally font1.Free; end; end;
    11: If SetThisFont<>nil then Font:=SetThisFont; // main-font
    12: If SetThisFont<>nil then ListViewLeft.Font:=SetThisFont; // leftlist-font
    13: If SetThisFont<>nil then ListViewRight.Font:=SetThisFont; // rightlist-font
    100: begin // default colors
           Color:=clBtnFace; ListViewLeft.Color:=clBtnFace; ListViewRight.Color:=clBtnFace; Memo.Color:=clBtnFace;
           ButtonSong.Font.Color:=clNavy; LabelInfo.Font.Color:=clNavy; LabelNow.Font.Color:=clNavy; LabelRem.Font.Color:=clNavy; LabelTotal.Font.Color:=clNavy; ScrollPosLabel.Font.Color:=clNavy;
         end;
    101: If SetThisColor>=0 then Color:=SetThisColor; // main-color
    102: If SetThisColor>=0 then ListViewLeft.Color:=SetThisColor; // leftlist-color
    103: If SetThisColor>=0 then ListViewRight.Color:=SetThisColor; // rightlist-color
    104: If SetThisColor>=0 then begin // highlighted player-color
           ButtonSong.Font.Color:=SetThisColor; LabelInfo.Font.Color:=SetThisColor; LabelNow.Font.Color:=SetThisColor; LabelRem.Font.Color:=SetThisColor; LabelTotal.Font.Color:=SetThisColor; ScrollPosLabel.Font.Color:=SetThisColor;
         end;
  end;
end;

// executes a file or dir (use "|" to split the execstring and the commandlineparams for this execstring !)
procedure TMainForm.ExecuteCom(ExecuteStr: string; ShowState: integer; ShowErrorMsg: boolean);
var s1: string; sei: TShellExecuteInfo;
begin
  s1:=''; ExpandFileCom(ExecuteStr,s1);
  With sei do begin
    FillChar(sei,SizeOf(sei),0);
    cbSize:=SizeOf(sei);
    fMask:=SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI;
    lpFile:=PChar(ExecuteStr);
    lpDirectory:=PChar(ExtractFilePath(ExecuteStr));
    lpParameters:=PChar(s1);
    nShow:=ShowState;
  end;
  If not ShellExecuteEx(@sei) then If ShowErrorMsg then begin
    Case GetLastError of
      ERROR_FILE_NOT_FOUND: s1:='The specified file or dir was not found.';
      ERROR_PATH_NOT_FOUND: s1:='The specified path was not found.';
      ERROR_DDE_FAIL: s1:='The DDE transaction failed.';
      ERROR_NO_ASSOCIATION: s1:='There is no application associated with the given filename extension.';
      ERROR_ACCESS_DENIED: s1:='Access denied.';
      ERROR_DLL_NOT_FOUND: s1:='DLL-file not found.';
      ERROR_CANCELLED: s1:='The function prompted the user for the location of the application, but the user cancelled the request.';
      ERROR_NOT_ENOUGH_MEMORY: s1:='Not enough memory.';
      ERROR_SHARING_VIOLATION: s1:='sharing violation.';
      else s1:='unknown Error...';
    end;
    MessageBox(0,PChar(s1),'Can''t go to web...',MB_IconStop+MB_Ok+MB_SetForeground+MB_ApplModal);
    Exit;
  end;
end;

procedure TMainForm.ReadPlaylistfile(ThisPlaylistFileCom: string; ClearListBeforeAdding: boolean);
var b1, b2, b3: boolean; i1, i2, i3, PlaylistKind {0=None 1=Unknown 2=M3U 3=PLS}, LineCount1, Line1: integer;
    s1, s2, s3, s4, s9: string; t1: textfile;
begin
  If not FileExists(ThisPlaylistFileCom) then Exit; Update;  
  LineCount1:=GetLinesCount(ThisPlaylistFileCom);
  AssignFile(t1,ExpandFileName(ThisPlaylistFileCom)); {$I-} Reset(t1); {$I+}
  If IoResult<>0 then MessageDlg('Can''t open the chosen Playlistfile...',mtError,[mbOk],0) else begin
    Screen.Cursor:=crHourGlass;
    If ClearListBeforeAdding then ListViewLeft.Items.Clear;
    Gauge.Progress:=0; GaugePanel.Visible:=true; GaugePanel.Update; Self.Update;
    PlaylistFileCom:=ExpandFileName(ThisPlaylistFileCom);
    s1:=ExtractFilePath(PlaylistFileCom); If s1[Length(s1)]<>'\' then s1:=s1+'\';
    PlaylistKind:=0; b2:=false; b3:=false; Line1:=0; 
    While (not Eof(t1))and(not Application.Terminated) do begin
      inc(Line1); Gauge.Progress:=GetProcent(LineCount1,Line1); Gauge.Update;