[Lazarus] Play video from memory

aradeonas aradeonas at operamail.com
Sun Mar 15 00:46:44 CET 2015


Hi. Silvio you are right,That is a miss understanding. Here another test
with DelphiFFmpeg,I don't have full version and I can test it with
Delphi. I made a test that play video from memory but there is a delay
between changing files,Can any one test this demo and help me with this?
My goal is buffer second one before first one and after first one
finished play second almost imminently. I also attached Delphi project.

> unit Unit2;
>
> interface
>
> uses Winapi.Windows, Winapi.Messages, System.SysUtils,
> System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls,
> Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, FFBaseComponent, MemoryProtocol,
> Vcl.FFPlay, Vcl.StdCtrls, Vcl.MemoryAccess;
>
> type TForm2 = class(TForm) FFPlayer: TFFPlayer; Panel1: TPanel;
> Button1: TButton; MAA: TMemoryAccessAdapter; ListBox1: TListBox;
> Timer1: TTimer; procedure FormCreate(Sender: TObject); procedure
> Button1Click(Sender: TObject); procedure MAAClose(Sender: TObject);
> function MAAOpen(Sender: TObject; AURLContext: Pointer; const
> APrivateData: string; AFlags: Integer): Boolean; function
> MAARead(Sender: TObject; var Buffer; Count: Integer): Integer;
> function MAASeek(Sender: TObject; const Offset: Int64; Origin:
> TSeekOrigin): Int64; function MAAWrite(Sender: TObject; const Buffer;
> Count: Integer): Integer; procedure FFPlayerState(Sender: TObject;
> APlayState: TPlayState); procedure Timer1Timer(Sender: TObject);
> private { Private declarations } public FStream: TStream; LFileName:
> string; ci: Integer; changing: Boolean; l1,l2:Integer; n1,n2:Integer;
> nn:Boolean; procedure AddMsgLog(AMsg: string); procedure
> PlayNext(ADelta: Integer = 1); procedure TryPlay(AIsDiskFile:
> Boolean); end;
>
> var Form2: TForm2;
>
> implementation
>
> {$R *.dfm}
>
> procedure TForm2.AddMsgLog(AMsg: string); begin
> ListBox1.Items.Add(AMsg); ListBox1.TopIndex := ListBox1.Items.Count
> - 1; end;
>
> procedure TForm2.Button1Click(Sender: TObject); begin
> FFPlayer.TryOpen(Format('memory:%d', [Integer(MAA.Stream)]),
> Panel1.Handle, False); end;
>
> procedure TForm2.FFPlayerState(Sender: TObject; APlayState:
> TPlayState); const CPlayState: array [TPlayState] of string =
> ('Play', 'Pause', 'Resume', 'Step', 'Stop', 'End'); begin // OnState
> event handler
>
> // show state AddMsgLog(CPlayState[APlayState]);
>
> case APlayState of psPlay: begin l2:=GetTickCount; AddMsgLog('---Play
> time: ' + inttostr(l2 - l1)); end; psStop: begin n2:=GetTickCount;
> AddMsgLog('---Stop time: ' + inttostr(n2 - n1)); end; psEnd: begin
> l1:=GetTickCount; n1:=GetTickCount; FFPlayer.Pause; if ci < 2 then if
> not changing then PlayNext; // FFPlayer.Seek(0, [sfBackward]); //
> LFileName := 'C:\ffmpeg\bin\tmp\OUTPUT1.mp4'; //
> FFPlayer.TryOpen(Format('memory:%d', [Integer(MAA.Stream)]),
> Panel1.Handle, False); // FFPlayer.Resume; end; end; end;
>
> procedure TForm2.FormCreate(Sender: TObject); begin ci := 0; changing
> := False;
> FFPlayer.SetLicenseKey('FSXXXXXX-XXXXXXXX-XXXXXXXX-XXXXXXXX-XXXXXXXX');
> FStream := nil; if not FFPlayer.AVLibLoaded then begin if not
> FFPlayer.LoadAVLib(ExtractFilePath(Application.ExeName) + 'LibAV')
> then begin ShowMessage('h'); end; register_memory_protocol; end;
>
> end;
>
> procedure TForm2.MAAClose(Sender: TObject); begin if FStream <> nil
> then FreeAndNil(FStream); end;
>
> function TForm2.MAAOpen(Sender: TObject; AURLContext: Pointer; const
> APrivateData: string; AFlags: Integer): Boolean;
>
> function GetFileSize(const FileName: String): Int64; var SearchRec:
> TSearchRec; begin if FindFirst(ExpandFileName(FileName), faAnyFile,
> SearchRec) = 0 then Result := SearchRec.Size else Result := -1; end;
>
> var LFileSize: Int64; t1, t2: Integer; begin t1 := GetTickCount;
> Result := False;
>
> if FStream <> nil then FreeAndNil(FStream);
>
> LFileName := 'C:\ffmpeg\bin\tmp\OUTPUT' + inttostr(ci) + '.mp4';
> LFileSize := GetFileSize(LFileName); if LFileSize <= 0 then
> AddMsgLog('file error') else if LFileSize < 1024 * 1024 * 10 then
> begin // less than 10 MB, use TMemoryStream FStream :=
> TMemoryStream.Create; (FStream as
> TMemoryStream).LoadFromFile(LFileName); end else // for large file,
> use TFileStream FStream := TFileStream.Create(LFileName, fmOpenRead);
>
> Result := FStream <> nil; t2 := GetTickCount; AddMsgLog('Open time: '
> + inttostr(t2 - t1)); end;
>
> function TForm2.MAARead(Sender: TObject; var Buffer; Count: Integer):
> Integer; var t1, t2: Integer; begin t1 := GetTickCount; if not
> Assigned(FStream) then begin Result := -1; Exit; end; Result :=
> FStream.Read(Buffer, Count); AddMsgLog(Format('MAA read from input
> stream %d -> %d', [Count, Result])); t2 := GetTickCount;
> AddMsgLog('Reed time: ' + inttostr(t2 - t1)); end;
>
> function TForm2.MAASeek(Sender: TObject; const Offset: Int64; Origin:
> TSeekOrigin): Int64; var t1, t2: Integer; begin t1 := GetTickCount; if
> not Assigned(FStream) then begin Result := -1; Exit; end; Result :=
> FStream.Seek(Offset, Origin); AddMsgLog(Format('MAA seek input stream
> [whence: %d] %d -> %d', [Ord(Origin), Offset, Result])); t2 :=
> GetTickCount; AddMsgLog('Seek time: ' + inttostr(t2 - t1)); end;
>
> function TForm2.MAAWrite(Sender: TObject; const Buffer; Count:
> Integer): Integer; begin Result := -1; end;
>
> procedure TForm2.PlayNext(ADelta: Integer); begin changing := True;
> Timer1.Interval := 1; AddMsgLog('Run timer'); Timer1.Enabled :=
> True; end;
>
> procedure TForm2.Timer1Timer(Sender: TObject); begin Timer1.Enabled :=
> False; AddMsgLog('Play next'); TryPlay(True); end;
>
> procedure TForm2.TryPlay(AIsDiskFile: Boolean); begin ci := ci + 1;
> FFPlayer.TryOpen(Format('memory:%d', [Integer(MAA.Stream)]),
> Panel1.Handle, False); changing := False; end;
>
> end.

Regards, Ara



-- 
http://www.fastmail.com - Does exactly what it says on the tin

-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.lazarus-ide.org/pipermail/lazarus/attachments/20150314/947c1046/attachment-0003.html>


More information about the Lazarus mailing list