IceVLCPlayer

From VideoLAN Wiki
Revision as of 01:41, 3 February 2012 by Edwardw (talk | contribs) (+category)
Jump to navigation Jump to search

This is a VCL component for Delphi to use VLC Player (0.8.6i) in your application.


IceVLCPlayer.pas: 

unit IceVLCPlayer;

{ TIceVLCPlayer  -  VLC Player for Delphi (0.8.6i) (c)2008 by Norbert Mereg    }

interface

uses
  SysUtils, Classes, Controls, ExtCtrls, libVLC, Graphics, Windows,
  Forms;

type
  TEVLCException = class(Exception);
  TEVLCNotFound = class(Exception);
  TEVLCLoadLibrary = class(Exception);

  TErrorEvent = procedure(Sender: TObject; ErrorCode: integer; ErrorMessage: string) of object;

  TIceVLCPlayer = class(TCustomPanel)
  private
    VLC      : libvlc_instance;
    VLCVideo : integer;
    VLCInput : libvlc_input;
    VLCError : libvlc_exception;
    FLength: Int64;
    FIsPlaying: boolean;
    FTime: Int64;
    FPosition: Single;

    FTimer: TTimer;
    FVideoWidth: integer;
    FVideoHeight: integer;

    FOnPlay: TNotifyEvent;
    FOnStop: TNotifyEvent;
    FOnError: TErrorEvent;

    function CheckError: boolean;
    procedure FTimerTimer(Sender: TObject);
    procedure StartPlaying;
    procedure SetOnPlay(const Value: TNotifyEvent);
    procedure StopPlaying;
    procedure SetOnStop(const Value: TNotifyEvent);
    procedure SetOnError(const Value: TErrorEvent);
    procedure StopIfPlaying;

    { Private declarations }
  protected
    { Protected declarations }
  public
    { Public declarations }
    property Length: Int64 read FLength;
    property Time: Int64 read FTime;
    property Position: Single read FPosition;
    property IsPlaying: boolean read FIsPlaying;
    property VideoWidth: integer read FVideoWidth;
    property VideoHeight: integer read FVideoHeight;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Play(const FileName: string);
    procedure PlayTV(const CaptureDev: string; const Channel: integer; const Country: integer = 0);

    procedure Stop;
  published
    { Published declarations }
    property Align;
    property OnPlay: TNotifyEvent read FOnPlay write SetOnPlay;
    property OnStop: TNotifyEvent read FOnStop write SetOnStop;
    property OnError: TErrorEvent read FOnError write SetOnError;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('IcePackage', [TIceVLCPlayer]);
end;

{ TIceVLCPlayer }

constructor TIceVLCPlayer.Create(AOwner: TComponent);
var
  Args: array [0..1] of PChar;

begin
  inherited Create(AOwner);

  VLC := nil;
  VLCInput := nil;
  FIsPlaying := False;

  ParentBackground := False;
  Color := clBlack;
  Width := 320;
  Height := 240;
  Caption := '';
  BevelOuter := bvNone;

  case VLD_Startup of
   VLD_SUCCESS  :
    begin

    end;
   VLD_NOLIB    :
    begin
      raise TEVLCLoadLibrary.Create('VLC Player not installed! Please re-install.');
      exit;
    end;
   VLD_NOTFOUND :
    begin
      raise TEVLCNotFound.Create('VLC Player not installed or wrong version! Please re-install.');
      exit;
    end;
  end;

  //Clear error var.
  FillChar(VLCError,SizeOf(VLCError),0);

  //Create new VLC object
  Args[0] := PChar(VLD_LibPath);
  Args[1] := nil;
  VLC := libvlc_new( 1, @Args[0], VLCError);


  FTimer := TTimer.Create(nil);
  FTimer.Enabled := False;
  FTimer.Interval := 500;
  FTimer.OnTimer := FTimerTimer;
end;

destructor TIceVLCPlayer.Destroy;
begin
  FTimer.Free;

  // NTDLL.DLL error :(
  //  if Assigned(VLC) then
  //    libvlc_destroy(VLC);

  inherited;
end;

procedure TIceVLCPlayer.Stop;
begin
  StopIfPlaying;
end;

procedure TIceVLCPlayer.StopIfPlaying;
begin
  if IsPlaying then
  begin
    if Assigned(VLCInput) then
    begin
      libvlc_playlist_stop(VLC, VLCError);
      CheckError;
    end;
    libvlc_playlist_clear(VLC, VLCError);
    CheckError;

    FTimer.Enabled := False;
    FIsPlaying := False;

    libvlc_input_free(VLCInput);
    VLCInput := nil;
  end;
end;

procedure TIceVLCPlayer.Play(const FileName: string);
begin
  StopIfPlaying;

  VLCVideo := libvlc_playlist_add(VLC, PChar(UTF8Encode(FileName)), '', VLCError);
  CheckError;

  StartPlaying;
end;

procedure TIceVLCPlayer.PlayTV(const CaptureDev: string; const Channel, Country: integer);
var
  Args: array[0..14] of PChar;
  DevStr: string;
begin
  StopIfPlaying;

  args[0] := ':dshow-adev=""';
  args[1] := ':dshow-size=""';
  args[2] := ':dshow-caching=200';
  args[3] := ':dshow-chroma=""';
  args[4] := ':dshow-fps=0.000000';
  args[5] := ':no-dshow-config';
  args[6] := ':no-dshow-tuner';
  args[7] := PChar(':dshow-tuner-channel=' + IntToStr(Channel));
  args[8] := PChar(':dshow-tuner-country=' + IntToStr(Country));
  args[9] := ':dshow-tuner-input=2'; //1-Cable, 2-Antenna
  args[10] := ':dshow-video-input=-1';
  args[11] := ':dshow-audio-input=-1';
  args[12] := ':dshow-video-output=-1';
  args[13] := ':dshow-audio-output=-1';
  args[14] := nil;

  DevStr := 'dshow:// :dshow-vdev="' + CaptureDev + '"';
  VLCVideo := libvlc_playlist_add_extended(VLC, PChar(UTF8Encode(DevStr)), '', 14, @Args[0], VLCError);
  CheckError;

  StartPlaying;
end;

function TIceVLCPlayer.CheckError: boolean;
var
  ErrorCode: Integer;
  ErrorMsg: string;
begin
  if VLCError.Code <> 0 then
  begin
    Result := False;
    ErrorCode := VLCError.Code;
    ErrorMsg := VLCError.Message;
    libvlc_exception_clear(VLCError);

    if Assigned(OnError) then
      OnError(Self, ErrorCode, ErrorMsg);

//    raise TEVLCException.CreateFmt('Error %d! %s', [ErrorCode, ErrorMsg]);
  end
  else
    Result := True;
end;

procedure TIceVLCPlayer.StartPlaying;
begin
  //Set current parent (Self)
  libvlc_video_set_parent(VLC, Self.Handle, VLCError);
  CheckError;

  //Start play
  libvlc_playlist_play(VLC, VLCVideo, 0, nil, VLCError);
  CheckError;

  FLength := -2; //returned Length = -1 - stream; 0 -  TV , >0 - local file

  FTimer.Enabled := true;
end;

procedure TIceVLCPlayer.StopPlaying;
begin
  FTimer.Enabled := False;
  FIsPlaying := False;

  //Freeing current input
  libvlc_input_free(VLCInput);
  VLCInput := nil;

  if Assigned(OnStop) then
    OnStop(Self);
end;

procedure TIceVLCPlayer.FTimerTimer(Sender: TObject);
var
  Ln: int64;
begin
  FTimer.Enabled := False;

  try
    //Get current input
    VLCInput := libvlc_playlist_get_input(VLC, VLCError);
    CheckError;

    //Get current movie length (msec)
    Ln := libvlc_input_get_length(VLCInput, VLCError);

    if not CheckError then
    begin
      if IsPlaying then
      begin
        //If end of movie then cause error.
        FIsPlaying := False;
        StopPlaying;
        exit;
      end
      else
      begin
        FTimer.Enabled := True;
        exit;
      end;
    end;
    FLength := Ln;

    //Get current movie current time (msec)
    FTime := libvlc_input_get_time(VLCInput, VLCError);
    CheckError;

    //Get current movie current position (0 -> 1)
    FPosition := libvlc_input_get_position(VLCInput, VLCError);
    CheckError;

    if CheckError and (not IsPlaying) then
    begin
      FIsPlaying := True;

      if Assigned(OnPlay) then
        OnPlay(Self);
    end;

//    FVideoWidth := libvlc_video_get_width(VLCInput, VLCError);
//    CheckError;
//    FVideoHeight := libvlc_video_get_height(VLCInput, VLCError);
//    CheckError;

    FTimer.Enabled := True;
  Except
    if IsPlaying then
      StopPlaying;
  end;
end;

procedure TIceVLCPlayer.SetOnError(const Value: TErrorEvent);
begin
  FOnError := Value;
end;

procedure TIceVLCPlayer.SetOnPlay(const Value: TNotifyEvent);
begin
  FOnPlay := Value;
end;

procedure TIceVLCPlayer.SetOnStop(const Value: TNotifyEvent);
begin
  FOnStop := Value;
end;

end.

libVLC.pas - Thanks to Paul TOTH 

unit libVLC;

{ VideoLAN libvcl.dll (0.8.6b) Interface for Delphi (c)2007 by Paul TOTH
  - Modified by Norbert Mereg     libvcl.dll (0.8.6i)                       }

// http://wiki.videolan.org/ExternalAPI#VLC_Control

interface


const
 LibName = 'libvlc.dll';

// Structures
type
  libvlc_exception = record
    Code    : integer;
    Message : pchar;
  end;

 libvlc_instance = pointer;
 libvlc_input    = pointer;

{$IFDEF STATIC}

// Core
function libvlc_new(argc:integer; args:ppchar; var exception:libvlc_exception):libvlc_instance; cdecl external lib;
procedure libvlc_destroy(vlc:libvlc_instance); cdecl external lib;
procedure libvlc_exception_clear(var exception:libvlc_exception); cdecl external lib;

// Playlist
function libvlc_playlist_add(vlc:libvlc_instance; fileName,name:pchar; var exception:libvlc_exception):integer; cdecl external lib;
function libvlc_playlist_add_extended(vlc:libvlc_instance; fileName,name:pchar; optCount:integer; opts:ppchar; var exception:libvlc_exception):integer; cdecl external lib;
procedure libvlc_playlist_clear(vlc:libvlc_instance; var exception:libvlc_exception); cdecl external lib;
function libvlc_playlist_items_count(vlc:libvlc_instance; var exception:libvlc_exception):integer; cdecl external lib;
function libvlc_playlist_isplaying(vlc:libvlc_instance; var exception:libvlc_exception):longbool; cdecl external lib;
procedure libvlc_playlist_play(vlc:libvlc_instance; index,optCount:integer; opts:ppchar; var exception:libvlc_exception); cdecl external lib;
procedure libvlc_playlist_pause(vlc:libvlc_instance; var exception:libvlc_exception); cdecl external lib;
procedure libvlc_playlist_stop(vlc:libvlc_instance; var exception:libvlc_exception); cdecl external lib;
procedure libvlc_playlist_next(vlc:libvlc_instance; var exception:libvlc_exception); cdecl external lib;
procedure libvlc_playlist_prev(vlc:libvlc_instance; var exception:libvlc_exception); cdecl external lib;
function libvlc_playlist_get_input(vlc:libvlc_instance; var exception:libvlc_exception):libvlc_input; cdecl external lib;

// Input
procedure libvlc_input_free(input:libvlc_input); cdecl external lib;
function libvlc_input_get_length(input:libvlc_input; var exception:libvlc_exception):int64; cdecl external lib;
function libvlc_input_get_time(input:libvlc_input; var exception:libvlc_exception):int64; cdecl external lib;
function libvlc_input_get_position(input:libvlc_input; var exception:libvlc_exception):single; cdecl external lib;
procedure libvlc_toggle_fullscreen(input:libvlc_input; var exception:libvlc_exception); cdecl external lib;
procedure libvlc_set_fullscreen(input:libvlc_input; var exception:libvlc_exception); cdecl external lib;
function libvlc_get_fullscreen(input:libvlc_input; var exception:libvlc_exception):longbool; cdecl external lib;

// Video
function libvlc_video_get_width(input:libvlc_input; var exception:libvlc_exception):integer; cdecl external lib;
function libvlc_video_get_height(input:libvlc_input; var exception:libvlc_exception):integer; cdecl external lib;

// Audio
function libvlc_audio_get_mute(vlc:libvlc_instance; var exception:libvlc_exception):longbool; cdecl external lib;
procedure libvlc_audio_set_mute(vlc:libvlc_instance; mute:longbool; var exception:libvlc_exception); cdecl external lib;
function libvlc_audio_get_volume(vlc:libvlc_instance; var exception:libvlc_exception):integer; cdecl external lib;
procedure libvlc_audio_set_volume(vlc:libvlc_instance; volume:integer; var exception:libvlc_exception); cdecl external lib;

//Other
procedure libvlc_video_set_parent(vlc:libvlc_instance; libvlc_drawable_t:integer; var exception:libvlc_exception); cdecl external lib;
//function libvlc_video_get_parent(vlc:libvlc_instance; var exception:libvlc_exception):integer; cdecl external lib;
 {$ELSE}

var

// Core
 libvlc_new:function(argc:integer; args:ppchar; var exception:libvlc_exception):libvlc_instance; cdecl;
 libvlc_destroy:procedure(vlc:libvlc_instance); cdecl;
 libvlc_exception_clear:procedure(var exception:libvlc_exception); cdecl;
// Playlist
 libvlc_playlist_add:function(vlc:libvlc_instance; fileName,name:pchar; var exception:libvlc_exception):integer; cdecl;
 libvlc_playlist_add_extended:function(vlc:libvlc_instance; fileName,name:pchar; optCount:integer; opts:ppchar; var exception:libvlc_exception):integer; cdecl;
 libvlc_playlist_clear:procedure(vlc:libvlc_instance; var exception:libvlc_exception); cdecl;
 libvlc_playlist_items_count:function(vlc:libvlc_instance; var exception:libvlc_exception):integer; cdecl;
 libvlc_playlist_isplaying:function(vlc:libvlc_instance; var exception:libvlc_exception):longbool; cdecl;
 libvlc_playlist_play:procedure(vlc:libvlc_instance; index,optCount:integer; opts:ppchar; var exception:libvlc_exception); cdecl;
 libvlc_playlist_pause:procedure(vlc:libvlc_instance; var exception:libvlc_exception); cdecl;
 libvlc_playlist_stop:procedure(vlc:libvlc_instance; var exception:libvlc_exception); cdecl;
 libvlc_playlist_next:procedure(vlc:libvlc_instance; var exception:libvlc_exception); cdecl;
 libvlc_playlist_prev:procedure(vlc:libvlc_instance; var exception:libvlc_exception); cdecl;
 libvlc_playlist_get_input:function(vlc:libvlc_instance; var exception:libvlc_exception):libvlc_input; cdecl;
 // Input (Vout)
 libvlc_input_free:procedure(input:libvlc_input); cdecl;
 libvlc_input_get_length:function(input:libvlc_input; var exception:libvlc_exception):int64; cdecl;
 libvlc_input_get_time:function(input:libvlc_input; var exception:libvlc_exception):int64; cdecl;
 libvlc_input_get_position:function(input:libvlc_input; var exception:libvlc_exception):single; cdecl;
 libvlc_toggle_fullscreen:procedure(input:libvlc_input; var exception:libvlc_exception); cdecl;
 libvlc_set_fullscreen:procedure(input:libvlc_input; var exception:libvlc_exception); cdecl;
 libvlc_get_fullscreen:function(input:libvlc_input; var exception:libvlc_exception):longbool; cdecl;
 // audio
 libvlc_video_get_width:function(input:libvlc_input; var exception:libvlc_exception):integer; cdecl;
 libvlc_video_get_height:function(input:libvlc_input; var exception:libvlc_exception):integer; cdecl;
 // Audio
 libvlc_audio_get_mute:function(vlc:libvlc_instance; var exception:libvlc_exception):longbool; cdecl;
 libvlc_audio_set_mute:procedure(vlc:libvlc_instance; mute:longbool; var exception:libvlc_exception); cdecl;
 libvlc_audio_get_volume:function(vlc:libvlc_instance; var exception:libvlc_exception):integer; cdecl;
 libvlc_audio_set_volume:procedure(vlc:libvlc_instance; volume:integer; var exception:libvlc_exception); cdecl;

 //Other
 libvlc_video_set_parent:procedure(vlc:libvlc_instance; libvlc_drawable_t:integer; var exception:libvlc_exception); cdecl;
 libvlc_video_get_parent:function(vlc:libvlc_instance; var exception:libvlc_exception):integer; cdecl;


const
  VLD_SUCCESS  =  0;
  VLD_NOLIB    = -1;
  VLD_NOTFOUND = -2;

// load libvlc.dll (get Install path from registry)
function VLD_LoadLibrary:integer;
// return Install path found in registry by VLD_LoadLibrary
function VLD_LibPath:string;
// return libvlc.dll proc adress
function VLD_GetProcAddress(Name:pchar; var addr:pointer):integer;
// return (and clear) last VLD error
function VLD_LastError:integer;
// load everything (dll & procs) and return last VLD error
function VLD_Startup:integer;

{$ENDIF}

implementation

{$IFNDEF STATIC}

uses
 Windows;
 
var
  LibVLCHandle: THandle = 0;
  LibPath: string;
  LastError: integer = VLD_SUCCESS;
  VLCLibLoaded: boolean = false;

function GetLibPath: boolean;
var
 Handle: HKEY;
 RegType: integer;
 DataSize: integer;
begin
  Result := False;
  if (RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'Software\VideoLAN\VLC', 0, KEY_ALL_ACCESS, Handle) = ERROR_SUCCESS) then
  begin
    if RegQueryValueEx(Handle, 'InstallDir', nil, @RegType, nil, @DataSize) = ERROR_SUCCESS then
    begin
      SetLength(LibPath, Datasize);
      RegQueryValueEx(Handle, 'InstallDir', nil, @RegType, PByte(@LibPath[1]), @DataSize);
      LibPath[DataSize] := '\';
      Result := True;
    end;
    RegCloseKey(Handle);
 end;
end;

function VLD_LibPath: string;
begin
  if LibPath = '' then
    getLibPath;
  Result := LibPath;
end;

function VLD_LoadLibrary:integer;
begin
  if LibVLCHandle = 0 then
  begin
    LibVLCHandle := LoadLibrary(LibName);
    if (LibVLCHandle = 0) and (getLibPath) then
      LibVLCHandle := LoadLibrary(PChar(LibPath + LibName));
  end;

  if LibVLCHandle <> 0 then
    Result := VLD_SUCCESS
  else
  begin
    LastError := VLD_NOLIB;
    Result := LastError;
  end;
end;

function VLD_GetProcAddress(Name: PChar; var Addr: Pointer): Integer;
begin
  if LibVLCHandle = 0 then
  begin
    Result := VLD_LoadLibrary;
    if Result <> VLD_SUCCESS then exit;
  end;

  Addr := GetProcAddress(LibVLCHandle, Name);
  if Addr <> nil then
    Result := VLD_SUCCESS
  else
  begin
    LastError := VLD_NOTFOUND;
    Result := LastError;
  end;
end;

function VLD_LastError: Integer;
begin
 Result := LastError;
 LastError := VLD_SUCCESS;
end;

function VLD_Startup: Integer;
begin
  LastError := VLD_SUCCESS;
  if VLD_LoadLibrary = VLD_SUCCESS then
  begin
    VLD_GetProcAddress('libvlc_new', @libvlc_new);
    VLD_GetProcAddress('libvlc_destroy', @libvlc_destroy);
    VLD_GetProcAddress('libvlc_exception_clear', @libvlc_exception_clear);
    VLD_GetProcAddress('libvlc_playlist_add', @libvlc_playlist_add);
    VLD_GetProcAddress('libvlc_playlist_add_extended', @libvlc_playlist_add_extended);
    VLD_GetProcAddress('libvlc_playlist_clear', @libvlc_playlist_clear);
    VLD_GetProcAddress('libvlc_playlist_items_count', @libvlc_playlist_items_count);
    VLD_GetProcAddress('libvlc_playlist_isplaying', @libvlc_playlist_isplaying);
    VLD_GetProcAddress('libvlc_playlist_play', @libvlc_playlist_play);
    VLD_GetProcAddress('libvlc_playlist_pause', @libvlc_playlist_pause);
    VLD_GetProcAddress('libvlc_playlist_stop', @libvlc_playlist_stop);
    VLD_GetProcAddress('libvlc_playlist_next', @libvlc_playlist_next);
    VLD_GetProcAddress('libvlc_playlist_prev', @libvlc_playlist_prev);
    VLD_GetProcAddress('libvlc_playlist_get_input', @libvlc_playlist_get_input);
    VLD_GetProcAddress('libvlc_input_free', @libvlc_input_free);
    VLD_GetProcAddress('libvlc_input_get_length', @libvlc_input_get_length);
    VLD_GetProcAddress('libvlc_input_get_time', @libvlc_input_get_time);
    VLD_GetProcAddress('libvlc_input_get_position', @libvlc_input_get_position);
    VLD_GetProcAddress('libvlc_toggle_fullscreen', @libvlc_toggle_fullscreen);
    VLD_GetProcAddress('libvlc_set_fullscreen', @libvlc_set_fullscreen);
    VLD_GetProcAddress('libvlc_get_fullscreen', @libvlc_get_fullscreen);
    VLD_GetProcAddress('libvlc_video_get_width', @libvlc_video_get_width);
    VLD_GetProcAddress('libvlc_video_get_height', @libvlc_video_get_height);
    VLD_GetProcAddress('libvlc_audio_get_mute', @libvlc_audio_get_mute);
    VLD_GetProcAddress('libvlc_audio_set_mute', @libvlc_audio_set_mute);
    VLD_GetProcAddress('libvlc_audio_get_volume', @libvlc_audio_get_volume);
    VLD_GetProcAddress('libvlc_audio_set_volume', @libvlc_audio_set_volume);

    VLD_GetProcAddress('libvlc_video_set_parent', @libvlc_video_set_parent);
//    VLD_GetProcAddress('libvlc_video_get_parent', @libvlc_video_get_parent);
    VLCLibLoaded := true;
  end;
  Result := LastError;
end;
{$ENDIF}

end.
Retrieved from "https://wiki.videolan.org/index.php?title=IceVLCPlayer&oldid=21498"