mpegplayer.pas

绝对经典的RPG类游戏

unit MPEGPlayer;

interface

uses
  Windows, Messages, SysUtils, Classes;

type TMPEGError = class (Exception);

type
  TMPEGPlayer = class(TComponent)
  private
    DLLHandle : THandle;
    FDLLPath     : string;
    FStreamName : String;
    FOutFilename : string;
    FOutputDevice : integer;
    FStartPos    : integer;
    FEndPos      : integer;
    FPlayStopped : boolean;
    FPaused      : boolean;
    FAutoPlay    : boolean;
    FPriority    : integer;

  protected

    function GetPosition:integer;
    function GetPlayMode:integer;
    function GetFrequency:integer;
    function GetBitrate:integer;
    function GetLayer:integer;
    function GetLength:integer;
    procedure SetStreamName(value:string);
    procedure Seek(value:integer);
    function GetPlayStopped:boolean;
    procedure Pause(value:boolean);

  public
    constructor Create(AOwner:TComponent); override;
    procedure Init;
    procedure Play;
    procedure Stop;
    procedure Open;
    procedure Close;
    procedure Deinit;
    property Paused : boolean read FPaused write Pause;
    property CurrentPosition : integer read GetPosition write Seek;
    property Mode : integer read GetPlayMode;
    property Frequency : integer read GetFrequency;
    property Bitrate : integer read GetBitrate;
    property Layer : integer read GetLayer;
    property PlayStopped : boolean read GetPlayStopped;
    property Length : integer read GetLength;

  published
    property PlayerPriority : integer read FPriority write FPriority;
    property AutoPlay : boolean read FAutoPlay write FAutoPlay;
    property StreamName : String read FStreamName write SetStreamName;
    property OutputDevice: integer read FOutputDevice write FOutputDevice;
                          // 0 - wavemapper, 1 - directsound, 2- wavefile
    property OutFilename: string read FOutFilename write FOutFilename;
    property PathToDLL : String read FDLLPath write FDLLPath;
    property StartPos : integer read FStartPos write FStartPos;
    property EndPos : integer read FEndPos write FEndPos;
  end;

procedure Register;

implementation

type MPInitProc = function:integer; stdcall;
     MPCMProc   = function:boolean; stdcall;
     MPOFNProc  = function (mode:integer; value:pchar):boolean; stdcall;
     MPSVProc   = function (value:integer):boolean; stdcall;
     MPSISProc  = function (value:pchar):boolean; stdcall;
     MPPProc    = function (sp, ep :integer; v:pointer):integer; stdcall;
     MPDProc    = function (value:boolean):boolean; stdcall;
     MPFProc    = function:single; stdcall;

const sxNotLoaded = 'MPEG library not loaded';
      sxNotInit   = 'MPEG library not initialized';
      sxIncMode   = 'Incorrect mode';

constructor TMPEGPlayer.Create;
begin
  inherited Create(AOwner);
  FPriority:=THREAD_PRIORITY_ABOVE_NORMAL;
  StartPos:=0;
  EndPos:=0;
  OutputDevice:=0;
  AutoPlay:=false;
end;

procedure TMPEGPlayer.Init;
var InitProc: MPInitProc;
    p:pchar;
    s:string;

begin
  GetMem(P,260);
  s:=FDLLPath;
  if (FDLLPath<>'') and (FDLLPath[system.Length(FDLLPath)]<>'\') then s:=s+'\';
  s:=s+'mpegdll.dll';
  StrPCopy(p,s);
  DLLHandle:=LoadLibrary(p);
  FreeMem(p,260);
  if DLLHandle=0 then Raise TMPEGError.Create('Can''t load MPEG library');
  @InitProc:=GetProcAddress(DLLHandle,'init');
  if (@InitProc=nil) or (InitProc=0) then
     Raise TMPEGError.Create('Can''t initialize MPEG library');
end;

procedure TMPEGPlayer.Deinit;
var DeInitProc: MPInitProc;
begin
  @DeInitProc:=GetProcAddress(DLLHandle,'deinit');
  if (@DeInitProc=nil) or (DeInitProc=0) then
     Raise TMPEGError.Create('Can''t deinitialize MPEG library') else
  FreeLibrary(DLLHandle);
  DLLHandle:=0;
end;

procedure TMPEGPlayer.Open;
var MPProc : MPSISProc;
    p:pchar;
    b:boolean;
begin
  if FStreamName = '' then
     Raise TMPEGError.Create('Can''t play non-specified stream');
  if DLLHandle=0 then Raise TMPEGError.Create(sxNotLoaded);
  @MPProc:=GetProcAddress(DLLHandle,'Open');
  if (@MPProc<>nil) then
  begin
    GetMem(p,512);
    StrPCopy(p,FStreamName);
    b:=MPProc(p);
    FreeMem(p,512);
    if not(b) then
    begin
      Raise TMPEGError.Create(sxIncMode);
    end;
  end
  else Raise TMPEGError.Create(sxNotInit);
end;

procedure TMPEGPlayer.Pause(value:boolean);
var MPProc : MPDProc;
begin
  FPaused:=value;
  if DLLHandle=0 then Raise TMPEGError.Create(sxNotLoaded);
  @MPProc:=GetProcAddress(DLLHandle,'Pause');
  if (@MPProc<>nil) then
  begin
    if not(MPProc(not value)) then Raise TMPEGError.Create(sxIncMode);
  end
  else Raise TMPEGError.Create(sxNotInit);
end;

procedure TMPEGPlayer.Stop;
var MPProc : MPCMProc;
begin
  if DLLHandle=0 then Raise TMPEGError.Create(sxNotLoaded);
  @MPProc:=GetProcAddress(DLLHandle,'Stop');
  if (@MPProc<>nil) then
  begin
    if MPProc then begin end else Raise TMPEGError.Create(sxIncMode);
  end
  else Raise TMPEGError.Create(sxNotInit);

end;

procedure TMPEGPlayer.Play;
var MPProc : MPPProc;
var MSProc : MPOFNProc;
var MVProc : MPSVProc;
    p      : pchar;
    b      : boolean;

begin
  if DLLHandle=0 then Raise TMPEGError.Create(sxNotLoaded);
  @MVProc:=GetProcAddress(DLLHandle,'SetPriority');
  if not ((@MVProc<>nil) and (MVProc(FPriority))) then
         Raise TMPEGError.Create(sxNotInit);

  @MSProc:=GetProcAddress(DLLHandle,'SetOutputDevice');
  if (@MSProc<>nil)
  then
  begin
    GetMem(p,260);
    StrPCopy(p,FOutFilename);
    b:=MSProc(FOutputDevice,p);
    FreeMem(p,260);
    if not b then Raise TMPEGError.Create(sxNotInit);
  end
  else Raise TMPEGError.Create(sxNotInit);

  @MPProc:=GetProcAddress(DLLHandle,'Play');
    if (@MPProc<>nil) and (MPProc(FStartPos, FEndPos,@FPlayStopped)=0) then begin end
    else Raise TMPEGError.Create(sxNotInit);
end;

procedure TMPEGPlayer.Close;
var MPProc : MPCMProc;
begin
  if DLLHandle=0 then Raise TMPEGError.Create(sxNotLoaded);
  @MPProc:=GetProcAddress(DLLHandle,'Close');
  if (@MPProc<>nil) then
  begin
    if not(MPProc) then Raise TMPEGError.Create(sxIncMode);
  end
  else Raise TMPEGError.Create(sxNotInit);
end;

function TMPEGPlayer.GetFrequency:integer;
var MPProc : MPInitProc;
begin
  if DLLHandle=0 then Raise TMPEGError.Create(sxNotLoaded);
  @MPProc:=GetProcAddress(DLLHandle,'GetFrequency');
  if (@MPProc<>nil)
     then result:=MPProc
     else Raise TMPEGError.Create(sxNotInit);
end;

function TMPEGPlayer.GetBitrate:integer;
var MPProc : MPInitProc;
begin
  if DLLHandle=0 then Raise TMPEGError.Create(sxNotLoaded);
  @MPProc:=GetProcAddress(DLLHandle,'GetBitrate');
  if (@MPProc<>nil)
     then result:=MPProc
     else Raise TMPEGError.Create(sxNotInit);
end;

function TMPEGPlayer.GetLayer:integer;
var MPProc : MPInitProc;
begin
  if DLLHandle=0 then Raise TMPEGError.Create(sxNotLoaded);
  @MPProc:=GetProcAddress(DLLHandle,'GetLayer');
  if (@MPProc<>nil)
     then result:=MPProc
     else Raise TMPEGError.Create(sxNotInit);
end;

function TMPEGPlayer.GetPlayMode;
var MPProc : MPInitProc;
begin
  if DLLHandle=0 then Raise TMPEGError.Create(sxNotLoaded);
  @MPProc:=GetProcAddress(DLLHandle,'GetPlayerMode');
  if (@MPProc<>nil)
     then result:=MPProc
     else Raise TMPEGError.Create(sxNotInit);
end;

function TMPEGPlayer.GetPosition;
var LenProc : MPInitProc;
begin
  if DLLHandle=0 then Raise TMPEGError.Create(sxNotLoaded);
  @LenProc:=GetProcAddress(DLLHandle,'GetCurrentPos');
  if (@LenProc<>nil)
     then result:=LenProc
     else Raise TMPEGError.Create(sxNotInit);
end;

function TMPEGPlayer.GetLength;
var LenProc : MPInitProc;
begin
  if DLLHandle=0 then Raise TMPEGError.Create(sxNotLoaded);
  @LenProc:=GetProcAddress(DLLHandle,'GetLength');
  if (@LenProc<>nil)
     then result:=LenProc
     else Raise TMPEGError.Create(sxNotInit);
end;

function TMPEGPlayer.GetPlayStopped;
var MPProc : MPCMProc;
begin
  if DLLHandle=0 then Raise TMPEGError.Create(sxNotLoaded);
  result:=FPlayStopped;
  if result then
  begin
    @MPProc:=GetProcAddress(DLLHandle,'ResetPlayerMode');
    if (@MPProc<>nil) and MPProc then begin end
       else Raise TMPEGError.Create(sxNotInit);
  end;
end;

procedure TMPEGPlayer.SetStreamName;
begin
  FStreamName:=value;
  if AutoPlay then
  begin
    Open;
    Play;
  end;
end;

procedure TMPEGPlayer.Seek;
var MPProc: MPSVProc;
begin
  if DLLHandle=0 then Raise TMPEGError.Create(sxNotLoaded);
  @MPProc:=GetProcAddress(DLLHandle,'Seek');
  if (@MPProc<>nil) and (MPProc(value)) then begin end
     else Raise TMPEGError.Create(sxNotInit);
end;

procedure Register;
begin
  RegisterComponents('Add-ons', [TMPEGPlayer]);
end;

end.