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

📄 adddir.pas

📁 mp3 播放器 delphi 源码
💻 PAS
字号:
{###############################################################################
# Dipesh-MP3yk                                               Delphi-Sourcecode #
################################################################################
# by Sebastian Sauer (Dipesh)                                                  #
#   email:   mail@dipesh.de                                                    #
#   url:     www.dipesh.de                                                     #
# (C) 1999 - freeware, see the licenceagreements in readme.txt                 #
################################################################################
# ADDDIR.PAS - TAddDirForm                                                     #
# Add a directory (maybe with subdirs) to the playlist                         #
###############################################################################}

UNIT AddDir;

INTERFACE

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
     StdCtrls, FileCtrl, Buttons, ShlObj, ActiveX;

type
  TAddDirForm = class(TForm)
    EditDir: TEdit;
    ButtonBrowseDir: TButton;
    ButtonAdd: TBitBtn;
    ButtonCancel: TBitBtn;
    ComboBoxFilter: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    CheckBoxID3Tags: TCheckBox;
    CheckBoxClear: TCheckBox;
    CheckBoxRecursiv: TCheckBox;
    CheckBoxSort: TCheckBox;
    procedure OnCreate(Sender: TObject);
    procedure OnActivate(Sender: TObject);
    procedure ButtonBrowseDir_OnClick(Sender: TObject);
    procedure ButtonAdd_OnClick(Sender: TObject);
  end;

var AddDirForm: TAddDirForm;

IMPLEMENTATION

uses Main;

{$R *.DFM}

procedure TAddDirForm.OnCreate(Sender: TObject);
begin
  Screen.Cursor:=crHourGlass;
  If FileExists(PlaylistFileCom) then EditDir.Text:=LowerCase(ExtractFilePath(PlaylistFileCom)) else EditDir.Text:=LowerCase(StartDir);
  CheckBoxID3Tags.Checked:=PlayUseID3Tags;
  MainForm.ImageListBtn.GetBitmap(1,ButtonAdd.Glyph);
  MainForm.ImageListBtn.GetBitmap(0,ButtonCancel.Glyph);
end;

procedure TAddDirForm.OnActivate(Sender: TObject);
begin Screen.Cursor:=crDefault; end;

procedure TAddDirForm.ButtonBrowseDir_OnClick(Sender: TObject);
var pc1: pchar; s1: string; pidlPrg, pidlBrowse: PItemIDList; ppMalloc: IMalloc; bi: TBrowseInfo;
begin
  Try
    SHGetMalloc(ppMalloc); If ppMalloc=nil then Exit;
    SHGetSpecialFolderLocation(Handle,CSIDL_DRIVES,pidlPrg);
    pc1:=StrAlloc(MAX_PATH); If pc1=nil then Exit; If pidlPrg=nil then Exit;
    With bi do begin
      hwndOwner:=Handle; pidlRoot:=pidlPrg; pszDisplayName:=pc1;
      lpszTitle:='Chose directory:'; ulFlags:=BIF_RETURNONLYFSDIRS;
      lpfn:=nil; lParam:=0;
    end;
    pidlBrowse:=SHBrowseForFolder(bi);
    If pidlBrowse<>nil then If SHGetPathFromIDList(pidlBrowse,pc1) then begin
      s1:=pc1; If s1>'' then begin If s1[Length(s1)]<>'\' then s1:=s1+'\'; EditDir.Text:=s1; end;
    end;
    ppMalloc.Free(pidlPrg); ppMalloc.Free(pc1);
  Finally Try {$ifdef ver90} ppMalloc.Release; {$endif} Except end; end;
end;

procedure TAddDirForm.ButtonAdd_OnClick(Sender: TObject);
begin
  If not DirectoryExists(EditDir.Text) then begin MessageDlg('Sourcedirectory not found...',mtError,[mbOk],0); Exit; end;
  ModalResult:=mrOk;
end;

END.

⌨️ 快捷键说明

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