Source of Player Demo - Delphi FFmpeg VCL Components(Video Converter and Video Player)

unit PlayerFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls, ExtDlgs, Jpeg, FFPlay, FFmpegLogger;

type
  TfrmPlayer = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Panel1: TPanel;
    TrackBar1: TTrackBar;
    mmoLog: TMemo;
    btnOpen: TButton;
    btnPause: TButton;
    btnStop: TButton;
    btnCapture: TButton;
    btnWebSite: TButton;
    chkDisableVideo: TCheckBox;
    chkDisableAudio: TCheckBox;
    chkDisableDisplay: TCheckBox;
    chkStayOnTop: TCheckBox;
    cboScreens: TComboBox;
    cboAspectRatio: TComboBox;
    cboVideo: TComboBox;
    cboAudio: TComboBox;
    cboSubtitle: TComboBox;
    chkHook: TCheckBox;
    chkMute: TCheckBox;
    TrackBar2: TTrackBar;
    FFPlayer: TFFPlayer;
    FFLogger: TFFLogger;
    OpenDialog1: TOpenDialog;
    SavePictureDialog1: TSavePictureDialog;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure btnOpenClick(Sender: TObject);
    procedure btnPauseClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure btnCaptureClick(Sender: TObject);
    procedure btnWebSiteClick(Sender: TObject);
    procedure cboAspectRatioChange(Sender: TObject);
    procedure cboVideoChange(Sender: TObject);
    procedure cboAudioChange(Sender: TObject);
    procedure cboSubtitleChange(Sender: TObject);
    procedure chkHookClick(Sender: TObject);
    procedure chkMuteClick(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure TrackBar2Change(Sender: TObject);
    procedure FFPlayerFileOpen(Sender: TObject; const ADuration: Int64;
      const AFrameWidth, AFrameHeight: Integer; var AScreenWidth,
      AScreenHeight: Integer);
    procedure FFPlayerHook(Sender: TObject; ABitmap: TBitmap; const APTS: Int64);
    procedure FFPlayerPosition(Sender: TObject; const APTS: Int64);
    procedure FFPlayerState(Sender: TObject; const AState: TPlayState);
    procedure FFLoggerLog(Sender: TObject; const AThreadID: Cardinal;
      const ALogLevel: TLogLevel; const ALogMsg: string);
  private
    { Private declarations }
    FDuration: Int64;
    FTrackChanging: Boolean;
    FScreenControl: TWinControl;
  public
    { Public declarations }
  end;

var
  frmPlayer: TfrmPlayer;

implementation

{$R *.dfm}

uses
{$IF NOT (DEFINED(VER140) OR DEFINED(VER185) OR DEFINED(VER200) OR DEFINED(VER210))}
//  XPMan,
{$IFEND}
  ShellAPI,
  MyUtils;

const
  CLibAVPath = 'LibAV';

  SAppTitle = 'Demo of FFPlayer %s';
  SCaption = 'Demo of FFPlayer %s - Delphi FFmpeg VCL Components';
  SWebSiteC = 'http://www.CCAVC.com';
  SWebSiteE = 'http://www.DelphiFFmpeg.com';
  DEMO_INFO = '* The Demo Version FFPlayer only works in Delphi IDE'#13#10#13#10;

  // License sample (this is a fake license key)
  // The full source version doesn't need license key.
//BOMB: you should replace the seed and the key with your own ones.
  LICENSE_SEED = $D24E9E33;
  LICENSE_KEY =
    '39EA968465F26B6CDCA1E51EC8FAC6392100A838813BD0E0F5575E31AC38AEE4' +
    '34E3AF85FDC4B84FBC8BC88078E83D482D8CD226F013CF85BA90F88765D91977' +
    'A8C2E0E345B052AFC342FF244A8D7A95306623716DDBB1B512A1F44F32D6731C' +
    '49308768679B36FC8F6AEF3207ED6CC8EA5EF8F4D2F2AA0F2DC5F13654B78322';

  CDialogOptions = [ofHideReadOnly, ofFileMustExist, ofEnableSizing];
  CPictureFiles = '*.BMP;*.GIF;*.JPEG;*.JPG;*.PNG;';
  CAudioFiles = '*.MP3;*.AAC;*.WAV;*.WMA;*.CDA;*.FLAC;*.M4A;*.MID;*.MKA;' +
      '*.MP2;*.MPA;*.MPC;*.APE;*.OFR;*.OGG;*.RA;*.WV;*.TTA;*.AC3;*.DTS;';
  CVideoFiles = '*.AVI;*.AVM;*.ASF;*.WMV;*.AVS;*.FLV;*.MKV;*.MOV;*.3GP;' +
      '*.MP4;*.MPG;*.MPEG;*.DAT;*.OGM;*.VOB;*.RM;*.RMVB;*.TS;*.TP;*.IFO;*.NSV;';
  CDialogFilter =
      'Video/Audio/Picture Files|' + CVideoFiles + CAudioFiles + CPictureFiles +
      '|Video Files|' + CVideoFiles +
      '|Audio Files|' + CAudioFiles +
      '|Picture Files|' + CPictureFiles +
      '|All Files|*.*';

  SHookTimeStamp = 'FFVCL - Time Stamp: %d';

var
  SWebSite: string = SWebSiteE;

// return desktop handle
function GetDesktopHandle: HWND;
begin
  Result := FindWindow('ProgMan', nil);    {Do not Localize}
  Result := GetWindow(Result, GW_CHILD);
  Result := GetWindow(Result, GW_CHILD);
end;

// whether mouse is down
function IsMouseDown: Boolean;
begin
  if GetSystemMetrics(SM_SWAPBUTTON) <> 0 then
    Result := GetAsyncKeyState(VK_RBUTTON) and $8000 <> 0
  else
    Result := GetAsyncKeyState(VK_LBUTTON) and $8000 <> 0;
end;

// find wincontrol of form by name
function FindWinControl(AForm: TForm; const AName: string): TWinControl;
var
  I: Integer;
begin
  for I := 0 to AForm.ControlCount - 1 do
  begin
    if (AForm.Controls[I] is TWinControl) and (AForm.Controls[I].Name = AName) then
    begin
      Result := TWinControl(AForm.Controls[I]);
      Exit;
    end;
  end;
  Result := nil;
end;

// form create
procedure TfrmPlayer.FormCreate(Sender: TObject);
var
  I, T: Integer;
  Found: Boolean;
begin
  // initialize
  Application.Title := Format(SAppTitle, [FFPlayer.Version]);
  Self.Caption := Format(SCaption, [FFPlayer.Version]);

  if SysUtils.SysLocale.PriLangID = LANG_CHINESE then
    SWebSite := SWebSiteC
  else
    SWebSite := SWebSiteE;

  mmoLog.Text := SWebSite + #13#10 + DEMO_INFO;
  btnWebsite.Hint := SWebSite;
  btnWebsite.ShowHint := True;

  // generate screen list
  cboScreens.Items.Clear;
  cboScreens.Items.Add('Desktop');
  T := 0;
  while True do
  begin
    Found := False;
    for I := 0 to Self.ControlCount - 1 do
    begin
      if (Self.Controls[I] is TWinControl) and ((Self.Controls[I] as TWinControl).TabOrder = T) then
      begin
        cboScreens.Items.Add(Self.Controls[I].Name);
        Inc(T);
        Found := True;
        Break;
      end;
    end;
    if not Found then
      Break;
  end;
  cboScreens.ItemIndex := 1;

  // open dialog setting
  OpenDialog1.Options := CDialogOptions;
  OpenDialog1.Filter := CDialogFilter;

  // save dialog setting
  SavePictureDialog1.Options := [ofOverwritePrompt, ofHideReadOnly, ofExtensionDifferent, ofPathMustExist, ofEnableSizing];
  SavePictureDialog1.Filter := 'Bitmaps (*.bmp)|*.bmp|JPEG Image File |*.jpg;*.jpeg';
  SavePictureDialog1.DefaultExt := 'bmp';

  // Set License Key
  // The full source version doesn't need license key.
  FFPlayer.SetLicenseKey(LICENSE_KEY, LICENSE_SEED);
end;

procedure TfrmPlayer.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  with FFPlayer do
  begin
    // Clear the event handlers
    OnPosition := nil;
    OnState := nil;
    OnHook := nil;
  end;
  FFLogger.OnLog := nil;
end;

// open media file to play
procedure TfrmPlayer.btnOpenClick(Sender: TObject);
var
  LScreenHandle: HWND;
begin
  // Load dynamic link libraries
  if not FFPlayer.AVLibLoaded then
  begin
    // TPathFileName = type WideString;
    // FFPlayer.LoadAVLib(const APath: TPathFileName): Boolean;
    // APath: Full path indicates location of FFmpeg DLLs.
    //        It can be empty, let Windows search DLLs in current dir or environment <PATH>
    //if not FFPlayer.LoadAVLib(ExtractFilePath(Application.ExeName) + CLibAVPath) then
    // the routine ExePath() is implemented in unit MyUtils which returns WideString type
    // of ExtractFilePath(Application.ExeName)
    if not FFPlayer.LoadAVLib(ExePath + CLibAVPath) then
    begin
      mmoLog.Lines.Add(FFPlayer.LastErrMsg);
      Exit;
    end;
  end;

  // open media file
  if not OpenDialog1.Execute then
    // cancel open file
    Exit;

  // initial options
  FFPlayer.DisableAudio := chkDisableAudio.Checked;
  FFPlayer.DisableVideo := chkDisableVideo.Checked;
  FFPlayer.DisableDisplay := chkDisableDisplay.Checked;

  // wincontrol used for render video
  FScreenControl := FindWinControl(Self, cboScreens.Items.Strings[cboScreens.ItemIndex]);
  if Assigned(FScreenControl) then
    LScreenHandle := FScreenControl.Handle
  else
    // render video on desktop
    LScreenHandle := GetDesktopHandle;

  // try to open and play media file, render on the custom window specified by handle
  if not FFPlayer.Open(OpenDialog1.FileName, LScreenHandle) then
    mmoLog.Lines.Add(FFPlayer.LastErrMsg);
end;

// toggle pause/resume
procedure TfrmPlayer.btnPauseClick(Sender: TObject);
begin
  FFPlayer.TogglePause;
end;

// stop
procedure TfrmPlayer.btnStopClick(Sender: TObject);
begin
  FFPlayer.Stop(True);
end;

// capture video frame
procedure TfrmPlayer.btnCaptureClick(Sender: TObject);
var
  BMP: TBitmap;
begin
  BMP := TBitmap.Create;
  try
    BMP.Assign(FFPlayer.CurrentFrame);
    if BMP.Width > 0 then
    begin
      if SavePictureDialog1.Execute then
      begin
        if SameText(ExtractFileExt(SavePictureDialog1.FileName), '.bmp') then
          BMP.SaveToFile(SavePictureDialog1.FileName)
        else
          with TJPEGImage.Create do
          try
            Assign(BMP);
            SaveToFile(SavePictureDialog1.FileName)
          finally
            Free;
          end;
      end;
    end;
  finally
    BMP.Free;
  end;
end;

// web site
procedure TfrmPlayer.btnWebSiteClick(Sender: TObject);
begin
  ShellExecute(Application.Handle, 'Open',   {Do not Localize}
    PChar(LowerCase(SWebSite)), '',
    PChar(ExtractFilePath(Application.ExeName)), 1);
end;

// change aspect ratio
procedure TfrmPlayer.cboAspectRatioChange(Sender: TObject);
begin
{
keeping original (0)
scaling to fit screen (-1)
4:3
16:9
1.85:1
2.35:1
}
  case cboAspectRatio.ItemIndex of
    1: FFPlayer.AspectRatio := -1;
    2: FFPlayer.AspectRatio := 4 / 3;
    3: FFPlayer.AspectRatio := 16 / 9;
    4: FFPlayer.AspectRatio := 1.85;
    5: FFPlayer.AspectRatio := 2.35;
  else
       FFPlayer.AspectRatio := 0;
  end;
end;

// change video stream channel
procedure TfrmPlayer.cboVideoChange(Sender: TObject);
var
  S: string;
begin
  S := cboVideo.Text;
  if Pos('#', S) > 0 then
  begin
    S := Copy(S, Pos('#', S) + 1, MaxInt);
    FFPlayer.VideoStreamIndex := StrToInt(S);
  end;
end;

// change audio stream channel
procedure TfrmPlayer.cboAudioChange(Sender: TObject);
var
  S: string;
begin
  S := cboAudio.Text;
  if Pos('#', S) > 0 then
  begin
    S := Copy(S, Pos('#', S) + 1, MaxInt);
    FFPlayer.AudioStreamIndex := StrToInt(S);
  end;
end;

// change subtitle stream channel
procedure TfrmPlayer.cboSubtitleChange(Sender: TObject);
var
  S: string;
begin
  S := cboSubtitle.Text;
  if Pos('#', S) > 0 then
  begin
    S := Copy(S, Pos('#', S) + 1, MaxInt);
    FFPlayer.SubtitleStreamIndex := StrToInt(S);
  end;
end;

// toggle enable/disable hook
procedure TfrmPlayer.chkHookClick(Sender: TObject);
begin
  FFPlayer.Hook := chkHook.Checked;
end;

// toggle audio mute
procedure TfrmPlayer.chkMuteClick(Sender: TObject);
begin
  FFPlayer.Mute := chkMute.Checked;
end;

// do seek when change track bar
procedure TfrmPlayer.TrackBar1Change(Sender: TObject);
begin
  if not FTrackChanging and not IsMouseDown then
    FFPlayer.Seek(FDuration * TrackBar1.Position div TrackBar1.Max);
end;

// change audio volume
procedure TfrmPlayer.TrackBar2Change(Sender: TObject);
begin
  FFPlayer.AudioVolume := TrackBar2.Position;
end;

// OnFileOpen event handler
procedure TfrmPlayer.FFPlayerFileOpen(Sender: TObject; const ADuration: Int64;
  const AFrameWidth, AFrameHeight: Integer; var AScreenWidth, AScreenHeight: Integer);
var
  I: Integer;
begin
  // show media file info
  mmoLog.Lines.Add(FFPlayer.AVProbe.FileInfoText);

  // show information
  mmoLog.Lines.Add(Format('duration: %f, frame size: %dx%d',
    [ADuration / 1000000, AFrameWidth, AFrameHeight]));

  // tell player the screen size
  if Assigned(FScreenControl) then
  begin
    // win control
    AScreenWidth := FScreenControl.Width;
    AScreenHeight := FScreenControl.Height;
  end
  else
  begin
    // desktop
    AScreenWidth := Screen.DesktopWidth;
    AScreenHeight := Screen.DesktopHeight;
  end;

  // duration of media file
  FDuration := ADuration;
  Label2.Caption := Format('%f', [ADuration / 1000000]);
  Label3.Caption := '0.0';

  // setup track bar
  TrackBar1.Frequency := 5;
  TrackBar1.TickStyle := tsAuto;
  TrackBar1.Max := TrackBar1.Width;
  TrackBar1.SelStart := 0;
  TrackBar1.SelEnd := 0;
  TrackBar1.SliderVisible := ADuration > 0;

  FTrackChanging := True;
  try
    TrackBar1.Position := 0;
  finally
    FTrackChanging := False;
  end;

  // setup stream info, including video, audio and subtitle
  cboVideo.Items.BeginUpdate;
  cboAudio.Items.BeginUpdate;
  cboSubtitle.Items.BeginUpdate;
  try
    cboVideo.Items.Clear;
    cboAudio.Items.Clear;
    cboSubtitle.Items.Clear;
    for I := 0 to FFPlayer.AVProbe.StreamCount - 1 do
    begin
      if FFPlayer.AVProbe.IsVideoStream(I) then
        cboVideo.Items.Add(Format('Video#%d', [I]))
      else if FFPlayer.AVProbe.IsAudioStream(I) then
        cboAudio.Items.Add(Format('Audio#%d', [I]))
      else if FFPlayer.AVProbe.IsSubtitleStream(I) then
        cboSubtitle.Items.Add(Format('Subtitle#%d', [I]));
    end;
    cboVideo.Enabled := (cboVideo.Items.Count > 1) and (FFPlayer.VideoStreamIndex >= 0);
    cboVideo.ItemIndex := cboVideo.Items.IndexOf(Format('Video#%d', [FFPlayer.VideoStreamIndex]));
    cboAudio.Enabled := (cboAudio.Items.Count > 1) and (FFPlayer.AudioStreamIndex >= 0);
    cboAudio.ItemIndex := cboAudio.Items.IndexOf(Format('Audio#%d', [FFPlayer.AudioStreamIndex]));
    cboSubtitle.Enabled := (cboSubtitle.Items.Count > 0) and (FFPlayer.VideoStreamIndex >= 0);
    if cboSubtitle.Enabled then
    begin
      cboSubtitle.Items.Insert(0, 'Subtitle#-1');
      cboSubtitle.ItemIndex := cboSubtitle.Items.IndexOf(Format('Subtitle#%d', [FFPlayer.SubtitleStreamIndex]));
    end;
  finally
    cboVideo.Items.EndUpdate;
    cboAudio.Items.EndUpdate;
    cboSubtitle.Items.EndUpdate;
  end;
end;

// OnHook event handler
procedure TfrmPlayer.FFPlayerHook(Sender: TObject; ABitmap: TBitmap; const APTS: Int64);
begin
  with ABitmap.Canvas.Font do
  begin // setup font example
    Color := clWhite;
    Name := 'Tahoma';
    Size := 12;
    Style := [fsBold, fsUnderline];
  end;
  // text out with Presentation Time Stamp example
  ABitmap.Canvas.TextOut(10, 10, Format(SHookTimeStamp, [APTS]));
  // draw graphic example
  ABitmap.Canvas.Draw(ABitmap.Width - Application.Icon.Width - 10,
                      ABitmap.Height - Application.Icon.Height - 10,
                      Application.Icon);
end;

// OnPosition event handler
procedure TfrmPlayer.FFPlayerPosition(Sender: TObject; const APTS: Int64);
begin
  Label3.Caption := Format('%f', [APTS / 1000000]);
  if (APTS >= 0) and (FDuration > 0) then
    TrackBar1.SelEnd := TrackBar1.Max * APTS div FDuration;
end;

// OnState event handler
procedure TfrmPlayer.FFPlayerState(Sender: TObject; const AState: TPlayState);
const
  CPlayState: array[TPlayState] of string = ('Play', 'Pause', 'Resume', 'Step', 'Stop', 'End');
begin
  // show state
  mmoLog.Lines.Add(CPlayState[AState]);

  case AState of
    psPlay, psResume:
      if chkStayOnTop.Checked then
        Self.FormStyle := fsStayOnTop;
    psPause, psStep:
      Self.FormStyle := fsNormal;
    psStop:
      begin
        Self.FormStyle := fsNormal;
        // repaint the screen to the original appearance
        PostMessage(FFPlayer.ScreenHandle, CM_INVALIDATE, 0, 0);
        UpdateWindow(FFPlayer.ScreenHandle);
      end;
    psEnd:
      begin
//        FFPlayer.Stop;
        FFPlayer.Seek(0);
        FFPlayer.Pause;
      end;
  end;
end;

procedure TfrmPlayer.FFLoggerLog(Sender: TObject; const AThreadID: Cardinal;
  const ALogLevel: TLogLevel; const ALogMsg: string);
begin
  // OnLog event handler
  // TLogLevel = (llQuiet, llPanic, llFatal, llError, llWarning, llInfo, llVerbose, llDebug);
  mmoLog.Lines.Add('#' + IntToStr(AThreadID) + '.' + IntToStr(Ord(ALogLevel)) + ': ' + ALogMsg);
end;

end.
FFVCL - Delphi FFmpeg VCL Components (Video Converter 3.9 and Video Player 3.0)

Source of the Video Player Demo
