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

📄 comfunction.pas

📁 delphi2007写的播放器源码。效果类似于千千静听。
💻 PAS
字号:
unit ComFunction;

interface

uses ComVariable,windows,SysUtils,Forms,ExtCtrls,inifiles,Controls,
Graphics,Dialogs,StrUtils,classes,bass,tags;



function FaceInitialization(form:TForm;FileName:string;var Arr:Array of TControls):boolean;
function SetConProp(Con:TControl;Index:integer;var Arr:Array of TControls):boolean;
function ReadPorperty(FileName,Title:string;Index:integer;var Arr:Array of TControls):Boolean;
procedure Painting(Con:TImage;var Arr:Array of TControls;Num:Integer);
procedure LoadConfig;
procedure LoadTitleConfig;
procedure DirToSkins(Directory:string;IncludeFiles:Boolean);
procedure MakeFileList(Path,FileExt,FindString:string;findFiles:boolean);
procedure  LoadTitle(temp:TImage;temp2:TTitle);
procedure LoadPlayList;
procedure SavePlayList;
procedure SaveConfig;
function GetTag(FileName:string):string;

implementation

uses main;


function GetTag(FileName:string):string;
var
  channel:DWORD;
begin

  Channel := Bass_StreamCreateFile(false, PChar(FileName), 0, 0, Bass_Stream_Decode);
  if Channel = 0 then
    exit;

  FileTag.Title:=TAGS_Read(Channel,'%TITL');
  FileTag.Artist:=TAGS_Read(Channel,'%ARTI');
  FileTag.Album:=TAGS_Read(Channel,'%ALBM');
  FileTag.Year:=TAGS_Read(Channel,'%YEAR');
  FileTag.Comment:=TAGS_Read(Channel,'%CMNT');
  FileTag.Track:=TAGS_Read(Channel,'%TRCK');
  FileTag.Genre:=TAGS_Read(Channel,'%GNRE');

  Bass_StreamFree(Channel);
  if Trim(FileTag.Artist)<>'' then
    Result:=FileTag.Artist;
  if Trim(FileTag.Title)<>'' then
    Result:=Result+'-'+FileTag.Title;
end;

procedure SaveConfig;
var
  filename:string;
begin
  filename:=path+'config.ini';
  ini:=tinifile.Create(filename);

  ini.WriteString('path','skin',skinpath);
  ini.WriteString('path','Capture',CapturePath);
  ini.WriteInteger('info','index',Playindex);
  ini.WriteInteger('info','ListLength',ListLength);
  ini.WriteFloat('info','volume',nowvolume);
  ini.WriteBool('info','conglutinate',conglutinate);
  ini.WriteBool('info','IsShowList',IsShowList);
  ini.WriteInteger('form2','top',playlistPos.Y);
  ini.WriteInteger('form2','left',playlistPos.X);
  ini.WriteInteger('form1','top',mainPos.Y);
  ini.WriteInteger('form1','left',mainPos.X);

  ini.Free;
end;

procedure SavePlayList;
var
  filename:string;
  I:integer;
begin
  filename:=path+'PlayList.plst';
  if FileExists(filename) then Deletefile(filename);
  ini:=tinifile.Create(filename);

  for I := 0 to lstFilePath.Count - 1 do
  begin
    ini.WriteString('PlayList','Title'+inttostr(I+1),lstTitle[I]);//form2.PlayListBox.Items[I]);
    ini.WriteString('PlayList','path'+inttostr(I+1),lstFilepath[I]);
  end;

  ini.Free;
end;

procedure LoadPlayList;
var
filename:string;
temp:TStringList;
I:integer;
begin
  filename:=path+'PlayList.plst';
  if not(FileExists(filename)) then exit;
  ini:=tinifile.Create(filename);
  temp:=TStringlist.Create;

  ini.ReadSection('PlayList',temp);
  for I := 0 to trunc((temp.Count)/2)-1  do
  begin
      lstTitle.Add(ini.ReadString('playlist','Title'
        +inttostr(I+1),''));
      lstFilePath.Add(ini.ReadString('playlist','path'
        +inttostr(I+1),''));
  end;

  temp.Free;
  ini.Free;
end;

procedure LoadConfig;
var
  filename:string;
begin
  filename:=path+'config.ini';
  if not(FileExists(filename)) then exit;
  ini:=tinifile.Create(filename);

  skinPath:=ini.ReadString('path','skin','');
  CapturePath:=ini.ReadString('path','Capture','');
  NowVolume:=ini.ReadFloat('info','volume',1.0);
  PlayIndex:=ini.ReadInteger('info','index',-1);
  ListLength:=ini.ReadInteger('info','ListLength',200);
  conglutinate:=ini.ReadBool('info','conglutinate',false);
  IsShowList:=ini.ReadBool('info','IsShowList',false);
  mainPos.X:=ini.ReadInteger('form1','left',0);
  mainPos.Y:=ini.ReadInteger('form1','top',0);
  playlistPos.X:=ini.ReadInteger('form2','left',0);
  playlistPos.Y:=ini.ReadInteger('form2','top',0);

  ini.Free;
end;

procedure ReadTitle(var T:TTitle;Section:string);
begin
  T.caption:=ini.ReadString(Section,'caption','');
  T.facename:=ini.ReadString(Section,'facename','');
  T.Color:=ini.ReadInteger(Section,'Color',0);
  T.Size:=ini.ReadInteger(Section,'size',0);
  T.Height:=ini.ReadInteger(Section,'height',0);
  T.X:=ini.ReadInteger(Section,'X',0);
  T.Y:=ini.ReadInteger(Section,'Y',0);
end;

procedure LoadTitleConfig;
var
  filename:string;
begin
  filename:=path+skinpath+'config.ini';

  if not(FileExists(filename)) then exit;
  ini:=tinifile.Create(filename);

  tran:=ini.ReadBool('info','tran',true);
  backColor:=ini.ReadInteger('info','backcolor',$0);
  G_Length:=ini.ReadInteger('info','G_Length',$0);
  V_Length:=ini.ReadInteger('info','V_Length',$0);
  ico:=ini.ReadString('info','ico','');

  ReadTitle(MainTitle,'Title');
  ReadTitle(TagTitle,'TagTitle');

  Pause:=ini.ReadString('imgpause','image','');

  ini.Free;

  filename:=path+skinpath+'list.ini';

  if not(FileExists(filename)) then exit;
  ini:=tinifile.Create(filename);

  ListBackColor:=ini.ReadInteger('info','ListBackColor',$ffffff);
  FontSize:=ini.ReadInteger('info','FontSize',$8);
  FontColor:=ini.ReadInteger('info','FontColor',$0);

  ReadTitle(PlayListTitle,'Title');

  ini.Free;
end;

function FaceInitialization(form:TForm;FileName:string;var Arr:Array of TControls):boolean;
//设置窗体上控件的属性初始化
var
  I:integer;
begin
  Result:=true;
  
  with form do
  begin
    for I := 0 to ControlCount - 1 do
    begin
      Controls[I].Tag:=I;
      if not ReadPorperty(FileName,Controls[I].Name,Controls[I].Tag,Arr) then
        begin
          Result:=False;
          Exit;
        end;
    end;  
    
    for I := 0 to ControlCount - 1 do
    begin
      if not SetConProp(Controls[I],I,Arr) then
      begin
        Result:=false;
        Break;
      end;
    end;
  end;
end;

function SetConProp(Con:TControl;Index:integer;var Arr:Array of TControls):boolean;
begin
  Result:=true;
  if not (Arr[Index].visible) then
  begin
    Con.Visible:=Arr[Index].visible;
    Con.Top:=0;
    Con.Left:=0;
    Con.Width:=0;
    Con.Height:=0;
    Exit;
  end;
  
  Con.Visible:=Arr[Index].visible;
  Con.Top:=Arr[Index].Top;
  Con.Left:=Arr[Index].Left;
  Con.Width:=Arr[Index].Width;
  Con.Height:=Arr[Index].Height;

  //如果是image就进行图片处理
  if Con is TImage then
  begin
    if AnsiContainsStr(Con.Name,'BarPosition') then
       Painting(Con as TImage,Arr,1)
    else Painting(Con as TImage,Arr,0);
  end;
end;

function ReadPorperty(FileName,Title:string;Index:integer;var Arr:Array of TControls):boolean;
begin
  Result:=true;

  if not(FileExists(FileName)) then
  begin
    Result:=false;
    Exit;
  end;

  ini:=TiniFile.Create(FileName);
  Arr[Index].Image:=ini.ReadString(Title,'Image','');
  Arr[Index].visible:=ini.ReadBool(Title,'Visible',True);
  Arr[Index].IsPlane:=ini.ReadBool(Title,'IsPlane',True);
  Arr[Index].Top:=ini.ReadInteger(Title,'Top',0);
  Arr[Index].Left:=ini.ReadInteger(Title,'Left',0);
  Arr[Index].Width:=ini.ReadInteger(Title,'Width',0);
   Arr[Index].Height:=ini.ReadInteger(Title,'Height',0);
  Arr[Index].Whole:=ini.ReadBool(Title,'Whole',False);

  ini.Free;
end;

procedure Painting(Con:TImage;var Arr:Array of TControls;Num:Integer);
var
bmp:TBitMap;
begin
  if not(FileExists(path+skinPath+Arr[Con.Tag].Image)) then Exit;

  if Arr[Con.Tag].Whole=false then
  begin
    bmp:=TBitmap.Create;
    bmp.LoadFromFile(path+skinPath+Arr[Con.Tag].Image);
    if Arr[Con.Tag].IsPlane then
    begin
      bitblt(Con.Canvas.Handle,0,0,Con.Width,
        Con.Height,bmp.Canvas.Handle,Con.Width*Num,0,SRCCOPY);
    end
    else
    begin
      bitblt(Con.Canvas.Handle,0,0,Con.Width,
        Con.Height,bmp.Canvas.Handle,0,Con.Height*Num,SRCCOPY);
    end;
    bmp.Free;
  end
  else
    Con.Picture.LoadFromFile(path+skinPath+Arr[Con.Tag].Image);
  Con.Refresh;
end;

procedure MakeFileList(Path,FileExt,FindString:string;findFiles:boolean);
var
sch:TSearchrec;
temp:string;
begin
if rightStr(trim(Path), 1) <> '\' then
    Path := trim(Path) + '\'
else
    Path := trim(Path);
if not DirectoryExists(Path) then
begin
    exit;
end;
if FindFirst(Path + '*', faAnyfile, sch) = 0 then
begin
    repeat
       Application.ProcessMessages;
       if ((sch.Name = '.') or (sch.Name = '..')) then Continue;
       if DirectoryExists(Path+sch.Name) then
       begin
         MakeFileList(Path+sch.Name,FileExt,FindString,findFiles);
       end
       else
         if AnsiContainsText(UpperCase(FileExt),UpperCase(extractfileext(Path+sch.Name))) then
            if findFiles then
            begin
              temp:=copy(sch.Name,1,Length(sch.Name)-4);
              if (Pos(UpperCase(FindString),UpperCase(temp))>0)
                  or (Pos(UpperCase(temp),UpperCase(FindString))>0) then
              begin
                LyricName:=Path+sch.Name;
                Exit;
              end;
            end
            else
            begin
              lstFilePath.Add(Path+sch.Name);
            end;

    until FindNext(sch) <> 0;
    SysUtils.FindClose(sch);
end;
end;

procedure DirToSkins(Directory:string;IncludeFiles:Boolean);
var
  SearchRec:TSearchRec;
begin
      if rightStr(trim(Directory), 1) <> '\' then
      Directory := trim(Directory) + '\'
      else
      Directory := trim(Directory);
      if FindFirst(Directory+'*.*',faDirectory,SearchRec)=0 then
      begin
      repeat
        if(SearchRec.Attr and faDirectory=faDirectory)and(SearchRec.Name[1]<>'.')then
        begin
          if(SearchRec.Attr and faDirectory>0)then
          begin
            //添加找到的文件夹到列表
            SkinList.Add(Directory);
            templist.add(SearchRec.Name);
            //
          end;
          //DirToSkins(Directory+SearchRec.Name,IncludeFiles);
        end;
       { else if IncludeFiles then
          if SearchRec.Name[1]<>'.'then
          begin
            //找到文件
          end;    }
        until FindNext(SearchRec)<>0;
        FindClose(SearchRec);
      end;
end;

procedure  LoadTitle(temp:TImage;temp2:TTitle);
begin
  temp.Canvas.Font.Color:=temp2.Color;
  temp.Canvas.Font.Height:=temp2.Height;
  temp.Canvas.Font.Name:=temp2.facename;
  temp.Canvas.Font.Size:=temp2.Size;
  temp.Canvas.Brush.Style:=bsClear;
  temp.Canvas.TextOut(temp2.X,temp2.Y,temp2.caption);
  temp.Refresh;
end;


end.

⌨️ 快捷键说明

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