unit apri4;

{$mode objfpc}{$H+}

 

interface

 

uses

  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,

  StdCtrls, Buttons, PasLibVlcPlayerUnit, PasLibVlcUnit, dglOpenGL, glBitmap,

  Windows;

 

type

  tRGBA = record

    r,g,b,a : byte;

  end;

  tVLCcontext = record

    VLCpixels:array of tRGBA;

  end;

 

  { Tfrmapri4 }

 

  Tfrmapri4 = class(TForm)

    Button1: TButton;

    Button2: TButton;

    Button3: TButton;

    Label1: TLabel;

    Label2: TLabel;

    Panel1: TPanel;

    Panel2: TPanel;

    Panel3: TPanel;

    PasLibVlcMediaList1: TPasLibVlcMediaList;

    Player1: TPasLibVlcPlayer;

    SpeedButton1: TSpeedButton;

    Timer2: TTimer;

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure Button3Click(Sender: TObject);

    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);

    procedure FormCreate(Sender: TObject);

    procedure FormHide(Sender: TObject);

    procedure SpeedButton1Click(Sender: TObject);

  private

    { private declarations }

    StartTime, TimeCount, FrameCount,fc  : Cardinal;

    Frames, DrawTime,VLCRenderTime       : Cardinal;

    DoPlay,NewFrame,fClose: Boolean;

    fTexture1: TglBitmap2D;

    procedure SetupGL;

    procedure Render;

    procedure RenderVLC;

    procedure RenderGL;

  public

    { public declarations }

    libvlc_instance        :libvlc_instance_t_ptr;

    libvlc_media           :libvlc_media_t_ptr;

    libvlc_media_player    :libvlc_media_player_t_ptr;

    libvlc_media_track_info:libvlc_media_track_info_t_ptr;

    VideoWidth,VideoHeight:Integer;

    VLCctx:tVLCcontext;

    DC                                : HDC;

    RC                                : HGLRC;

  end;

 

  function libvlc_video_lock(opaque : Pointer; var planes : Pointer) : Pointer; cdecl;

  function libvlc_video_unlock(opaque : Pointer; picture : Pointer; planes : Pointer) : Pointer; cdecl;

  function libvlc_video_display(opaque : Pointer; picture : Pointer) : Pointer; cdecl;

 

 

var

  frmapri4: Tfrmapri4;

  mio_width:integer = 720;

  mio_hength:integer = 576;

 

 

implementation

 

{$R *.lfm}

 

{ Tfrmapri4 }

 

procedure Tfrmapri4.FormCreate(Sender: TObject);

begin          // PlayList

  PasLibVlcMediaList1.Clear();

  PasLibVlcMediaList1.Add('c:\film\01\01.mp4'); // 480 x 320

  PasLibVlcMediaList1.Add('c:\film\02\02.mpg'); // 1920 x 1080

 

  //******************************************

  libvlc_dynamic_dll_init_with_path('C:\Program Files (x86)\VideoLAN\VLC');

  libvlc_instance := libvlc_new(0, nil);

  //OpenGL:

  DC:= GetDC(Player1.Handle);    //Handle TPasLibVlcPlayer compont visual

  if not InitOpenGL then Application.Terminate;

  RC:= CreateRenderingContext( DC,

                               [opDoubleBuffered],

                               32,

                               24,

                               0,0,0,

                               0);

  ActivateRenderingContext(DC, RC);

  SetupGL;

  TimeCount:=0;

  FrameCount:=0;

  fc:=0;

  DoPlay:=false;

  NewFrame:=false;

end;

 

procedure Tfrmapri4.FormHide(Sender: TObject);

begin

  PasLibVlcMediaList1.Stop;

  PasLibVlcMediaList1.Clear();

end;

 

procedure Tfrmapri4.SpeedButton1Click(Sender: TObject);

begin

   PasLibVlcMediaList1.Next();

end;

 

procedure Tfrmapri4.SetupGL;

begin

  glClearColor(0.3, 0.4, 0.7, 0.0);

  glEnable(GL_DEPTH_TEST);

  glEnable(GL_CULL_FACE);

  glEnable(GL_ALPHA_TEST);

  glAlphaFunc(GL_GREATER, 0.1);

  glMatrixMode(GL_PROJECTION);

  glLoadIdentity;

  glOrtho(0,mio_width,0,mio_hength,0,128);

  //glOrtho(0,1024,0,768,0,128);

  glMatrixMode(GL_MODELVIEW);

end;

 

procedure Tfrmapri4.Render;

begin

   if not DoPlay then begin sleep(20); exit; end;

  if NewFrame then  // NewFrame in debug always False ????

    begin

      NewFrame:=false;

      RenderVLC;

      RenderGL;

      TimeCount:= GetTickCount - StartTime;

      Inc(FrameCount);

      Frames:= FrameCount*1000 div TimeCount;

      Drawtime:=TimeCount div FrameCount;

    end

  else

    begin

      sleep(1);

    end;

end;

 

procedure Tfrmapri4.RenderVLC;

var pp: TglBitmapPixelPosition;

    pf: TglBitmapPixelPositionFields;

begin

  pf:=[ffX];

  pp.Fields:=pf;

  pp.X:=VideoWidth;

  pp.Y:=VideoHeight;

  if fTexture1 = nil then

    begin

      fTexture1 := TglBitmap2D.Create(pp,ifRGBA8);

      fTexture1.AddAlphaFromValue(255);

      fTexture1.FreeDataAfterGenTexture := False;

    end;

  Move(VLCctx.vlcpixels[0],tRGBA(fTexture1.Scanline[0]^),VideoHeight*VideoWidth*4);

  fTexture1.GenTexture;

  glActiveTexture(GL_TEXTURE0);

  fTexture1.Bind;

end;

 

procedure Tfrmapri4.RenderGL;

begin

  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

  glLoadIdentity;

  glTranslatef(0, 0, -5);

  glBegin(GL_QUADS);

  glVertex3f(   0,   0, 0); glMultiTexCoord2fARB(GL_TEXTURE0_ARB,1,1); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,1,1);

  glVertex3f(mio_width,   0, 0); glMultiTexCoord2fARB(GL_TEXTURE0_ARB,1,0); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,1,0);

  glVertex3f(mio_width, mio_hength, 0); glMultiTexCoord2fARB(GL_TEXTURE0_ARB,0,0); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,0,0);

  glVertex3f(   0, mio_hength, 0); glMultiTexCoord2fARB(GL_TEXTURE0_ARB,0,1); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,0,1);

  glEnd;

  SwapBuffers(DC);

end;

 

procedure Tfrmapri4.Button1Click(Sender: TObject);

begin

  VideoWidth :=mio_width;      //  VideoWidth :=720;

  VideoHeight:=mio_hength;     //  VideoHeight:=576;

 

  Setlength(VLCctx.vlcpixels,VideoWidth*VideoHeight*4);

 

  libvlc_media :=  PasLibVlcMediaList1.GetItemAtIndex(0);

  libvlc_media_parse(libvlc_media);

 

  libvlc_media_player := libvlc_media_player_new_from_media(libvlc_media);

  libvlc_media_release(libvlc_media);

 //******************************  Render video  720 x 576 ****************

 

   libvlc_video_set_format(libvlc_media_player,'RGBA',VideoWidth,VideoHeight,VideoWidth*4);

   libvlc_video_set_callbacks(libvlc_media_player,@libvlc_video_lock,@libvlc_video_unlock,@libvlc_video_display,@VLCctx);

 

 // ******* Play to PasLibVlcmediaList  component visual ******************

  PasLibVlcMediaList1.Play();

 // ***************************************

    Timer2.Enabled:=true;

  DoPlay:=true;

  StartTime:= GetTickCount;

  while DoPlay do

    begin

      Render;

      Application.ProcessMessages;

    end;

  if fClose then libvlc_media_player_stop(libvlc_media_player);

  if fClose then PasLibVlcMediaList1.Stop;

end;

 

procedure Tfrmapri4.Button2Click(Sender: TObject);

begin

  PasLibVlcMediaList1.Player.LogoSetFile('C:\film\logo\120x100.png');

  PasLibVlcMediaList1.Player.LogoSetEnable(1);

  label1.Caption:= inttostr(PasLibVlcMediaList1.Player.GetVideoWidth());

  label2.Caption:= inttostr(PasLibVlcMediaList1.Player.GetVideoHeight());

end;

 

procedure Tfrmapri4.Button3Click(Sender: TObject);

begin

  PasLibVlcMediaList1.Stop;

end;

 

procedure Tfrmapri4.FormCloseQuery(Sender: TObject; var CanClose: boolean);

begin

    fClose:=True;

  DoPlay:=false;

end;

 

function libvlc_video_lock(opaque : Pointer; var planes : Pointer) : Pointer; cdecl;

begin

  planes := @(frmapri4.VLCctx.vlcpixels[0]);

  Result:=nil;

end;

 

function libvlc_video_unlock(opaque : Pointer; picture : Pointer; planes : Pointer) : Pointer; cdecl;

begin

  Inc(frmapri4.fc);

  frmapri4.NewFrame:=true;

  frmapri4.VLCRenderTime:=GetTickCount;

  Result:=nil;

end;

 

function libvlc_video_display(opaque : Pointer; picture : Pointer) : Pointer; cdecl;

begin

    ////////////////

end;

 

end.

 

 

libvlc_media :=  PasLibVlcMediaList1.GetItemAtIndex(1); // not assign correct media

  libvlc_media_parse(libvlc_media);

 

  libvlc_media_player := libvlc_media_player_new_from_media(libvlc_media);

  libvlc_media_release(libvlc_media);

   //*************************

   libvlc_video_set_format(libvlc_media_player,'RGBA',VideoWidth,VideoHeight,VideoWidth*4);

   libvlc_video_set_callbacks(libvlc_media_player,@libvlc_video_lock,@libvlc_video_unlock,@libvlc_video_display,@VLCctx);