mpform.pas

Delphi 的媒体播放器的例子

// Copyright(C) Lord Dr. Andrei J. Sagura II von Orechov. All rights reserved.

(*
Dr.SAGURA Media Player v.1.0	GPLS 	  	 2007-03-03
By Andrei Sagura. Adwanced DirectX open source Media Video Player,
compatible with most codecs (DivX, XviD, MPEG ...), need only small
DLL mediaplr.dll (source code is available) to buildin it in your
applications. Can replace Windows Media Player. Very flexible, light and simple.

Fully functional
Source: Included
Exe-demo included
Download: D7 D2005 D2006 D2007
*)

unit mpform;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, SHFolder,
  MediaInterface;

type
  TDemoForm = class(TForm)
    AboutLbl: TLabel;
    PlayBtn: TButton;
    PauseBtn: TButton;
    StopBtn: TButton;
    InfoLbl: TLabel;
    VideoPnl: TPanel;
    VolumeBar: TScrollBar;
    PosBar: TScrollBar;
    Timer1: TTimer;
    FullBtn: TButton;
    RegisterBtn: TButton;
    OpenBtn: TButton;
    OpenMediaFile: TOpenDialog;
    ReplaceBtn: TButton;

    procedure FormShow(Sender: TObject);
    procedure PlayBtnClick(Sender: TObject);
    procedure PauseBtnClick(Sender: TObject);
    procedure StopBtnClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure VolumeBarChange(Sender: TObject);
    procedure PosBarChange(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FullBtnClick(Sender: TObject);
    procedure RegisterBtnClick(Sender: TObject);
    procedure OpenBtnClick(Sender: TObject);
    procedure ReplaceBtnClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);

  private
    TimerTick : boolean;

  public
    procedure WMOnMove(var Msg: TMessage); message WM_MOVE;
  end;

var
  MediaFileName : shortString = 'clock.avi';
  DemoForm: TDemoForm = nil;
  FileNameChanged : boolean = true;

implementation

{$R *.dfm}

procedure TDemoForm.WMOnMove(var Msg: TMessage);
begin
  if VideoAvailable then try
    NotifyOwnerMessage(VideoPnl.Handle, Msg);
  except
  end;
end;

procedure TDemoForm.PauseBtnClick(Sender: TObject);
begin
  pauseMediaStream;
end;

procedure TDemoForm.PlayBtnClick(Sender: TObject);
begin
  Caption:=loadMediaFile(MediaFileName, VideoPnl.Handle);
  if MediaStreamAvailable then try
    if VideoAvailable then begin
      Application.ProcessMessages;
      setVideoPos(5, 5, VideoPnl.Width-15, VideoPnl.Height-15);
      Application.ProcessMessages;
      VideoPnl.Visible:=true;
    end else
      VideoPnl.Visible:=false;
    Application.ProcessMessages;
    playMediaStream;
    PosBar.Position:=0;
    PosBar.Max:=integer(getMediaStreamDuration div 10000) ;
  except
  end;
end;

procedure TDemoForm.VolumeBarChange(Sender: TObject);
begin
  try
    with VolumeBar do
      setWaveOutVolume(Max - Position);
  except
  end;
end;

procedure TDemoForm.PosBarChange(Sender: TObject);
begin
  if not TimerTick then
    setMediaStreamPos(int64(PosBar.Position) * 10000);
end;

procedure TDemoForm.StopBtnClick(Sender: TObject);
begin
  if MediaStreamPlayed then begin
    stopMediaStream;
    if getFullScreenVideo then
      setFullScreenVideo(false);
  end else
    Close;
end;

procedure TDemoForm.Timer1Timer(Sender: TObject);
var
  s : string;
  volume : integer;
begin
  if not TimerTick then try
    TimerTick:=true;
    if getMediaStreamDuration > 0 then try
      PosBar.Position:=getMediaStreamPos div 10000;
      System.Str(PosBar.Position / 1000 / 60:5:3, s);
      InfoLbl.Caption:=MediaFileName + ': ' + s + ' min';

      System.Str(getMediaStreamDuration / 10000 / 1000 / 60:5:3, s);
      Caption:=InfoLbl.Caption + ' / ' + s + ' min';
    except
    end else if FileNameChanged then begin
      InfoLbl.Caption:='Media File: ' + MediaFileName;
      FileNameChanged:=false;
    end;
    volume:=getWaveOutVolume;
    with VolumeBar do
      if Max - Position <> volume then
        Position:=Max - volume;
    TimerTick:=false;
  except
    TimerTick:=false;
  end;
end;

procedure TDemoForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  freeMediaStream;
end;

procedure TDemoForm.FormDestroy(Sender: TObject);
begin
  ActiveControl:=nil;
  DemoForm:=nil;
end;

procedure TDemoForm.FormResize(Sender: TObject);
begin
  try
    VideoPnl.Width:=ClientWidth - VideoPnl.Left - VideoPnl.Top - VolumeBar.Width;
    VideoPnl.Height:=ClientHeight - VideoPnl.Top - VideoPnl.Top - PosBar.Height;
    VolumeBar.Height:=VideoPnl.Height;
    VolumeBar.Left:=VideoPnl.Left + VideoPnl.Width;
    PosBar.Width:=VideoPnl.Width;
    PosBar.Top:=VideoPnl.Top + VideoPnl.Height;
    if VideoAvailable then
      setVideoPos(5, 5, VideoPnl.Width-15, VideoPnl.Height-15);
  except
  end;
end;

procedure TDemoForm.FormShow(Sender: TObject);
var i : integer;
begin
  AboutLbl.Caption:=aboutMediaPlayer;

  if ParamCount > 0 then try
    i:=0;
    repeat
      inc(i);
      MediaFileName:=ParamStr(i);
    until (ParamCount <= i) or (MediaFileName[1] <> '/');
    Caption:=ParamStr(0);
    for i:=1 to ParamCount do
      Caption:=Caption + ' ' + ParamStr(i);
  except
  end;
end;

procedure TDemoForm.FullBtnClick(Sender: TObject);
begin
  setFullScreenVideo(true);
end;

procedure TDemoForm.OpenBtnClick(Sender: TObject);
begin
  OpenMediaFile.execute;
  if OpenMediaFile.FileName <> '' then begin
    MediaFileName:=OpenMediaFile.FileName;
    FileNameChanged:=true;
  end;
end;

procedure TDemoForm.RegisterBtnClick(Sender: TObject);
begin
  registerFileType(MediaFileName, '', 'Dr. SAGURA Media Player', '', ParamStr(0));
end;

procedure TDemoForm.ReplaceBtnClick(Sender: TObject);
begin
  if not FileExists('wmplayer.exe') then ShowMessage('rename first your player in "wmplayer.exe".')
  else begin
    deleteFile(getSpecialFolderName(Handle, CSIDL_WINDOWS) + '\i386\wmplayer.ex_');
    deleteFile(getSpecialFolderName(Handle, CSIDL_SYSTEM) + '\dllcache\wmplayer.exe');
    if not copyFile(PChar('wmplayer.exe'), PChar(getSpecialFolderName(Handle, CSIDL_PROGRAM_FILES) + '\Windows Media Player\wmplayer.exe'), false) or
       not copyFile(PChar('mediaplr.dll'), PChar(getSpecialFolderName(Handle, CSIDL_PROGRAM_FILES) + '\Windows Media Player\mediaplr.dll'), false) then
      ShowMessage('Error Replace Windows Media Player')
    else
      ShowMessage('Windows Media Player was replaced!');
  end;
end;

end.