ActiveX-Komponente von "VideoLAN" nutzbar

[Troelli]

Ich sitze da auch schon 2 Tage dran, jedoch möchte ich dazu sagen das ich Vollnoob bin.
Aber die meisten Funktionen gehen bei mir ...
Mal abgesehen davon das man sich die DLLs in APP verzeichnis kopieren muss.
Ach ja ... ich habe die neue vlc-0.9.8a-win32.exe genommen ...

Delphi-Quellcode:

unit VLCPlayer;

{ TTFPlayer  -  VLC Player for Delphi (0.9.2) (c)2008 by Keypad
  Thanks to IceBob for his IceVLCPlayer : [url]http://wiki.videolan.org/IceVLCPlayer[/url]  }

interface

uses
  Dialogs, SysUtils, Classes, Controls, ExtCtrls, libvlc, Graphics, Windows,
  Forms,Variants;

type

 TValue=packed record
 case byte of
  0:(AsInteger:integer);
  1:(AsBoolean:longbool);
  2:(AsFloat  :single);
  3:(AsPChar  :pchar);
  4:(AsPointer:pointer);
  5:(AsObject :pointer); // ^vcl_object_t
  6:(AsList   :pointer); // ^vcl_list_t
  7:(AsTime   :int64);
  8:(AsVar    :record name:pchar; id:integer end );
 end;
  TEVLCException = class(Exception);
  TEVLCNotFound = class(Exception);
  TEVLCLoadLibrary = class(Exception);

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


  TTFPPlayer = class(TCustomPanel)
  private
    VLC : libvlc_instance;
    Media : libvlc_media;
    MediaTime : libvlc_time;
    MediaState : libvlc_state;
    Medialist : libvlc_media_list;
    Medialistplayer : libvlc_media_list_player;
    MediaPlayer : libvlc_media_player;
    MediaDiscoverer : libvlc_media_discoverer;
    PlaylistIt : libvlc_playlist_item;
    logofond : TImage;
    VLCVideo : integer;
    VLCMP : integer;
    VLCInput : libvlc_input;
    VLCError : libvlc_exception;
    FLength: Int64;
    FIsPlaying: boolean;
    FSpeed : single;
    FIsCreate : boolean;
    FTime: Int64;
    FPosition: Single;
    FVLCPanel:TPanel;
    Fvolume : integer;
    FTimer: TTimer;
    FVideoWidth: integer;
    FPlaylistIndex: integer;
    FVideoHeight: integer;
    FVideo : integer;
    FSeekable : integer;
    FOnPlay: TNotifyEvent;
    FOnStop: TNotifyEvent;
    FOnError: TErrorEvent;
    FOnStartPlaying : Tnotifyevent;  // Début de lecture
    FOnEndPlaying   : TNotifyEvent;  // Fin de la lecture en cours
    function GetVolume: Integer;
    procedure SetVolume(const Value: Integer);
    function GetSpeed: Single;
    procedure SetSpeed(const Value: Single);
    function Gettime : integer;
    procedure Settime(const value: libvlc_time);
    function Getposition : single;

    procedure Setposition(const Value: single);

    function GetState: Integer;

    function GetVideo: Integer;
    function GetSeekable : integer;
   // function GetPlaylistIndex : integer;
    function CheckError: boolean;
    procedure FTimerTimer(Sender: TObject);
    procedure StartPlaying;
    procedure SetOnPlay(const Value: TNotifyEvent);
    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 IsPlaying: boolean read FIsPlaying;
    property IsVideo: integer read GetVideo;
    property IsSeekable: integer read GetSeekable;
    property IsCreate: boolean read FIsCreate;
    property VideoWidth: integer read FVideoWidth;
    property VideoHeight: integer read FVideoHeight;
    property Volume:Integer read GetVolume write SetVolume;
    property Speed:Single read GetSpeed write SetSpeed;
    property Position:Single read GetPosition write SetPosition;
    property PlayListIndex: integer read FPlaylistIndex;
    property Time:Integer read GetTime write SetTime;
    property State:Integer read GetState;
    
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    // lancement d'un média
    procedure Play(const FilePath, FileName, options: string; second : integer);
    procedure PlayTV(const CaptureDev: string; const Channel: integer; const Country: integer = 0);
    procedure fullscreen;
    procedure Stop;
    procedure pause;
    procedure photo(Filename: pchar; largeur, hauteur:integer);
    procedure Playlistnext;
   procedure Playlistprevious;
   function PlaylistItemIndex : integer;
   function PlaylistItemCount : integer;
   procedure Playlist_Clear;
 //  procedure Playlist_play(filename : pchar);

  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;



implementation



{ TIceVLCPlayer }

constructor TTFPPlayer.Create(AOwner: TComponent);
var
  Args: array [0..1] of PChar;
  val:TValue;
begin
  inherited Create(AOwner);
  FIsCreate := false;
  VLC := nil;
  VLCInput := nil;
  Media := nil;
  MediaPlayer := nil;
  VLCVideo := 0;
  FIsPlaying := False;
  ParentColor := false;
  Color := clBlack;
  Caption := '';
  BevelOuter := bvNone;

  case VLD_Startup of
   VLD_SUCCESS  :
    begin

    end;
   VLD_NOLIB    :
    begin
      raise TEVLCLoadLibrary.Create('VLC Player ist nicht installiert!');
      exit;
    end;
   VLD_NOTFOUND :
    begin
      raise TEVLCNotFound.Create('VLC Player ist nicht installiert oder falsche Version!');
      exit;
    end;
  end;

  //On efface les erreurs
  FillChar(VLCError,SizeOf(VLCError),0);

  //On crée une instance de VLC
  args[0]:=pchar('--plugin-path=' + VLD_LibPath);
  Args[1] := nil;

  VLC := libvlc_new( 1, @Args[0], VLCError);

  // on crée un timer
  FTimer := TTimer.Create(nil);
  FTimer.Enabled := False;
  FIsCreate := true;
  FTimer.Interval := 500;
  FTimer.OnTimer := FTimerTimer;
end;

destructor TTFPPlayer.Destroy;
begin
  FTimer.Free;
  // NTDLL.DLL error :(
  //  if Assigned(VLC) then
  //    libvlc_destroy(VLC);

  inherited;
end;

////////////////////////////////////////////////////////////////////////////
// Fonction State, renvoie sous forme d'un entier l'état du lecteur :     //
// IDLE/CLOSE=0, OPENING=1, BUFFERING=2, PLAYING=3, PAUSED=4, STOPPING=5, //
// FORWARD=6, BACKWARD=7, ENDED=8, ERROR=9                                //
////////////////////////////////////////////////////////////////////////////
function TTFPPlayer.getstate : Integer;
begin
Result := libvlc_media_player_get_state(mediaplayer, vlcerror);
checkerror;
end;

function TTFPPlayer.getvolume : Integer;
begin
Result := libvlc_audio_get_volume(VLC, Vlcerror);
checkerror;
end;

function TTFPPlayer.getvideo : Integer;
begin
Result := libvlc_media_player_has_vout(mediaplayer, vlcerror);
FVideo := Result;
checkerror;
end;

function TTFPPlayer.getspeed : Single;
begin
Result := libvlc_media_player_get_rate(mediaplayer, vlcerror);
FSpeed := Result;
checkerror;
end;

procedure TTFPPlayer.SetSpeed(const value: single);
begin
libvlc_media_player_set_rate(mediaplayer,value,vlcerror);
checkerror;
end;

function TTFPPlayer.getseekable : Integer;
begin
Result := libvlc_media_player_is_seekable(mediaplayer, vlcerror);
FSeekable := Result;
checkerror;
end;

procedure TTFPPlayer.photo(Filename: pchar; largeur, hauteur:integer);
begin
libvlc_video_take_snapshot(MediaPlayer, pchar(filename), largeur,hauteur,vlcerror);
checkerror;
end;

procedure TTFPPlayer.Playlist_Clear;
begin
libvlc_playlist_clear(vlc,vlcerror);
end;

procedure TTFPPlayer.playlistnext;
begin
libvlc_playlist_next(vlc,vlcerror);
checkerror;
end;

function TTFPPlayer.PlaylistItemcount : integer;
begin
result := libvlc_playlist_items_count(vlc, vlcerror);
checkerror;
end;

function TTFPPlayer.PlaylistItemIndex : integer;
begin
result := libvlc_playlist_get_current_index(vlc, vlcerror);
checkerror;
end;

procedure TTFPPlayer.playlistprevious;
begin
libvlc_playlist_prev(vlc,vlcerror);
checkerror;
end;

procedure ttfpplayer.fullscreen;
begin
if IsPlaying then
  begin
    if Assigned(mediaplayer) then
    begin
if libvlc_get_fullscreen(mediaplayer,vlcerror) = 0 then
        libvlc_set_fullscreen(mediaplayer,1, vlcerror)
else
        libvlc_set_fullscreen(mediaplayer,0, vlcerror);
checkerror;
end;
end;
end;

procedure TTFPPlayer.SetVolume(const Value: Integer);
begin
libvlc_audio_set_volume(vlc,value,vlcerror);
checkerror;
end;

function TTFPPlayer.gettime : Integer;
begin
result := libvlc_media_player_get_time(mediaplayer, vlcerror) div 1000;
//result := libvlc_media_player_get_time(mediaplayer, vlcerror) ;
checkerror;
end;

procedure TTFPPlayer.Settime(const value: libvlc_time);
//procedure TTFPPlayer.Settime(const value: Integer);
var
duree : integer;
pos : single;
begin
duree := libvlc_media_player_get_length(mediaplayer, vlcerror) div 1000;
//duree := libvlc_media_player_get_length(mediaplayer, vlcerror) ;
checkerror;
pos := value / duree;
libvlc_media_player_set_position(mediaplayer, value, vlcerror);
checkerror;
end;

function TTFPPlayer.getposition : single;
begin
result := libvlc_media_player_get_position(mediaplayer, vlcerror);
checkerror;
end;

procedure TTFPPlayer.Setposition(const Value: single);
begin
libvlc_media_player_set_position(mediaplayer, value,vlcerror);
checkerror;
end;

procedure TTFPPlayer.Stop;
begin
  StopIfPlaying;
end;

procedure TTFPPlayer.pause;
begin
libvlc_playlist_pause(vlc,vlcerror);
CheckError;
end;

procedure TTFPPlayer.StopIfPlaying;
begin
if (IsPlaying) then
  begin
  libvlc_playlist_stop(VLC, VLCError);
  CheckError;
  libvlc_playlist_clear(VLC, VLCError);
  CheckError;

  FTimer.Enabled := False;
  FIsPlaying := False;
  VLCVideo := 0;
  if Assigned(OnStop) then
    OnStop(Self);
  end;
end;


procedure TTFPPlayer.Play(const FilePath, FileName, options: string; second : integer);
var
 slTmp:TStringList;
 i,j:integer;
 s:array of String;
begin
  // on arrete la lecture s'il y a ..
  StopIfPlaying;
  vlcvideo := 0;
  // on récupere les options de lecture (toujours passer les options comme suit 'option1' + #13'option2' )
  slTmp:=TStringList.Create;
        try
        slTmp.text:=options;
        for j:=slTmp.Count-1 downto 0 do
                begin
                if slTmp[j]='' then slTmp.Delete(j);
                end;
        for i:=0 to slTmp.count-1 do
                begin
                If slTmp[i]<>'' then
                      SetLength(s,system.length(s)+1);
                s[system.length(s)-1]:=PChar(slTmp[i]);
                end;
        finally
                slTmp.free;
        end;
vlcvideo := libvlc_playlist_add_extended(vlc,pchar(filepath),pchar(filename),  system.length(s), ppchar(s),  vlcerror);//on ajoute le nouveau flu
checkerror;
StartPlaying;
end;

procedure TTFPPlayer.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 TTFPPlayer.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 TTFPPlayer.StartPlaying;
begin
libvlc_video_set_parent(VLC, Self.Handle, VLCError);
CheckError;
libvlc_playlist_play(VLC, VLCVideo, 0, nil, VLCError);
checkerror;
FLength := -2; //returned Length = -1 - stream; 0 -  TV , >0 - local file
// on active le timer
FTimer.Enabled := true;


end;




procedure TTFPPlayer.FTimerTimer(Sender: TObject);
var
  Ln: int64;
begin
  MediaPlayer := libvlc_playlist_get_media_player(vlc, vlcerror);
  checkerror;
  
  FTimer.Enabled := False;
        try
        //Durée du média (msec)
        Ln := libvlc_media_player_get_length(MediaPlayer, VLCError) div 1000;
        //Ln := libvlc_media_player_get_length(MediaPlayer, VLCError) ;
        CheckError;
        if not CheckError then
                begin
                if IsPlaying then
                        begin
                        //If end of movie then cause error.
                        FIsPlaying := False;
                        StopifPlaying;
                        exit;
                        end
                else
                        begin
                        FTimer.Enabled := True;
                        exit;
                        end;
                end;

        FLength := Ln;
        //Position en ms du média (msec)
        FTime := libvlc_media_player_get_time(MediaPlayer, vlcerror) div 1000;
        CheckError;

        // position (0 -> 1) du media
        FPosition := libvlc_media_player_get_position(MediaPlayer, VLCError);
        CheckError;

        if CheckError and (not IsPlaying) then
                begin
                FIsPlaying := True;
                if Assigned(OnPlay) then
                        OnPlay(Self);
                end;
        FTimer.Enabled := True;
        Except
                if IsPlaying then
                        begin
                        StopifPlaying;
                        //if Assigned(OnStop) then
                               // OnStop(Self);
                        end;
        end;
end;

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

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

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

end.

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls,VLCPlayer, ComCtrls, JvExComCtrls, JvComCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Timer1: TTimer;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    Button10: TButton;
    Button11: TButton;
    Button12: TButton;
    JvTrackBar1: TJvTrackBar;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Button13: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure JvTrackBar1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Timer1Timer(Sender: TObject);
    procedure CreateVLC;
    procedure Button13Click(Sender: TObject);
  private
    { Private declarations }
  public
      vlccreate : boolean;
      Applikation_Path : string;
  end;

var
  Form1: TForm1;
  vlcp : TTFPPlayer;
  IndexPlaylist : integer;
  
implementation

{$R *.dfm}
function MSecToTime(mSec: Int64): string;
var
  dt : TDateTime;
begin
   dt := mSec / MSecsPerSec / SecsPerDay;
   Result :=  FormatDateTime('hh:nn:ss', Frac(dt)) ;
end;


procedure TForm1.CreateVLC;
begin
if vlccreate = false then
        begin
        vlcp := TTFPPlayer.Create(Form1.Panel1);
        vlcp.Parent := Form1.Panel1;
        vlcp.Align := alClient;
        vlccreate := true;
        //vlcp.OnPlay := DebutLectureVLC;
        //vlcp.OnStop := Finlecturevlc;
        end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
Applikation_Path:= ExtractFilePath(Application.ExeName);
createVLC;
end;

procedure TForm1.Button1Click(Sender: TObject);
var options : string;
begin
createVLC;
//options := 'fullscreen';
Timer1.Enabled := true;
vlcp.Playlist_Clear;
vlcp.play(Applikation_Path + 'test.m3u', 'test', options,0);
end;

procedure TForm1.Button2Click(Sender: TObject);
var options : string;
begin
createVLC;
options := 'audio-visual=goom';
////////////////////////////////////////////////////////////////////////////////////////////////////////////
// You can have options := 'audio-visual=goom' + #13'fullscreen' if you want to have several options !!!! //
////////////////////////////////////////////////////////////////////////////////////////////////////////////
Timer1.Enabled := true;
//'http://www.pop-radio.de/stream_1_dsl_winamp.pls'
//vlcp.play('http://viphttp.yacast.fr/v4/virgin/virgin.asx', 'test audio', options,0);
vlcp.play('http://www.pop-radio.de/stream_1_dsl_winamp.pls', 'test audio', options,0);
end;


procedure TForm1.Button3Click(Sender: TObject);
begin
 ShowMessage(FloatToStr(vlcp.Speed));
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
      try
          vlcp.Speed := vlcp.Speed * 2;
      except
      end;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
        try
          vlcp.Speed := vlcp.Speed / 2;
        except
          vlcp.Speed := 1;
          end;
end;



procedure TForm1.Button6Click(Sender: TObject);
begin
if indexplaylist > 1 then
        begin

        vlcp.Playlistprevious;
        IndexPlaylist := IndexPlaylist - 1;
        end;
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
if indexplaylist < vlcp.PlaylistItemcount then
        begin
        vlcp.Playlistnext;
        IndexPlaylist := Indexplaylist + 1;
        end;
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
vlcp.fullscreen;
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
 vlcp.Volume := vlcp.Volume - 10;
end;

procedure TForm1.Button10Click(Sender: TObject);
begin
vlcp.Volume := vlcp.Volume + 10;
end;

procedure TForm1.Button11Click(Sender: TObject);
begin
 vlcp.pause;
end;

procedure TForm1.Button12Click(Sender: TObject);
begin
 vlcp.Stop;
end;

procedure TForm1.JvTrackBar1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
//vlcp.time := jvTrackBar1.Position;
showmessage(inttostr(jvTrackBar1.Position));
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
label1.Caption := MSecToTime(vlcp.time)+ ' / ' + MSecToTime(vlcp.Length);
label3.Caption := inttostr(vlcp.time)+ ' / ' + inttostr(vlcp.Length);
label4.Caption := inttostr(JvTrackBar1.Position);
JvTrackBar1.Max := vlcp.Length;
JvTrackBar1.Min := 0;
JvTrackBar1.Position := vlcp.time;
case vlcp.State of
0: Form1.Caption := 'Idle/Close';
1: Form1.Caption := 'Geöffnet';
2: Form1.Caption := 'Am Cachen';
3: Form1.Caption := 'Abspielen';
4: Form1.Caption := 'Pausieren';
5: Form1.Caption := 'Gestoppt';
6: Form1.Caption := 'Vorwärts';
7: Form1.Caption := 'Rückwärts';
8: begin
   Form1.Caption := 'Beenden';
   IndexPlaylist := 1;
   end;
9: Form1.Caption := 'Fehler';
end;
 label2.Caption := inttostr(vlcp.PlaylistItemindex) +' "'+inttostr(indexplaylist)+'"' + ' of ' + inttostr(vlcp.PlaylistItemcount);
end;

procedure TForm1.Button13Click(Sender: TObject);
begin
vlcp.time:=100000;
end;

end.

Vielleicht hilft es ja weiter ...