lazarus-ccr/components/mplayer/examples/FullFeatured/FormMain.pas

Unit FormMain;

{$mode objfpc}{$H+}

Interface

Uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Buttons, ExtCtrls, ComCtrls,
  StdCtrls, MPlayerCtrl;

Type

  { TfrmMain }

  TfrmMain = Class(TForm)
    btnRunCommand: TButton;
    cboCommand: TComboBox;
    ilTools: TImageList;
    lblPos: TLabel;
    memResults: TMemo;
    MPlayerControl1: TMPlayerControl;
    OpenDialog1: TOpenDialog;
    pnlTrackbar: TPanel;
    pnlPos: TPanel;
    pnlCommands: TPanel;
    pnlFeedback: 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 btnLoadClick(Sender: TObject);
    Procedure btnPauseClick(Sender: TObject);
    Procedure btnPlayClick(Sender: TObject);
    Procedure btnRunCommandClick(Sender: TObject);
    Procedure btnStopClick(Sender: TObject);
    Procedure FormCreate(Sender: TObject);
    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);
  Private
    FUpdatingPosition: Integer;
    FLastPosition: Integer;

    Property UpdatingPosition: Boolean read GetUpdatingPosition write SetUpdatingPosition;
  End;

Var
  frmMain: TfrmMain;

Implementation

{$R *.lfm}

{ TfrmMain }

Procedure TfrmMain.FormCreate(Sender: TObject);
Begin
  FUpdatingPosition := 0;
  FLastPosition := -1;
  TrackBarPlaying.Max := 50;

  MPlayerControl1.Volume := 50;

  {$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';
  {$ENDIF}
End;

Procedure TfrmMain.btnLoadClick(Sender: TObject);
Begin
  If OpenDialog1.Execute Then
  Begin
    MPlayerControl1.Stop;
    memResults.Lines.Clear;
    MPlayerControl1.Filename := OpenDialog1.Filename;
    MPlayerControl1.Play;
  End;
End;

Procedure TfrmMain.btnPauseClick(Sender: TObject);
Begin
  MPlayerControl1.Paused := Not MPlayerControl1.Paused;
  btnPause.Down := MPlayerControl1.Paused;
End;

Procedure TfrmMain.btnPlayClick(Sender: TObject);
Begin
  MPlayerControl1.Play;
End;

Procedure TfrmMain.btnRunCommandClick(Sender: TObject);
Begin
  memResults.Lines.Add(cboCommand.Text);
  MPlayerControl1.SendMPlayerCommand(cboCommand.Text);
End;

Procedure TfrmMain.btnStopClick(Sender: TObject);
Begin
  MPlayerControl1.Stop;
End;

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);
Var
  i: Integer;
Begin
  For i := 0 To AStrings.Count - 1 Do
    memResults.Lines.Add(' Err: ' + AStrings[i]);
End;

Procedure TfrmMain.OnPlaying(ASender: TObject; APosition: Single);
Begin
  If (MPlayerControl1.Duration <> -1) Then
  Begin
    UpdatingPosition := True;
    Try
      btnPause.Down := MPlayerControl1.Paused;

      TrackBarPlaying.SelEnd := Trunc(TrackBarPlaying.Max * APosition / MPlayerControl1.Duration);
      If ActiveControl <> TrackBarPlaying Then
        TrackBarPlaying.Position := TrackBarPlaying.SelEnd;

      lblPos.Caption := FormatDateTime('nnn:ss', APosition / (24 * 60 * 60)) +
        ' / ' + 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;
End;

Procedure TfrmMain.TrackBarPlayingChange(Sender: TObject);
Begin
  If (MPlayerControl1.Duration <> -1) And Not UpdatingPosition Then
    If TrackBarPlaying.Position <> FLastPosition Then
    Begin
      MPlayerControl1.Position := MPlayerControl1.Duration * TrackBarPlaying.Position /
        TrackBarPlaying.Max;
      FLastPosition := TrackBarPlaying.Position;
    End;
End;

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);
Begin
  MPlayerControl1.Paused := False;
  Self.ActiveControl := memResults;
End;

Procedure TfrmMain.TrackBarVolumeChange(Sender: TObject);
Begin
  If (TrackBarVolume.Position <> TrackBarVolume.Tag) And Not UpdatingPosition Then
  Begin
    MPlayerControl1.Volume := Trunc(100 * TrackBarVolume.Position / TrackBarVolume.Max);

    TrackBarVolume.Tag := TrackBarVolume.Position;
  End;
End;

Function TfrmMain.GetUpdatingPosition: Boolean;
Begin
  Result := FUpdatingPosition <> 0;
End;

Procedure TfrmMain.SetUpdatingPosition(AValue: Boolean);
Begin
  If AValue Then
    Inc(FUpdatingPosition)
  Else
    Dec(FUpdatingPosition);
End;

Procedure TfrmMain.OnPlay(Sender: TObject);
Begin
  memResults.Lines.Add('OnPlay message received');
  StatusBar1.SimpleText := 'Playing ' + MPlayerControl1.Filename;

  btnStop.Enabled := MPlayerControl1.Running;
  btnPause.Enabled := MPlayerControl1.Running;
End;

Procedure TfrmMain.OnStop(Sender: TObject);
Begin
  If csDestroying In ComponentState Then
    exit;

  memResults.Lines.Add('OnStop message received');
  StatusBar1.SimpleText := '';

  UpdatingPosition := True;
  Try
    TrackBarPlaying.Position := 0;
    TrackBarPlaying.SelStart := 0;
  Finally
    UpdatingPosition := False;
  End;

  btnStop.Enabled := MPlayerControl1.Running;
  btnPause.Enabled := MPlayerControl1.Running;

  lblPos.Caption := '';
End;

End.