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.