pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

mplayer: Added Image Grab functionality, Rate, FindMPlayerPath, fixed Screen painting when playing an audio file, by Mike Thompson

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3324 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
mgaertner
2014-07-15 20:15:14 +00:00
parent 7db78ca670
commit 3374315c8b
5 changed files with 723 additions and 405 deletions
Download Patch File Download Diff File Expand all files Collapse all files

225
components/mplayer/examples/FullFeatured/FormMain.lfm
View File

@ -1,50 +1,53 @@
object frmMain: TfrmMain
Left = 463
Left = 486
Height = 569
Top = 88
Width = 1248
Top = 222
Width = 1252
ActiveControl = memResults
Caption = 'frmMain'
ClientHeight = 569
ClientWidth = 1248
ClientWidth = 1252
OnCreate = FormCreate
OnMouseWheel = FormMouseWheel
LCLVersion = '1.2.4.0'
object pnlVideo: TPanel
Left = 640
Left = 642
Height = 504
Top = 42
Width = 608
Width = 610
Align = alClient
BevelOuter = bvNone
ClientHeight = 504
ClientWidth = 608
ClientWidth = 610
TabOrder = 0
object MPlayerControl1: TMPlayerControl
Left = 0
Height = 477
Top = 0
Width = 584
Width = 586
Align = alClient
Loop = 0
OnMouseWheel = MPlayerControl1MouseWheel
Volume = 0
OnFeedback = OnFeedback
OnError = OnError
OnPlaying = OnPlaying
OnPlay = OnPlay
OnStop = OnStop
OnGrabImage = OnGrabImage
end
object pnlTrackbar: TPanel
Left = 0
Height = 27
Top = 477
Width = 608
Width = 610
Align = alBottom
BevelOuter = bvNone
ClientHeight = 27
ClientWidth = 608
ClientWidth = 610
TabOrder = 1
object pnlPos: TPanel
Left = 502
Left = 504
Height = 27
Top = 0
Width = 106
@ -66,7 +69,7 @@ object frmMain: TfrmMain
Left = 0
Height = 27
Top = 0
Width = 502
Width = 504
Frequency = 5
OnChange = TrackBarPlayingChange
Position = 0
@ -80,14 +83,14 @@ object frmMain: TfrmMain
end
object TrackBarVolume: TTrackBar
AnchorSideLeft.Control = MPlayerControl1
Left = 584
Left = 586
Height = 477
Top = 0
Width = 24
Max = 25
OnChange = TrackBarVolumeChange
Orientation = trVertical
Position = 10
Position = 0
Reversed = True
ScalePos = trBottom
TickMarks = tmBoth
@ -101,17 +104,17 @@ object frmMain: TfrmMain
Left = 0
Height = 504
Top = 42
Width = 635
Width = 637
Align = alLeft
BevelOuter = bvNone
ClientHeight = 504
ClientWidth = 635
ClientWidth = 637
TabOrder = 1
object memResults: TMemo
Left = 0
Height = 472
Top = 32
Width = 635
Height = 458
Top = 46
Width = 637
Align = alClient
Color = clBlack
Font.Color = clInfoBk
@ -125,150 +128,74 @@ object frmMain: TfrmMain
end
object pnlCommands: TPanel
Left = 0
Height = 32
Height = 46
Top = 0
Width = 635
Width = 637
Align = alTop
BevelOuter = bvNone
ClientHeight = 32
ClientWidth = 635
ClientHeight = 46
ClientWidth = 637
TabOrder = 1
object cboCommand: TComboBox
Left = 12
Left = 272
Height = 23
Top = 5
Width = 524
Top = 20
Width = 266
Anchors = [akTop, akLeft, akRight]
DropDownCount = 15
ItemHeight = 15
ItemIndex = 0
Items.Strings = (
'get_audio_bitrate'
'get_audio_codec'
'get_audio_samples'
'get_file_name'
'get_meta_comment'
'get_time_length'
'get_time_pos'
'get_video_bitrate'
'get_video_codec'
'get_video_resolution'
'mute '
'stop'
'osd [level]'
'osd_show_progression'
'osd_show_text <string> [duration] [level]'
'exit'
'frame_step'
'seek <seconds_From_Start> 2'
'seek <percent> 1'
'screenshot 0'
'speed_mult <value>'
'get_property <property>'
'set_property <property> <value>'
'Available properties:'
''
'name type min max get set step comment'
'================================================================='
''
'osdlevel int 0 3 X X X as -osdlevel'
'speed float 0.01 100 X X X as -speed'
'loop int -1 X X X as -loop'
'pause flag 0 1 X 1 if paused, use with pausing_keep_force'
'filename string X file playing w/o path'
'path string X file playing'
'demuxer string X demuxer used'
'stream_pos pos 0 X X position in stream'
'stream_start pos 0 X start pos in stream'
'stream_end pos 0 X end pos in stream'
'stream_length pos 0 X (end - start)'
'stream_time_pos time 0 X present position in stream (in seconds)'
'titles int X number of titles'
'chapter int 0 X X X select chapter'
'chapters int X number of chapters'
'angle int 0 X X X select angle'
'length time X length of file in seconds'
'percent_pos int 0 100 X X X position in percent'
'time_pos time 0 X X X position in seconds'
'metadata str list X list of metadata key/value'
'metadata/* string X metadata values'
'volume float 0 100 X X X change volume'
'balance float -1 1 X X X change audio balance'
'mute flag 0 1 X X X'
'audio_delay float -100 100 X X X'
'audio_format int X'
'audio_codec string X'
'audio_bitrate int X'
'samplerate int X'
'channels int X'
'switch_audio int -2 255 X X X select audio stream'
'switch_angle int -2 255 X X X select DVD angle'
'switch_title int -2 255 X X X select DVD title'
'capturing flag 0 1 X X X dump primary stream if enabled'
'fullscreen flag 0 1 X X X'
'deinterlace flag 0 1 X X X'
'ontop flag 0 1 X X X'
'rootwin flag 0 1 X X X'
'border flag 0 1 X X X'
'framedropping int 0 2 X X X 1 = soft, 2 = hard'
'gamma int -100 100 X X X'
'brightness int -100 100 X X X'
'contrast int -100 100 X X X'
'saturation int -100 100 X X X'
'hue int -100 100 X X X'
'panscan float 0 1 X X X'
'vsync flag 0 1 X X X'
'video_format int X'
'video_codec string X'
'video_bitrate int X'
'width int X "display" width'
'height int X "display" height'
'fps float X'
'aspect float X'
'switch_video int -2 255 X X X select video stream'
'switch_program int -1 65535 X X X (see TAB default keybinding)'
'sub int -1 X X X select subtitle stream'
'sub_source int -1 2 X X X select subtitle source'
'sub_file int -1 X X X select file subtitles'
'sub_vob int -1 X X X select VOBsubs'
'sub_demux int -1 X X X select subs from demux'
'sub_delay float X X X'
'sub_pos int 0 100 X X X subtitle position'
'sub_alignment int 0 2 X X X subtitle alignment'
'sub_visibility flag 0 1 X X X show/hide subtitles'
'sub_forced_only flag 0 1 X X X'
'sub_scale float 0 100 X X X subtitles font size'
'tv_brightness int -100 100 X X X'
'tv_contrast int -100 100 X X X'
'tv_saturation int -100 100 X X X'
'tv_hue int -100 100 X X X'
'teletext_page int 0 799 X X X'
'teletext_subpage int 0 64 X X X'
'teletext_mode flag 0 1 X X X 0 - off, 1 - on'
'teletext_format int 0 3 X X X 0 - opaque,'
' 1 - transparent,'
' 2 - opaque inverted,'
' 3 - transparency inverted,'
'teletext_half_page int 0 2 X X X 0 - off, 1 - top half,'
' 2- bottom half'
)
TabOrder = 0
Text = 'get_audio_bitrate'
Text = '-help'
end
object btnRunCommand: TButton
Left = 544
Left = 546
Height = 25
Top = 4
Top = 20
Width = 91
Anchors = [akTop, akRight]
Caption = 'Run Command'
OnClick = btnRunCommandClick
TabOrder = 1
end
object lblStartParams: TLabel
Left = 6
Height = 15
Top = 3
Width = 215
Caption = 'Start Params (passed to mplayer on Play)'
ParentColor = False
end
object cboStartParams: TComboBox
Left = 6
Height = 23
Top = 20
Width = 215
ItemHeight = 15
ItemIndex = 1
Items.Strings = (
'-vo gl_nosw'
'-vo direct3d'
'-vf snapshot'
)
TabOrder = 2
Text = '-vo direct3d'
end
object lblCommand: TLabel
Left = 272
Height = 15
Top = 3
Width = 324
Caption = 'Slave Command (if playing) / mplayer Params (if not playing)'
ParentColor = False
end
end
end
object Splitter1: TSplitter
Left = 635
Left = 637
Height = 504
Top = 42
Width = 5
@ -277,7 +204,7 @@ object frmMain: TfrmMain
Left = 0
Height = 42
Top = 0
Width = 1248
Width = 1252
AutoSize = True
ButtonHeight = 40
Caption = 'tbMain'
@ -302,6 +229,7 @@ object frmMain: TfrmMain
Left = 40
Top = 2
Caption = 'Play'
Enabled = False
ImageIndex = 1
OnClick = btnPlayClick
end
@ -341,6 +269,7 @@ object frmMain: TfrmMain
Caption = 'Fast Forward'
Enabled = False
ImageIndex = 5
OnClick = btnFWDClick
end
object ToolButton9: TToolButton
Left = 435
@ -355,6 +284,7 @@ object frmMain: TfrmMain
Caption = 'Grab Frame'
Enabled = False
ImageIndex = 6
OnClick = btnFrameGrabClick
end
object btnNudgeBack: TToolButton
Left = 273
@ -362,6 +292,7 @@ object frmMain: TfrmMain
Caption = 'Nudge Back'
Enabled = False
ImageIndex = 7
OnClick = btnNudgeBackClick
end
object btnNudgeForward: TToolButton
Left = 345
@ -369,6 +300,7 @@ object frmMain: TfrmMain
Caption = 'Nudge Forward'
Enabled = False
ImageIndex = 8
OnClick = btnNudgeForwardClick
end
object ToolButton4: TToolButton
Left = 268
@ -382,16 +314,18 @@ object frmMain: TfrmMain
Left = 0
Height = 23
Top = 546
Width = 1248
Width = 1252
Panels = <>
end
object OpenDialog1: TOpenDialog
left = 32
top = 56
Filter = 'All Video|*.wmv;*.asf;*.avi;*.mpg;*.mpeg;*.divx;*.mp4;*.pkt|Microsoft Video|*.wmv;*.asf|Other Video|*.avi;*.mpg;*.mpeg;*.divx;*.mp4|NetMC Video|*.pkt|Text Files|*.txt|Microsoft Audio|*.wma|All Files|*.*'
FilterIndex = 0
left = 40
top = 88
end
object ilTools: TImageList
left = 280
top = 72
top = 88
Bitmap = {
4C69090000001000000010000000EBBA78CFEBBA78FFEBBA78FFEBBA78FFEBBA
78FFEBBA78FFEBBA78FFEBBA78FFEBBA78FFEBBA78FFEBBA78FFEBBA78FFEBBA
@ -684,4 +618,11 @@ object frmMain: TfrmMain
FF00FFFFFF00FFFFFF00FFFFFF00
}
end
object dlgFindmplayer: TOpenDialog
Title = 'Locate mplayer.exe'
Filter = 'mplayer.exe|mplayer.exe'
Options = [ofPathMustExist, ofFileMustExist, ofEnableSizing]
left = 175
top = 183
end
end

334
components/mplayer/examples/FullFeatured/FormMain.pas
View File

@ -6,65 +6,81 @@ Interface
Uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Buttons, ExtCtrls, ComCtrls,
StdCtrls, MPlayerCtrl;
StdCtrls, MPlayerCtrl, Process, types;
Type
{ TfrmMain }
TfrmMain = Class(TForm)
btnFrameGrab: TToolButton;
btnFWD: TToolButton;
btnLoad: TToolButton;
btnNudgeBack: TToolButton;
btnNudgeForward: TToolButton;
btnPause: TToolButton;
btnPlay: TToolButton;
btnRewind: TToolButton;
btnRunCommand: TButton;
btnStop: TToolButton;
cboCommand: TComboBox;
cboStartParams: TComboBox;
ilTools: TImageList;
lblCommand: TLabel;
lblPos: TLabel;
lblStartParams: TLabel;
memResults: TMemo;
MPlayerControl1: TMPlayerControl;
OpenDialog1: TOpenDialog;
pnlTrackbar: TPanel;
pnlPos: TPanel;
dlgFindmplayer: TOpenDialog;
pnlCommands: TPanel;
pnlFeedback: TPanel;
pnlPos: TPanel;
pnlTrackbar: TPanel;
pnlVideo: TPanel;
Splitter1: TSplitter;
StatusBar1: TStatusBar;
tbMain: TToolBar;
btnLoad: TToolButton;
btnFrameGrab: TToolButton;
btnNudgeBack: TToolButton;
ToolButton2: TToolButton;
btnPlay: TToolButton;
btnStop: TToolButton;
btnPause: TToolButton;
btnNudgeForward: TToolButton;
ToolButton4: TToolButton;
ToolButton6: TToolButton;
btnRewind: TToolButton;
btnFWD: TToolButton;
ToolButton9: TToolButton;
TrackBarPlaying: TTrackBar;
TrackBarVolume: TTrackBar;
procedure btnFrameGrabClick(Sender: TObject);
procedure btnFWDClick(Sender: TObject);
Procedure btnLoadClick(Sender: TObject);
procedure btnNudgeBackClick(Sender: TObject);
procedure btnNudgeForwardClick(Sender: TObject);
Procedure btnPauseClick(Sender: TObject);
Procedure btnPlayClick(Sender: TObject);
Procedure btnRunCommandClick(Sender: TObject);
Procedure btnStopClick(Sender: TObject);
Procedure FormCreate(Sender: TObject);
procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
var Handled: Boolean);
procedure MPlayerControl1MouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
var Handled: Boolean);
procedure OnGrabImage(ASender: TObject; AFilename: String);
Procedure OnError(ASender: TObject; AStrings: TStringList);
Procedure OnFeedback(ASender: TObject; AStrings: TStringList);
Procedure OnPlay(Sender: TObject);
Procedure OnPlaying(ASender: TObject; APosition: Single);
Procedure OnStop(Sender: TObject);
Procedure TrackBarPlayingChange(Sender: TObject);
Procedure TrackBarPlayingMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Procedure TrackBarPlayingMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Procedure TrackBarVolumeChange(Sender: TObject);
Private
Function GetUpdatingPosition: Boolean;
Procedure SetUpdatingPosition(AValue: Boolean);
Procedure PopulateCommands(ARunning: Boolean);
Procedure RefreshUI;
Private
FUpdatingPosition: Integer;
FLastPosition: Integer;
@ -77,11 +93,14 @@ Var
Implementation
Uses
FileUtil;
{$R *.lfm}
{ TfrmMain }
Procedure TfrmMain.FormCreate(Sender: TObject);
procedure TfrmMain.FormCreate(Sender: TObject);
Begin
FUpdatingPosition := 0;
FLastPosition := -1;
@ -89,62 +108,157 @@ Begin
MPlayerControl1.Volume := 50;
// Have a go at finding where mplayer is installed
If Not MPlayerControl1.FindMPlayerPath Then
MPlayerControl1.MPlayerPath :=
IncludeTrailingBackslash(ExtractFileDir(Application.ExeName)) +
IncludeTrailingBackSlash('mplayer') + 'mplayer' + GetExeExt;
{$IFDEF Linux}
MPlayerControl1.MPlayerPath := '';
MPlayerControl1.StartParam := '-vo x11 -zoom -fs';
{$else $IFDEF Windows}
// Download MPlayer generic for Windows and save under Programm Folder Directory
// http://sourceforge.net/projects/mplayer-win32/
MPlayerControl1.MPlayerPath :=
IncludeTrailingBackslash(ExtractFileDir(Application.ExeName)) + 'mplayer\mplayer.exe';
MPlayerControl1.StartParam := '-vo gl_nosw';
//MPlayerControl1.StartParam := '-vo direct3d';
//MPlayerControl1.StartParam := '-vf screenshot';
MPlayerControl1.StartParam := '-vo direct3d -nofontconfig';
{$ENDIF}
cboStartParams.Text := MPlayerControl1.StartParam;
PopulateCommands(False);
End;
Procedure TfrmMain.btnLoadClick(Sender: TObject);
procedure TfrmMain.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
var Handled: Boolean);
begin
Caption := Format('WheelDelta %d', [WheelDelta]);
end;
procedure TfrmMain.MPlayerControl1MouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
var Handled: Boolean);
begin
if MPlayerControl1.Running Then
begin
MPlayerControl1.Paused := True;
if WheelDelta>0 Then
MPlayerControl1.Position := MPlayerControl1.Position + 1/3
Else
MPlayerControl1.Position := MPlayerControl1.Position - 1/3;
end;
end;
procedure TfrmMain.OnGrabImage(ASender: TObject; AFilename: String);
begin
memResults.Lines.Add('Grabbed image: '+AFilename);
end;
procedure TfrmMain.btnLoadClick(Sender: TObject);
Begin
// If we didn't find the mplayer install, then ask the user if they know instead...
If not MPlayerControl1.FindMPlayerPath Then
begin
dlgFindmplayer.Filename := 'mplayer'+GetExeExt;
If dlgFindmplayer.Execute Then
MPlayerControl1.MPlayerPath:=dlgFindmplayer.FileName;
end;
If Not FileExists(MPlayerControl1.MPlayerPath) Then
ShowMessage('mplayer not found!');
If OpenDialog1.Execute Then
Begin
MPlayerControl1.Stop;
memResults.Lines.Clear;
MPlayerControl1.StartParam := cboStartParams.Text;
MPlayerControl1.Filename := OpenDialog1.Filename;
MPlayerControl1.Play;
btnPlay.Enabled := True;
End;
End;
Procedure TfrmMain.btnPauseClick(Sender: TObject);
procedure TfrmMain.btnNudgeBackClick(Sender: TObject);
begin
MPlayerControl1.Paused := True;
MPlayerControl1.Position := MPlayerControl1.Position - 1;
end;
procedure TfrmMain.btnNudgeForwardClick(Sender: TObject);
begin
MPlayerControl1.Paused := True;
MPlayerControl1.Position := MPlayerControl1.Position + 1;
end;
procedure TfrmMain.btnFWDClick(Sender: TObject);
begin
MPlayerControl1.Rate := MPlayerControl1.Rate * sqrt(2);
end;
procedure TfrmMain.btnFrameGrabClick(Sender: TObject);
begin
MPlayerControl1.ImagePath:=ExtractFilePath(MPlayerControl1.Filename);
MPlayerControl1.GrabImage;
//memResults.Lines.Add('Grabbed '+MPlayerControl1.LastImageFilename);
end;
procedure TfrmMain.btnPauseClick(Sender: TObject);
Begin
MPlayerControl1.Paused := Not MPlayerControl1.Paused;
btnPause.Down := MPlayerControl1.Paused;
End;
Procedure TfrmMain.btnPlayClick(Sender: TObject);
procedure TfrmMain.btnPlayClick(Sender: TObject);
Begin
MPlayerControl1.Play;
End;
Procedure TfrmMain.btnRunCommandClick(Sender: TObject);
procedure TfrmMain.btnRunCommandClick(Sender: TObject);
Var
sOutput: String;
slCommands : TStringList;
arrCommands : Array Of String;
i : Integer;
Begin
memResults.Lines.Add(cboCommand.Text);
MPlayerControl1.SendMPlayerCommand(cboCommand.Text);
If MPlayerControl1.Running Then
Begin
memResults.Lines.Add(cboCommand.Text);
MPlayerControl1.SendMPlayerCommand(cboCommand.Text);
End
Else
Begin
sOutput := '';
slCommands := TStringList.Create;
slCommands.Delimiter:=' ';
Try
CommandToList(cboCommand.Text, slCommands);
SetLength(arrCommands, slCommands.Count);
For i := 0 To slCommands.Count-1 Do
arrCommands[i] := slCommands[i];
RunCommand(MplayerControl1.MPlayerPath, arrCommands, sOutput);
memResults.Lines.Add(MplayerControl1.MPlayerPath + ' ' + slCommands.DelimitedText);
memResults.Append(sOutput);
finally
slCommands.Free;
end;
End;
End;
Procedure TfrmMain.btnStopClick(Sender: TObject);
procedure TfrmMain.btnStopClick(Sender: TObject);
Begin
MPlayerControl1.Stop;
End;
Procedure TfrmMain.OnFeedback(ASender: TObject; AStrings: TStringList);
procedure TfrmMain.OnFeedback(ASender: TObject; AStrings: TStringList);
Begin
memResults.Lines.AddStrings(AStrings);
memResults.SelStart := Length(memResults.Text);
//memResults.SelLength := 0;
End;
Procedure TfrmMain.OnError(ASender: TObject; AStrings: TStringList);
procedure TfrmMain.OnError(ASender: TObject; AStrings: TStringList);
Var
i: Integer;
Begin
@ -152,9 +266,9 @@ Begin
memResults.Lines.Add(' Err: ' + AStrings[i]);
End;
Procedure TfrmMain.OnPlaying(ASender: TObject; APosition: Single);
procedure TfrmMain.OnPlaying(ASender: TObject; APosition: Single);
Begin
If (MPlayerControl1.Duration <> -1) Then
If (MPlayerControl1.Duration>0) Then
Begin
UpdatingPosition := True;
Try
@ -168,22 +282,32 @@ Begin
' / ' + FormatDateTime('nnn:ss', MPlayerControl1.Duration / (24 * 60 * 60));
pnlPos.Width := lblPos.Width + 3;
// Reversed := True doesn't seem to apply for SelStart/SelEnd...
// TODO: Talk about on Forum/Consider lodging item on Bugtracker...
TrackBarVolume.SelEnd := TrackBarVolume.Max;
TrackBarVolume.SelStart := TrackBarVolume.Max - Trunc(TrackBarVolume.Max *
MPlayerControl1.Volume / 100);
If ActiveControl <> TrackBarVolume Then
TrackBarVolume.Position := TrackBarVolume.SelEnd - TrackBarVolume.SelStart;
Finally
UpdatingPosition := False;
End;
End;
UpdatingPosition:=True;
Try
// Reversed := True doesn't seem to apply for SelStart/SelEnd...
// TODO: Talk about on Forum/Consider lodging item on Bugtracker...
TrackBarVolume.SelEnd := TrackBarVolume.Max;
TrackBarVolume.SelStart := TrackBarVolume.Max - Trunc(TrackBarVolume.Max *
MPlayerControl1.Volume / 100);
If ActiveControl <> TrackBarVolume Then
TrackBarVolume.Position := TrackBarVolume.SelEnd - TrackBarVolume.SelStart;
finally
UpdatingPosition := False;
end;
If MPlayerControl1.Paused Then
StatusBar1.SimpleText := 'Paused'
Else
StatusBar1.SimpleText := Format('Playing at rate %.3f', [MPlayerControl1.Rate]);
End;
Procedure TfrmMain.TrackBarPlayingChange(Sender: TObject);
procedure TfrmMain.TrackBarPlayingChange(Sender: TObject);
Begin
If (MPlayerControl1.Duration <> -1) And Not UpdatingPosition Then
If TrackBarPlaying.Position <> FLastPosition Then
@ -194,20 +318,18 @@ Begin
End;
End;
Procedure TfrmMain.TrackBarPlayingMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure TfrmMain.TrackBarPlayingMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Begin
MPlayerControl1.Paused := True;
End;
Procedure TfrmMain.TrackBarPlayingMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure TfrmMain.TrackBarPlayingMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Begin
MPlayerControl1.Paused := False;
Self.ActiveControl := memResults;
End;
Procedure TfrmMain.TrackBarVolumeChange(Sender: TObject);
procedure TfrmMain.TrackBarVolumeChange(Sender: TObject);
Begin
If (TrackBarVolume.Position <> TrackBarVolume.Tag) And Not UpdatingPosition Then
Begin
@ -217,12 +339,12 @@ Begin
End;
End;
Function TfrmMain.GetUpdatingPosition: Boolean;
function TfrmMain.GetUpdatingPosition: Boolean;
Begin
Result := FUpdatingPosition <> 0;
End;
Procedure TfrmMain.SetUpdatingPosition(AValue: Boolean);
procedure TfrmMain.SetUpdatingPosition(AValue: Boolean);
Begin
If AValue Then
Inc(FUpdatingPosition)
@ -230,35 +352,101 @@ Begin
Dec(FUpdatingPosition);
End;
Procedure TfrmMain.OnPlay(Sender: TObject);
procedure TfrmMain.PopulateCommands(ARunning: Boolean);
Begin
memResults.Lines.Add('OnPlay message received');
StatusBar1.SimpleText := 'Playing ' + MPlayerControl1.Filename;
btnStop.Enabled := MPlayerControl1.Running;
btnPause.Enabled := MPlayerControl1.Running;
cboCommand.Items.Clear;
If ARunning Then
Begin
lblCommand.Caption := 'Input Commands';
cboCommand.Items.Add('get_audio_bitrate');
cboCommand.Items.Add('get_audio_codec');
cboCommand.Items.Add('get_audio_samples');
cboCommand.Items.Add('get_file_name');
cboCommand.Items.Add('get_meta_comment');
cboCommand.Items.Add('get_time_length');
cboCommand.Items.Add('get_time_pos');
cboCommand.Items.Add('get_video_bitrate');
cboCommand.Items.Add('get_video_codec');
cboCommand.Items.Add('get_video_resolution');
cboCommand.Items.Add('mute');
cboCommand.Items.Add('stop');
cboCommand.Items.Add('osd [level]');
cboCommand.Items.Add('osd_show_progression');
cboCommand.Items.Add('osd_show_text <string> [duration] [level]');
cboCommand.Items.Add('exit');
cboCommand.Items.Add('frame_step');
cboCommand.Items.Add('seek <seconds_From_Start> 2');
cboCommand.Items.Add('seek <percent> 1');
cboCommand.Items.Add('screenshot 0');
cboCommand.Items.Add('speed_mult <value>');
cboCommand.Items.Add('get_property <property>');
cboCommand.Items.Add('set_property <property> <value>');
End
Else
Begin
lblCommand.Caption := 'mplayer Parameters';
cboCommand.Items.Add('-help');
cboCommand.Items.Add('-vo help');
cboCommand.Items.Add('-input cmdlist');
End;
cboCommand.ItemIndex := 0;
End;
Procedure TfrmMain.OnStop(Sender: TObject);
procedure TfrmMain.RefreshUI;
var
bRunning: Boolean;
begin
bRunning := MPlayerControl1.Running;
If Not bRunning Then
begin
UpdatingPosition := True;
Try
TrackBarPlaying.Position := 0;
TrackBarPlaying.SelStart := 0;
TrackBarPlaying.SelEnd := 0;
TrackBarVolume.Position := 0;
TrackBarVolume.SelStart := 0;
TrackBarVolume.SelEnd := 0;
Finally
UpdatingPosition := False;
End;
StatusBar1.SimpleText := '';
lblPos.Caption := '';
end;
btnStop.Enabled := bRunning;
btnPause.Enabled := bRunning;
btnFWD.Enabled := bRunning;
btnFrameGrab.Enabled := bRunning;
btnNudgeBack.Enabled := bRunning;
btnNudgeForward.Enabled := bRunning;
lblStartParams.Enabled := Not bRunning;
cboStartParams.Enabled := Not bRunning;
PopulateCommands(bRunning);
end;
procedure TfrmMain.OnPlay(Sender: TObject);
Begin
memResults.Lines.Add('OnPlay message received');
Caption := Application.Name + ': ' + MPlayerControl1.Filename;
RefreshUI;
End;
procedure TfrmMain.OnStop(Sender: TObject);
Begin
If csDestroying In ComponentState Then
exit;
memResults.Lines.Add('OnStop message received');
StatusBar1.SimpleText := '';
Caption := Application.Name;
UpdatingPosition := True;
Try
TrackBarPlaying.Position := 0;
TrackBarPlaying.SelStart := 0;
Finally
UpdatingPosition := False;
End;
btnStop.Enabled := MPlayerControl1.Running;
btnPause.Enabled := MPlayerControl1.Running;
lblPos.Caption := '';
RefreshUI;
End;
End.

26
components/mplayer/examples/FullFeatured/mplayerTestHarness.lpi
View File

@ -45,6 +45,7 @@
<ComponentName Value="frmMain"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="FormMain"/>
</Unit1>
</Units>
</ProjectOptions>
@ -55,12 +56,27 @@
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<IOChecks Value="True"/>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
<VerifyObjMethodCallValidity Value="True"/>
</CodeGeneration>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
<Debugging>
<UseHeaptrc Value="True"/>
</Debugging>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

22
components/mplayer/mplayercontrollaz.lpk
View File

@ -1,20 +1,23 @@
<?xml version="1.0"?>
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<Package Version="3">
<Package Version="4">
<Name Value="MPlayerControlLaz"/>
<AddToProjectUsesSection Value="True"/>
<Author Value="Mattias Gaertner"/>
<CompilerOptions>
<Version Value="8"/>
<Version Value="11"/>
<SearchPaths>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
</CompilerOptions>
<Description Value="LCL control for embedding mplayer"/>
<License Value="modified LGPL2"/>
<Version Minor="1" Release="1"/>
<Version Minor="1" Release="2"/>
<Files Count="3">
<Item1>
<Filename Value="mplayerctrl.pas"/>
@ -41,11 +44,14 @@
</Item2>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)/"/>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
</PublishOptions>
<CustomOptions Items="ExternHelp" Version="2">
<_ExternHelp Items="Count"/>
</CustomOptions>
</Package>
</CONFIG>

521
components/mplayer/mplayerctrl.pas
View File

@ -41,30 +41,46 @@ Changes:
Replaced StrToCmdParam with AnsiQuotedStr in Play
- StrToCmdParam didn't work under Windows - wrapped filename in ', Windows needed "
Persisted FCanvas outside of IDE to prevent painting issues when no file playing
by Mike Thompson
/ Mike Thompson
2014-06-24 Added FindMPlayerPath (Refactored code from Play)
2014-06-28 Extended FindMPlayer to also look for mplayer in a subfolder of the exe
Fixed painting issues when playing audio files (introduces a flicker on
resize when playing video :-( )...
Fixed repeated requests for volume in files that don't support volme
Changed TProcessUTF8 population code in .Play from .CommandLine to
use .Executable & .Parameters
- incidently removed the need to use AnsiQuotedStr around Filename under Windows
Added Rate (Fast Forward only, mplayer doesn't support rewind)
Only request position updates every ON_PLAYING_INTERVAL
Set Volume on Play
Added GrabImage and OnGrabImage (delay before mplayer grabs image)
- doesn't work well with some renderers (-glnosw for instance,
also inconsistently on -vo X11)
- Capturing failed attempts in code will be hard, for now I'll
just ensure this is documented on the wiki (recommend -vo direct3d under win)
/ Mike Thompson
2014-07-01 Discovered -identify to load stats (including Start Time)
Moved set volume on play to the parameters
Refactored TimerEvent to ensure OnPlay & OnPlaying are broadcast in correct sequence
Added VideoInfo and AudioInfo (load values from -identify)
Fixed Position for videos with embedded Start_Time
Deprecated PlayerProcess (no need for it to be exposed anymore)
Realised no need for StepForward/StepBack - can be implemented externally via Position
Exposed OnMouseWheel and implemented wheelmouse scrolling through video in FullFeatured
demo
/ Mike Thompson
TODO
2014-06-21
EXTENSIVE TESTING UNDER LINUX
- Tested under Linus Mint 16 (MATE) with mplayer installed (not mplayer2)
Consider descending control from TGraphicControl (instead of creating FCanvas)
Add Rate(dRate)
Add StepForward(increment), Stepback(increment)
Add FrameGrab (and OnFrameGrab)
- Requires adding -vf screenshot to initial params
- Find out how to set grab path
- initial tests good, but framegrab saved to exe folder, needs to be to
user defined folder
Hide PlayerProcess (OnFeedback/OnError events + Running property
means there is no reason for this to be exposed... (speak to mattias/six1 first)
Find out if AnsiQuotedStr breaks unicode filenames
Find out if AnsiQuotedStr works under Linux (files with spaces or " in filename)
- Confirmed AnsiQuotedStr worked under Linux Mint 16 (MATE)
Set Volume on Play
Find out what happens if Volume <0 or >100
Fix repeated requests for Pause in TimerEvent (Use DoCommand)
Stop requesting Position every TimerEvent, instead only run every 500mS
What to do with ANS_ERROR=PROPERTY_UNAVAILABLE? (ie, volume when playing text file)
Change existing commands (ie "volume") to their set_property equivalent
NOTES
2014-06-29 TProcessUTF8 is a thin wrapper over TProcess. TProcess on Windows
is not unicode aware, so there is currently an issue playing unicode
filenames under windows.
No easy apparent solution other than upgrading TProcess (win\process.inc).
}
unit MPlayerCtrl;
@ -88,26 +104,50 @@ uses
;
type
TVideoInfo = record
Codec: string;
Format: string;
Width, Height: Integer;
FPS: Single;
Bitrate: Integer;
end;
TAudioInfo = record
Codec: string;
Format: string;
Bitrate: Single;
Channels: Integer;
SampleRate: Integer; // Hz
end;
{ TCustomMPlayerControl }
TOnFeedback = procedure(ASender: TObject; AStrings: TStringList) of object;
TOnError = procedure(ASender: TObject; AStrings: TStringList) of object;
TOnPlaying = procedure(ASender: TObject; APosition: single) of object;
TOnGrabImage = Procedure(ASender: TObject; AFilename: String) of object;
TCustomMPlayerControl = class(TWinControl)
private
FFilename: string;
FImagePath: string;
FLastImageFilename: string;
FOnGrabImage: TOnGrabImage;
FRate: single;
FStartParam:string;
FLoop: integer;
FMPlayerPath: string;
FPaused: boolean;
fPlayerProcess: TProcessUTF8;
fTimer: TTimer;
FPlayerProcess: TProcessUTF8;
FTimer: TTimer;
FVolume: integer;
FCanvas: TCanvas;
FPosition: Single;
FLastPosition: string;
FRequestingPosition: boolean;
FLastTimer: TDateTime;
FRequestVolume: boolean;
FStartTime: single;
FDuration: single;
FOnError: TOnError;
FOnFeedback: TOnFeedback;
@ -115,12 +155,17 @@ type
FOnPlaying: TOnPlaying;
FOnStop: TNotifyEvent;
FOutList: TStringList;
FVideoInfo: TVideoInfo;
FAudioInfo: TAudioInfo;
function GetPosition: single;
function GetRate: single;
procedure SetImagePath(AValue: string);
procedure SetPosition(AValue: single);
procedure SetFilename(const AValue: string);
procedure SetLoop(const AValue: integer);
procedure SetMPlayerPath(const AValue: string);
procedure SetPaused(const AValue: boolean);
procedure SetRate(AValue: single);
procedure SetVolume(const AValue: integer);
procedure SetStartParam(const AValue: string);
procedure TimerEvent(Sender: TObject);
@ -128,11 +173,7 @@ type
procedure WMPaint(var Message: TLMPaint); message LM_PAINT;
procedure WMSize(var Message: TLMSize); message LM_SIZE;
// Allows this control to inject commands without the results
// being exposed to end users of this control (other than via
// public interface)
// DoCommand is actually written for get_property XXX calls
function DoCommand(ACommand, AResultIdentifier: string): string;
procedure InitialiseInfo;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
@ -144,22 +185,34 @@ type
procedure Invalidate; override;
procedure EraseBackground(DC: HDC); override;
public
function FindMPlayerPath : Boolean;
procedure GrabImage;
property LastImageFilename: String read FLastImageFilename;
property Filename: string read FFilename write SetFilename;
property StartParam: string read FStartParam write SetStartParam;
property MPlayerPath: string read FMPlayerPath write SetMPlayerPath;
property PlayerProcess: TProcessUTF8 read fPlayerProcess;
property PlayerProcess: TProcessUTF8 read fPlayerProcess; deprecated;
property Paused: boolean read FPaused write SetPaused;
property Loop: integer read FLoop write SetLoop; // -1 no, 0 forever, 1 once, 2 twice, ...
property Volume: integer read FVolume write SetVolume;
property ImagePath: string read FImagePath write SetImagePath;
property Rate: single read GetRate write SetRate; // mplayer only supports 0.1 to 100
property Duration: single read FDuration; // seconds
property Position: single read GetPosition write SetPosition; // seconds
property VideoInfo: TVideoInfo read FVideoInfo; // this isn't fully populated until OnPlay recieved
property AudioInfo: TAudioInfo read FAudioInfo; // this isn't fully populated until OnPlay received
property OnFeedback: TOnFeedback read FOnFeedback write FOnFeedback;
property OnError: TOnError read FOnError write FOnError;
property OnPlaying: TOnPlaying read FOnPlaying write FOnPlaying;
property OnPlay: TNotifyEvent read FOnPlay write FOnPlay;
property OnStop: TNotifyEvent read FOnStop write FOnStop;
Property OnGrabImage: TOnGrabImage read FOnGrabImage write FOnGrabImage;
end;
TMPlayerControl = class(TCustomMPlayerControl)
@ -176,13 +229,15 @@ type
property OnClick;
property OnMouseUp;
property OnMouseDown;
property OnMouseWheel;
property Visible;
property Volume; // 0 to 100
property OnFeedback; // Provides standard console output from mplayer
property OnError; // Provides stderr console output from mplayer
property OnPlaying; // When not paused, an event every 250ms to 500ms with Position
property OnPlay; // Sent when mplayer initialised with video file
property OnStop; // Sent sometime (approx 250ms) after mplayer finishes
property OnPlay; // Sent after mplayer initialises the current video file
property OnStop; // Sent sometime (up to approx 250ms) after mplayer finishes current video
property OnGrabImage; // Fired when mplayer reports the filename of the image grab
end;
{ TWSMPlayerControl }
@ -196,10 +251,16 @@ type
end;
{$endif}
Const
ON_PLAYING_INTERVAL = 500 / (24*60*60*1000);
procedure Register;
implementation
Uses
Forms;
procedure Register;
begin
RegisterComponents('Multimedia',[TMPlayerControl]);
@ -219,90 +280,115 @@ end;
procedure TCustomMPlayerControl.TimerEvent(Sender: TObject);
var
ErrList: TStringList;
dPosition: single;
i: integer;
sTemp: string;
bFoundPosition: boolean;
iPosEquals: SizeInt;
iPosEquals, iPosAfterUS: SizeInt;
sValue: string;
sProperty: string;
iError: Integer;
bPostOnPlay, bPostOnStop, bPostOnPlaying: boolean;
begin
if Running then
bPostOnPlay:=False;
bPostOnStop:=False;
bPostOnPlaying:=False;
if FPlayerProcess<>nil then
begin
// Inject a request for current position
bFoundPosition := False;
if Assigned(FOnPlaying) and not FPaused then
SendMPlayerCommand('get_time_pos');
If Running And ((Now-FLastTimer)>ON_PLAYING_INTERVAL) Then
begin
// Inject a request for current position
if Assigned(FOnPlaying) and not FPaused then
begin
SendMPlayerCommand('get_time_pos');
FRequestingPosition := True;
end;
// Inject a request for Volume level
if FRequestVolume then
SendMPlayerCommand('get_property volume');
// Inject a request for Volume level
if FRequestVolume then
SendMPlayerCommand('get_property volume');
FLastTimer := Now;
bPostOnPlaying := True;
end;
if FPlayerProcess.Output.NumBytesAvailable > 0 then
begin
FOutList.LoadFromStream(FPlayerProcess.Output);
// Look for responses to injected commands...
// or for standard commands
// or for standard issued information
for i := FOutList.Count - 1 downto 0 do
begin
sTemp := Lowercase(FOutList[i]);
iPosEquals := Pos('=', sTemp);
// Property Requested are provided in the format
// ANS_PropertyName=Value
if Pos('ans_', sTemp) = 1 then
// Identify requests look like ID_Property=Value
// Property requests look like ANS_Property=Value
if (iPosEquals>1) and ((Pos('ans_', sTemp)=1) or (Pos('id_', sTemp)=1)) then
begin
iPosEquals := Pos('=', sTemp);
iPosAfterUS := Pos('_', sTemp)+1;
sValue := Copy(sTemp, iPosEquals + 1, Length(sTemp) - iPosEquals);
sProperty := Copy(sTemp, iPosAfterUS, iPosEquals - iPosAfterUS);
if iPosEquals > 1 then
if Assigned(FOnPlaying) and (FRequestingPosition) and (sProperty = 'time_position') then
begin
sValue := Copy(sTemp, iPosEquals + 1, Length(sTemp) - iPosEquals);
sProperty := Copy(sTemp, 5, iPosEquals - 5);
// Are we paused by any chance?
if sValue = FLastPosition then
SendMPlayerCommand('get_property pause');
if (FDuration = -1) and (sProperty = 'length') then
begin
FDuration := StrToFloatDef(sValue, -1);
FLastPosition := sValue;
// clear this response from the queue
FOutList.Delete(i);
end
else if Assigned(FOnPlaying) and (not bFoundPosition) and
(sProperty = 'time_position') then
begin
// Are we paused by any chance?
if sValue = FLastPosition then
SendMPlayerCommand('get_property pause');
FPosition := StrToFloatDef(sValue, 0) - FStartTime;
FLastPosition := sValue;
// Don't remove any further ANS_Time_Positions, they're not ours...
FRequestingPosition := False;
dPosition := StrToFloatDef(sValue, 0);
// clear this response from the queue
FOutList.Delete(i);
end
else
case sProperty Of
'volume' :
begin
FVolume := Trunc(0.5 + StrToFloatDef(sValue, 100));
FRequestVolume := False;
// Don't remove any further ANS_Time_Positions, they're not ours...
bFoundPosition := True;
// Send the message
FOnPlaying(Self, dPosition);
// clear this response from the queue
FOutList.Delete(i);
end
else if {FRequestVolume And }(sProperty = 'volume') then
begin
FVolume := Trunc(0.5 + StrToFloatDef(sValue, 100));
FRequestVolume := False;
// clear this response from the queue
FOutList.Delete(i);
end
else if (sProperty = 'pause') then
FPaused := (sValue = 'yes');
// clear this response from the queue
FOutList.Delete(i);
end;
'length' : FDuration := StrToFloatDef(sValue, -1);
'pause' : FPaused := (sValue = 'yes');
'video_codec' : FVideoInfo.Codec:=sValue;
'video_format' : FVideoInfo.Format:=sValue;
'video_bitrate': FVideoInfo.Bitrate:=StrToIntDef(sValue, 0);
'video_width' : FVideoInfo.Width:=StrToIntDef(sValue, 0);
'video_height' : FVideoInfo.Height:=StrToIntDef(sValue, 0);
'video_fps' : FVideoInfo.FPS:=StrToFloatDef(sValue, 0);
'start_time' : FStartTime:=StrToFloatDef(sValue, 0);
//'seekable' : FSeekable:=(sValue='1');
'audio_codec' : FAudioInfo.Codec:=sValue;
'audio_format' : FAudioInfo.Format:=sValue;
'audio_bitrate': FAudioInfo.Bitrate:=StrToIntDef(sValue, 0);
'audio_rate' : FAudioInfo.SampleRate:=StrToIntDef(sValue, 0);
'audio_nch' : FAudioInfo.Channels:=StrToIntDef(sValue, 0);
'exit' : bPostOnStop:=True;
end;
end
end // ID_ or ANS_
else if Assigned(FOnPlay) and (sTemp = 'starting playback...') then
FOnPlay(Self);
bPostOnPlay:=True
else if (Pos('*** screenshot', sTemp)=1) Then
begin
// result looks like *** screenshot 'shot0002.png' ***
FLastImageFilename:=IncludeTrailingBackslash(GetCurrentDirUTF8) + Copy(sTemp, 17, Pos('.', sTemp)-17+4);
if assigned(FOnGrabImage) And FileExistsUTF8(FLastImageFilename) then
FOnGrabImage(Self, FLastImageFilename);
// clear this response from the queue
FOutList.Delete(i);
end
else if sTemp='sending vfctrl_screenshot!' then
FOutList.Delete(i);
end;
if Assigned(FOnFeedback) and (FOutlist.Count > 0) then
@ -315,14 +401,36 @@ begin
try
ErrList.LoadFromStream(FPlayerProcess.Stderr);
// Catch error retrieving volume
If FRequestVolume Then
begin
iError := ErrList.IndexOf('Failed to get value of property ''volume''.');
If iError<>-1 Then
begin
Errlist.Delete(iError);
// Prevent further requests for volume
FVolume := 0;
FRequestVolume := False;
end;
end;
if Assigned(FOnError) then
FOnError(Self, ErrList);
finally
ErrList.Free;
end;
end;
end
else
end;
// don't post the OnPlay until all the data above is processed
if Assigned(FOnPlay) and bPostOnPlay then
FOnPlay(Self);
If Assigned(FOnPlaying) And bPostOnPlaying then
FOnPlaying(Self, FPosition);
If (not Running) Or bPostOnStop Then
Stop;
end;
@ -354,7 +462,6 @@ begin
DoOnResize;
end;
procedure TCustomMPlayerControl.SetStartParam(const AValue: string);
begin
if FStartParam=AValue then exit;
@ -362,11 +469,20 @@ begin
end;
procedure TCustomMPlayerControl.SetFilename(const AValue: string);
// Copied from win\process.inc
// mplayer uses identical params under linux, so this is safe
Function MaybeQuoteIfNotQuoted(Const S : String) : String;
begin
If (Pos(' ',S)<>0) and (pos('"',S)=0) then
Result:='"'+S+'"'
else
Result:=S;
end;
begin
if FFilename=AValue then exit;
FFilename:=AValue;
if Running then
SendMPlayerCommand('loadfile '+AnsiQuotedStr(Filename, '"'));
SendMPlayerCommand('loadfile '+MaybeQuoteIfNotQuoted(Filename));
end;
procedure TCustomMPlayerControl.SetLoop(const AValue: integer);
@ -392,6 +508,16 @@ begin
end;
end;
procedure TCustomMPlayerControl.SetRate(AValue: single);
begin
if FRate=AValue then Exit;
if (FRate<0.1) or (FRate>100) then Exit;
if Running then begin
FRate:=AValue;
SendMPlayerCommand(Format('set_property speed %.3f', [FRate]));
end;
end;
procedure TCustomMPlayerControl.SetVolume(const AValue: integer);
begin
if FVolume=AValue then exit;
@ -448,10 +574,45 @@ begin
Result:=(fPlayerProcess<>nil) and fPlayerProcess.Running;
end;
function TCustomMPlayerControl.FindMPlayerPath: Boolean;
var
ExePath: string;
MPlayerExe: String;
begin
result := FileExistsUTF8(FMPlayerPath);
If not result then
begin
MPlayerExe:='mplayer'+GetExeExt;
if FMPlayerPath='' then
FMPlayerPath:=MPlayerExe;
ExePath:=FMPlayerPath;
// Is mplayer installed in the environment path?
if not FilenameIsAbsolute(ExePath) then
ExePath:=FindDefaultExecutablePath(ExePath);
// is mplayer in a folder under the application folder?
if Not FileExistsUTF8(ExePath) then
ExePath := IncludeTrailingBackSlash(ExtractFileDir(Application.ExeName))+
IncludeTrailingBackslash('mplayer') + MPlayerExe;
// did we find it?
if FileExistsUTF8(ExePath) then
begin
FMPlayerPath:=ExePath;
result := true;
end;
end;
end;
procedure TCustomMPlayerControl.GrabImage;
begin
if Running then
SendMPlayerCommand('screenshot 0')
end;
procedure TCustomMPlayerControl.Play;
var
ExePath: String;
CurWindowID: PtrUInt;
slStartParams : TStringList;
begin
if (csDesigning in ComponentState) then exit;
@ -460,7 +621,11 @@ begin
exit;
end;
if Playing then exit;
if Playing then begin
if FRate<>1 Then
Rate := 1;
exit;
end;
{$IFDEF Linux}
if (not HandleAllocated) then exit;
@ -471,12 +636,7 @@ begin
FreeAndNil(fPlayerProcess);
// raise Exception.Create('TCustomMPlayerControl.Play fPlayerProcess still exists');
if MPlayerPath='' then
MPlayerPath:='mplayer'+GetExeExt;
ExePath:=MPlayerPath;
if not FilenameIsAbsolute(ExePath) then
ExePath:=FindDefaultExecutablePath(ExePath);
if not FileExistsUTF8(ExePath) then
if not FindMPlayerPath then
raise Exception.Create(MPlayerPath+' not found');
{$IFDEF Linux}
@ -488,38 +648,54 @@ begin
FPlayerProcess := TProcessUTF8.Create(Self);
FPlayerProcess.Options := FPlayerProcess.Options + [poUsePipes, poNoConsole];
// -slave : allow us to control mplayer
// -quiet : supress most messages
// -really-quiet : DONT USE: causes the video player to not connect to -wid. Odd...
// -msglevel global=6 : required for EOF signal when playing stops
// -wid : sets Window ID (display video in our control)
// -noconfig all : stop mplayer from reading commands from a text file
// -vf screenshot : Allow frame grab
// -zoom -fs : Unsure: Only perceptible difference is background drawn black not green
// -vo direct3d : uses Direct3D renderer (recommended under windows)
// -vo gl_nosw : uses OpenGL no software renderer
FPlayerProcess.CommandLine :=
ExePath + ' -slave -quiet -wid ' + IntToStr(CurWindowID) +
' ' + StartParam + ' ' + AnsiQuotedStr(Filename, '"');
FPlayerProcess.Executable:=FMPlayerPath;
FPlayerProcess.Parameters.Add('-slave'); // allow us to control mplayer
FPlayerProcess.Parameters.Add('-quiet'); // supress most messages
FPlayerProcess.Parameters.Add('-identify'); // Request stats on playing file
FPlayerProcess.Parameters.Add('-volume'); // Set initial volume
FPlayerProcess.Parameters.Add(IntToStr(FVolume));
FPlayerProcess.Parameters.Add('-vf');
FPlayerProcess.Parameters.Add('screenshot'); // (with -vf) Allow frame grab
DebugLn(['TCustomMPlayerControl.Play ', FPlayerProcess.CommandLine]);
FPlayerProcess.Parameters.Add('-wid'); // sets Window ID (display video in our control)
FPlayerProcess.Parameters.Add(IntToStr(CurWindowID));
// Add the user defined start params
if (Trim(FStartParam)<>'') then
begin
slStartParams := TStringList.Create;
try
CommandToList(StartParam, slStartParams);
FPlayerProcess.Parameters.AddStrings(slStartParams);
finally
slStartParams.Free;
end;
end;
FPlayerProcess.Parameters.Add(FFilename);
FPlayerProcess.Parameters.Delimiter:=' ';
DebugLn(['TCustomMPlayerControl.Play ', FPlayerProcess.Parameters.DelimitedText]);
// Normally I'd be careful to only use FOutList in the
// Timer event, but here I'm confident the timer isn't running...
if assigned(FOnFeedback) then
begin
FOutlist.Clear;
FOutlist.Add(FPlayerProcess.CommandLine);
FOutlist.Add(FPlayerProcess.Executable + ' ' + FPlayerProcess.Parameters.DelimitedText);
FOutlist.Add('');
FonFeedback(Self, FOutlist);
end;
FPlayerProcess.Execute;
// Populate defaults
InitialiseInfo;
// Inject a request for Duration
FDuration := -1;
SendMPlayerCommand('get_time_length');
FRequestVolume := True;
FPlayerProcess.Execute;
// Start the timer that handles feedback from mplayer
FTimer.Enabled := True;
@ -530,6 +706,7 @@ begin
if FPlayerProcess = nil then
exit;
DebugLn(Format('ExitStatus=%d', [fPlayerProcess.ExitStatus]));
FPaused := False;
FDuration := -1;
FTimer.Enabled := False;
@ -558,7 +735,7 @@ end;
procedure TCustomMPlayerControl.EraseBackground(DC: HDC);
begin
if (not Running) and (FCanvas <> nil) then
if (FCanvas <> nil) then
with FCanvas do
begin
if DC <> 0 then
@ -568,77 +745,70 @@ begin
if DC <> 0 then
Handle := 0;
end;
// else
// everything is painted, so erasing the background is not needed
end;
function TCustomMPlayerControl.DoCommand(ACommand, AResultIdentifier: string): string;
var
i: integer;
slTemp: TStringList;
procedure TCustomMPlayerControl.InitialiseInfo;
begin
if not Running then
Exit;
FLastPosition := '';
FPosition := 0;
FRequestVolume := False;
FStartTime := 0;
FRate := 1;
FDuration := -1;
// Pause the timer
FTimer.Enabled := False;
// Clear existing mplayer console output
TimerEvent(Self);
SendMPlayerCommand(ACommand);
// Now *immediately* read the output results.
// this may have problems if mplayer takes
// a while to execute this command, but outside intilisation
// this doesn't appear to be the case...
if FPlayerProcess.Output.NumBytesAvailable > 0 then
with FVideoInfo Do
begin
slTemp := TStringList.Create;
try
// Read the result
slTemp.LoadFromStream(FPlayerProcess.Output);
// Find our reply
i := 0;
while (i < slTemp.Count) and (Pos(AResultIdentifier, slTemp[i]) <> 1) do
Inc(i);
if (i <> slTemp.Count) then
begin
Result := ExtractAfter(slTemp[i], AResultIdentifier);
// Hide our feedback from the outer app
slTemp.Delete(i);
end;
// Ensure any feedback we accidently intercepted get's processed
if Assigned(FOnFeedback) and (slTemp.Count > 0) then
FOnFeedback(Self, slTemp);
finally
slTemp.Free;
end;
Format := '';
Width := 0;
Height := 0;
FPS := 0;
Bitrate := 0;
end;
// Resume the timer
FTimer.Enabled := True;
With FAudioInfo Do
begin
Format := '';
Bitrate := 0;
end;
end;
function TCustomMPlayerControl.GetPosition: single;
begin
Result := 0;
DebugLn(Format('Get Position %.3f', [FPosition]));
Result := FPosition;
end;
if not Running then
exit;
function TCustomMPlayerControl.GetRate: single;
begin
Result := FRate;
Result := StrToFloatDef(DoCommand('get_time_pos', 'ans_time_position='), 0);
//If not Running Then
// Result := FRate
//Else
// Result := StrToFloatDef(DoCommand('get_property speed', 'ans_speed='), 1)
end;
procedure TCustomMPlayerControl.SetImagePath(AValue: string);
begin
if DirectoryExistsUTF8(AValue) then
begin
FImagePath:=AValue;
SetCurrentDirUTF8(AValue);
end;
end;
procedure TCustomMPlayerControl.SetPosition(AValue: single);
begin
if Running then
SendMPlayerCommand(Format('pausing_keep seek %.3f 2', [AValue]));
begin
if AValue>0 Then
FPosition := AValue
Else
FPosition := 0;
DebugLn(Format('Set Position to %.3f', [FPosition]));
SendMPlayerCommand(Format('pausing_keep seek %.3f 2', [FPosition]));
end;
end;
{$ifdef Linux}
@ -693,16 +863,13 @@ class procedure TWSMPlayerControl.DestroyHandle(const AWinControl: TWinControl
begin
inherited DestroyHandle(AWinControl);
end;
initialization
RegisterWSComponent(TCustomMPlayerControl,TWSMPlayerControl);
{$I mplayerctrl.lrs}
{$else ifwindows}
initialization
{$I mplayerctrl.lrs}
{$endif}
initialization
{$ifdef Linux}
RegisterWSComponent(TCustomMPlayerControl,TWSMPlayerControl);
{$endif}
{$I mplayerctrl.lrs}
end.