- 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.