Source of Single Demo Main Form

unit SingleFrm;

interface

uses
  Windows, Messages, SysUtils, {Variants,} Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, FFmpegVCL;

type
  TfrmSingle = class(TForm)
    btnOpen: TButton;
    btnStart: TButton;
    btnStop: TButton;
    btnPause: TButton;
    btnResume: TButton;
    btnExit: TButton;
    OpenDialog1: TOpenDialog;
    FFVCL: TFFmpegVCL;
    mmoLog: TMemo;
    ProgressBar1: TProgressBar;
    procedure FormCreate(Sender: TObject);
    procedure btnOpenClick(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure btnPauseClick(Sender: TObject);
    procedure btnResumeClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure FFVCLLog(const AIndex: Integer; const ALogLevel: TLogLevel;
      const AMsg: string);
    procedure FFVCLProgress(const AIndex, AFrameNumber, AFPS,
      ACurrentDuration: Integer; const AQuality, ABitRate: Single;
      const ACurrentSize: Int64; const ATotalOutputDuration: Integer);
    procedure FFVCLTerminate(const AIndex: Integer; const AFinished,
      AException: Boolean; const AMessage: string);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmSingle: TfrmSingle;

implementation

{$R *.dfm}

{$IF NOT (DEFINED(VER140) OR DEFINED(VER185))}
uses
  XPMan;
{$IFEND}

const
  CLibAVPath = 'LibAV';

  SAppTitle = 'Demo of FFVCL %s';
  SCaption = 'Demo of FFVCL - Delphi FFmpeg VCL Component %s';

  // License sample (this is a fake license key)
//BOMB: you should update 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|*.*';

procedure TfrmSingle.FormCreate(Sender: TObject);
begin
  Application.Title := Format(SAppTitle, [FFVCL.Version]);
  Self.Caption := Format(SCaption, [FFVCL.Version]);

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

  // Set License Key
  FFVCL.SetLicenseKey(LICENSE_KEY, LICENSE_SEED);
end;

procedure TfrmSingle.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  with FFVCL do
  begin
    // Clear the event handlers
    OnBeforeHook := nil;
    OnCustomHook := nil;
    OnLog := nil;
    OnProgress := nil;
    OnTerminate := nil;

    // Break converting
    BreakConverting;
  end;
end;

function GenerateOutputFileName(const AFileName, AFileExt: string): string;
var
  LBaseName: string;
  I: Integer;
begin
  // generate output filename automatically
  LBaseName := ChangeFileExt(AFileName, '');
  Result := LBaseName + '_(new)' + AFileExt;
  if FileExists(Result) then
  begin
    I := 1;
    while FileExists(LBaseName + '_(new_' + IntToStr(I) + ')' + AFileExt) do
      Inc(I);
    Result := LBaseName + '_(new_' + IntToStr(I) + ')' + AFileExt;
  end;
end;

procedure TfrmSingle.btnOpenClick(Sender: TObject);
var
  LIndex: Integer;
  IO: TInputOptions;
  OO: TOutputOptions;
  LInFileName: string;
  LOutFileName: string;
begin
  // ensure FFmpeg DLLs loaded
  // FFVCL.LoadAVLib(const APath: string; const AWithVerNum): Boolean;
  // APath: Full path indicates location of FFmpeg DLLs.
  //        It can be empty, let Windows search DLLs in current dir or environment <PATH>
  // AWithVerNum: True means "avcodec-51.dll" rather than "avcodec.dll"
  // Normally, call LoadAVLib only once is enough, UnloadAVLib is not necessary.
  // In this demo, LoadAVLib and UnloadAVLib maybe called more than once,
  //    that only shows you the LoadAVLib parameter AWithVerNum
  if not FFVCL.LoadAVLib(ExtractFilePath(Application.ExeName) + CLibAVPath, True) then
  begin
    // cannot load FFmpeg DLLs, show error message
    mmoLog.Lines.Add(FFVCL.LastErrMsg);
    Exit;
  end;

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

  ProgressBar1.Position := 0;
  FFVCL.ClearInputFiles; // ensure reset FFVCL

  // open input file selected
  LInFileName := OpenDialog1.FileName;

  // you should determine the out filename
  LOutFileName := GenerateOutputFileName(LInFileName, '_ipod.mp4');

  // set input options
  InitInputOptions(@IO);
  IO.FileName := LInFileName;

  // try to open input file
  LIndex := FFVCL.AddInputFile(LInFileName, @IO);
  if LIndex < 0 then
  begin // open failed
    mmoLog.Lines.Add('');
    mmoLog.Lines.Add('***File open error: ' + FFVCL.LastErrMsg);
    mmoLog.Lines.Add('');
  end
  else
  begin // open success
    // here you can get input file info by property AVFileInfo
    // property AVFileInfo[Index: Integer]: TAVProbe read GetAVProbes;
    // property AVFileInfo is an instance of TAVProbe which is readonly,
    //    in other words, it cannot be seeked and its frame cannot be read.
    mmoLog.Lines.Add('');
    mmoLog.Lines.Add(FFVCL.AVFileInfo[LIndex].FileInfoText);

    InitOutputOptions(@OO);

    // ipod mp4 output options
    // -acodec libfaac -vcodec mpeg4 width<=320 height<=240
    OO.VideoCodec := 'mpeg4';     {Do not Localize}
    OO.AudioCodec := 'libfaac';   {Do not Localize}
    OO.FrameSize := '320x240';

    // try to set output file with output options
    if FFVCL.SetOutputFile(LIndex, LOutFileName, @OO) then
    begin // can do output file with output options
      // display some information of input file

      mmoLog.Lines.Add('');
      mmoLog.Lines.Add('***File loaded.');
      mmoLog.Lines.Add('');

      btnStart.Enabled := True;
      btnStart.SetFocus;
    end
    else
    begin // cannot do output file, remove input file
      FFVCL.RemoveInputFile(LIndex);
      mmoLog.Lines.Add('');
      mmoLog.Lines.Add('***Cannot do convert, error: ' + FFVCL.LastErrMsg);
      mmoLog.Lines.Add('');
    end;
  end;
end;

procedure TfrmSingle.btnStartClick(Sender: TObject);
begin
  // TLogLevel = (llQuiet, llError, llInfo, llDebug, llAll);
  FFVCL.LogLevel := llInfo;
  // TConvertPriority = tpIdle..tpNormal; //tpIdle, tpLowest, tpLower, tpNormal
  FFVCL.ThreadPriority := tpLower;

  btnOpen.Enabled := False;

  btnStart.Enabled := False;
  btnStop.Enabled := True;
  btnPause.Enabled := True;
  btnResume.Enabled := False;

  // procedure StartConvert(const AThreadCount: Integer);
  // AThreadCount: >  0, means do converting task in thread mode
  //               >  1, means do converting task with multiple files in the same time
  //               <= 0, means do converting task in main thread
  FFVCL.StartConvert(1);
end;

procedure TfrmSingle.btnStopClick(Sender: TObject);
begin
  btnStop.Enabled := False;
  FFVCL.BreakConverting; // only works in thread mode
end;

procedure TfrmSingle.btnPauseClick(Sender: TObject);
begin
  btnPause.Enabled := False;
  btnResume.Enabled := True;
  FFVCL.PauseConverting; // only works in thread mode
end;

procedure TfrmSingle.btnResumeClick(Sender: TObject);
begin
  btnPause.Enabled := True;
  btnResume.Enabled := False;
  FFVCL.ResumeConverting; // only works in thread mode
end;

procedure TfrmSingle.btnExitClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmSingle.FFVCLLog(const AIndex: Integer; const ALogLevel: TLogLevel;
  const AMsg: string);
begin
  // OnLog event handler
  // AIndex: index of input files, (-1) means index cannot be determined
  // TLogLevel = (llQuiet, llError, llInfo, llDebug, llAll);
  mmoLog.Lines.Add('#' + IntToStr(AIndex) + '.' + IntToStr(Ord(ALogLevel)) + ': ' + AMsg);
end;

procedure TfrmSingle.FFVCLProgress(const AIndex, AFrameNumber, AFPS,
  ACurrentDuration: Integer; const AQuality, ABitRate: Single;
  const ACurrentSize: Int64; const ATotalOutputDuration: Integer);
begin
  // OnProgress event handler
  // AIndex: index of input files
  // AFrameNumber: current frame number
  // AFPS: video converting speed, frames per second, not valid when only audio output
  // ACurrentDuration: current duration time in millisecond
  // AQuality: <i don't know...>???
  // ABitRate: ...
  // ACurrentSize: current output file size in bytes
  // ATotalOutputDuration: total output duration time in millisecond
  ProgressBar1.Position := ACurrentDuration * 100 div ATotalOutputDuration;
end;

procedure TfrmSingle.FFVCLTerminate(const AIndex: Integer; const AFinished,
  AException: Boolean; const AMessage: string);
begin
  // OnTerminate event handler
  // AIndex: index of input files, (-1) means all files are converted
  // AFinished: true means converted success, false means converting breaked
  // AException: true means Exception occured
  // AMessage: exception message
  if AIndex < 0 then
  begin
    btnOpen.Enabled := True;

    btnStart.Enabled := False;
    btnStop.Enabled := False;
    btnPause.Enabled := False;
    btnResume.Enabled := False;

    // do not forget to clear all input files!!!
    FFVCL.ClearInputFiles;
  end
  else if AFinished then
  begin // AIndex file converted success
    ProgressBar1.Position := 100;
  end;
  if AException then // Exception occured, show exception message
    Application.MessageBox(PChar(AMessage), PChar(Application.Title), MB_OK + MB_ICONWARNING);
end;

end.