filelist.~pas

关于DEPHI7.0的播放器管理系统源代码

unit Filelist;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ComCtrls, Urlmon, StdCtrls, Inifiles, MMSystem,
  MPlayer, ActnList, Menus;

type
  TFormFileList = class(TForm)
    Image1: TImage;
    Panel_add: TPanel;
    Image_add: TImage;
    Panel_del: TPanel;
    Image_del: TImage;
    Panel_clear: TPanel;
    Image_clear: TImage;
    Panel_hide: TPanel;
    Image_hide: TImage;
    Panel_close: TPanel;
    Image_close: TImage;
    Panel_List: TPanel;
    Image_list: TImage;
    Panel_journer: TPanel;
    Image_journer: TImage;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    ListBox1: TListBox;
    Panel1: TPanel;
    MediaPlayer1: TMediaPlayer;
    ActionList1: TActionList;
    ActionPause: TAction;
    ActionNext: TAction;
    ActionPrev: TAction;
    ActionPlay: TAction;
    ActionStop: TAction;
    ActionBack: TAction;
    ActionStep: TAction;
    Image_up: TImage;
    Image_down: TImage;
    ActionIndexUp: TAction;
    ActionIndexdown: TAction;
    ActionAdd: TAction;
    ActionClear: TAction;
    ActionDel: TAction;
    ActionCd: TAction;
    Timer1: TTimer;
    Panel_up: TPanel;
    Panel_down: TPanel;
    PopupMenu1: TPopupMenu;
    A1: TMenuItem;
    ActionDel1: TMenuItem;
    ActionClear1: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    ActionIndexUp1: TMenuItem;
    ActionIndexdown1: TMenuItem;
    N4: TMenuItem;
    ActionPlay1: TMenuItem;
    AboutAction1: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    CloseAction1: TMenuItem;
    procedure Image_closeClick(Sender: TObject);
    procedure Image_journerClick(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
    procedure ActionBackExecute(Sender: TObject);
    procedure ActionStopExecute(Sender: TObject);
    procedure ActionPlayExecute(Sender: TObject);
    procedure ActionPrevExecute(Sender: TObject);
    procedure ActionNextExecute(Sender: TObject);
    procedure ActionStepExecute(Sender: TObject);
    procedure ActionPauseExecute(Sender: TObject);
    procedure ActionIndexUpExecute(Sender: TObject);
    procedure ActionIndexdownExecute(Sender: TObject);
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure Image_upClick(Sender: TObject);
    procedure Image_downClick(Sender: TObject);
    procedure Image_hideClick(Sender: TObject);
    procedure ActionAddExecute(Sender: TObject);
    procedure ActionClearExecute(Sender: TObject);
    procedure ActionDelExecute(Sender: TObject);
    procedure Image_addClick(Sender: TObject);
    procedure Image_delClick(Sender: TObject);
    procedure Image_clearClick(Sender: TObject);
    procedure ActionCdExecute(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Image_downMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image_downMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image_downMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image_upMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image_upMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image_upMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image_addMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image_addMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image_addMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image_delMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image_delMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image_delMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image_clearMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image_clearMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image_clearMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image_journerMouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure Image_journerMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image_journerMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image_hideMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image_hideMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image_hideMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image_closeMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image_closeMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image_closeMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    procedure PlayMedia;
  public
    { Public declarations }
    FileIndex:integer;          //播放文件的索引
    FileCount:integer;          //列表中文件总数
    FileChange:boolean;         //通知主窗口播放歌曲已改
    FileLength:longint;         //文件长度
    FilePosition:longint;       //当前播放的帧数
    Drive: char;                 //光驱盘符
    CDopen : Boolean;            //光驱是否打开
    FileListName:TIniFile;       //列表文件关联名
    Playingpause : Boolean;      //暂停控制
    function DiskInDrive(Drive: Char): Boolean;
    procedure ListBoxScrollar(Sender: TObject); //产生水平滚动条
end;

var
    FormFileList: TFormFileList;

implementation

uses Movie, main;
{$R *.dfm}

procedure TFormFileList.ListBoxScrollar(Sender: TObject);
var
i, MaxWidth: integer; 
begin 
  MaxWidth := 0;
  for i := 0 to ListBox1.Items.Count - 1 do
    if MaxWidth < ListBox1.Canvas.TextWidth(ListBox1.Items.Strings[i]) then
       MaxWidth := ListBox1.Canvas.TextWidth(ListBox1.Items.Strings[i]);
  SendMessage(ListBox1.Handle, LB_SETHORIZONTALEXTENT, MaxWidth+20, 0);
end;

function TFormFileList.DiskInDrive(Drive: Char): Boolean;
var ErrorMode: word;
  begin
if Drive in ['a'..'z'] then Dec(Drive, $20);
if not (Drive in ['A'..'Z']) then
   raise EConvertError.Create('Not a valid drive ID');
ErrorMode := SetErrorMode(SEM_FailCriticalErrors);
try
{ drive 1 = a, 2 = b, 3 = c, etc. }
if DiskSize(Ord(Drive) - $40) = -1 then
  Result := False
else
  Result := True;
finally
  SetErrorMode(ErrorMode);
end;
end;

procedure TFormFileList.Image_closeClick(Sender: TObject);
begin
  FormMain.ActionClose.Execute;
end;

procedure TFormFileList.Image_journerClick(Sender: TObject);
begin
   //访问作者主页
   HlinkNavigateString(Nil,'http://journer.yeah.net');
end;

procedure TFormFileList.Image1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  //控制左键拖动
  POSTMESSAGE(FormFileList.handle,WM_LBUTTONUP,0,0);
  POSTMESSAGE(FormFileList.handle,274,61458,0);
end;

procedure TFormFileList.FormCreate(Sender: TObject);
var
  i: Integer;
  tempname: String;
begin
        FileListName := Tinifile.create(ExtractFilePath(paramstr(0))+'media.Ini');
         //建立列表文件关联
        FileCount :=FileListName.ReadInteger('播放文件','文件数',0);
        for i:=0 to FileCount-1 do
        begin
          tempname:=FileListName.ReadString('文件列表','No.['+inttostr(i)+']','');
          ListBox1.Items.Add (tempname);
        end;
        FileIndex :=FileListName.ReadInteger('播放文件','文件号',-1);
        ListBox1.ItemIndex :=FileIndex;
        ListBoxScrollar(Sender);
        for i:=Ord('A') to Ord('Z') do
        begin
          drive:=Chr(i);
          if GetDriveType(pchar(drive+':\'+#0))=DRIVE_CDROM  then
          break;
        end;
end;

procedure TFormFileList.ListBox1DblClick(Sender: TObject);
var
  Index : integer;
begin
        Index := ListBox1.ItemIndex;
        if Index < 0 then exit;
        if Index = FileIndex then exit;
        MediaPlayer1.Close;
        FileIndex := Index;
        FileListName.WriteInteger('播放文件','文件号',FileIndex);
        PlayMedia;
end;

procedure TFormFileList.PlayMedia;
var
  extname : string;
begin
        with MediaPlayer1 do
        begin
          if mode = mpOpen then close;    //如果正在播放，则关闭
          filename :=FileListName.ReadString('文件列表','No.['+inttostr(FileIndex)+']','');
          try
            Open;
            extname := extractfileext(filename);
            if (stricomp(pchar(extname),'.mpg')=0)or
               (stricomp(pchar(extname),'.dat')=0)or
               (stricomp(pchar(extname),'.avi')=0) or
               (stricomp(pchar(extname),'.asf')=0) then
            begin
               Mediaplayer1.Display := FormMovie.Panel1;
               MediaPlayer1.DisplayRect := FormMovie.Panel1.ClientRect;
               FormMovie.Visible := True;
            end
            else
            begin
              Mediaplayer1.Display := nil;
              FormMovie.Visible := False;
            end;
            TimeFormat := tfMilliseconds;
            Position := 0;
            FileChange := true;
            play;
            Playingpause := False;
          except
            MessageDlg('无法打开或者播放此文件！',mtError,[mbOK],0);
          end;
        end;
end;

procedure TFormFileList.ActionBackExecute(Sender: TObject);
begin
        with MediaPlayer1 do
        begin
          if not(mode in[mpPlaying]) then exit;
          pause;
          Position := Position - 6000;
          play;
        end;
end;

procedure TFormFileList.ActionStepExecute(Sender: TObject);
begin
with MediaPlayer1 do
        begin
          if not(mode in[mpPlaying]) then exit;
          pause;
          Position := Position + 6000;
          play;
        end;
end;

procedure TFormFileList.ActionStopExecute(Sender: TObject);
begin
        with MediaPlayer1 do
        begin
          if mode in [mpStopped] then exit;
          close;
        end;
end;

procedure TFormFileList.ActionPlayExecute(Sender: TObject);
var
  Index:integer;
begin
        Index:= ListBox1.ItemIndex;
        if (FileIndex <> Index)and(Index >= 0) then
        begin
          FileIndex := Index;
          FileListName.WriteInteger('播放文件','文件号',FileIndex);
          PlayMedia;
        end
        else begin
        if FileIndex = -1 then exit;
        with MediaPlayer1 do
        begin
          if mode in [mpPlaying] then exit
          else if mode in [mpPaused] then
          begin
            resume;
            exit;
          end
          else
          begin
            PlayMedia;
          end;
        end;
        end;
end;

procedure TFormFileList.ActionPrevExecute(Sender: TObject);
begin
        if FileIndex <=0 then exit;
        FileIndex :=FileIndex-1;
        ListBox1.ItemIndex := FileIndex;
        FileListName.WriteInteger ('播放文件','文件号',FileIndex);