unit SingleFrm;
interface
uses
  Windows, Messages, SysUtils,  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
    
  public
    
  end;
var
  frmSingle: TfrmSingle;
implementation
uses
  XPMan;
const
  CLibAVPath = 'LibAV';
  SAppTitle = 'Demo of FFVCL %s';
  SCaption = 'Demo of FFVCL - Delphi FFmpeg VCL Component %s';
  
  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]);
  
  OpenDialog1.Options := CDialogOptions;
  OpenDialog1.Filter := CDialogFilter;
  
  FFVCL.SetLicenseKey(LICENSE_KEY, LICENSE_SEED);
end;
procedure TfrmSingle.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  with FFVCL do
  begin
    
    OnBeforeHook := nil;
    OnCustomHook := nil;
    OnLog := nil;
    OnProgress := nil;
    OnTerminate := nil;
    
    BreakConverting;
  end;
end;
function GenerateOutputFileName(const AFileName, AFileExt: string): string;
var
  LBaseName: string;
  I: Integer;
begin
  
  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
  
  
  
  
  
  
  
  
  if not FFVCL.LoadAVLib(ExtractFilePath(Application.ExeName) + CLibAVPath, True) then
  begin
    
    mmoLog.Lines.Add(FFVCL.LastErrMsg);
    Exit;
  end;
  if not OpenDialog1.Execute then
    
    Exit;
  ProgressBar1.Position := 0;
  FFVCL.ClearInputFiles; 
  
  LInFileName := OpenDialog1.FileName;
  
  LOutFileName := GenerateOutputFileName(LInFileName, '_ipod.mp4');
  
  InitInputOptions(@IO);
  IO.FileName := LInFileName;
  
  LIndex := FFVCL.AddInputFile(LInFileName, @IO);
  if LIndex < 0 then
  begin 
    mmoLog.Lines.Add('');
    mmoLog.Lines.Add('***File open error: ' + FFVCL.LastErrMsg);
    mmoLog.Lines.Add('');
  end
  else
  begin 
    
    
    
    
    mmoLog.Lines.Add('');
    mmoLog.Lines.Add(FFVCL.AVFileInfo[LIndex].FileInfoText);
    InitOutputOptions(@OO);
    
    
    OO.VideoCodec := 'mpeg4';     
    OO.AudioCodec := 'libfaac';   
    OO.FrameSize := '320x240';
    
    if FFVCL.SetOutputFile(LIndex, LOutFileName, @OO) then
    begin 
      
      mmoLog.Lines.Add('');
      mmoLog.Lines.Add('***File loaded.');
      mmoLog.Lines.Add('');
      btnStart.Enabled := True;
      btnStart.SetFocus;
    end
    else
    begin 
      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
  
  FFVCL.LogLevel := llInfo;
  
  FFVCL.ThreadPriority := tpLower;
  btnOpen.Enabled := False;
  btnStart.Enabled := False;
  btnStop.Enabled := True;
  btnPause.Enabled := True;
  btnResume.Enabled := False;
  
  
  
  
  FFVCL.StartConvert(1);
end;
procedure TfrmSingle.btnStopClick(Sender: TObject);
begin
  btnStop.Enabled := False;
  FFVCL.BreakConverting; 
end;
procedure TfrmSingle.btnPauseClick(Sender: TObject);
begin
  btnPause.Enabled := False;
  btnResume.Enabled := True;
  FFVCL.PauseConverting; 
end;
procedure TfrmSingle.btnResumeClick(Sender: TObject);
begin
  btnPause.Enabled := True;
  btnResume.Enabled := False;
  FFVCL.ResumeConverting; 
end;
procedure TfrmSingle.btnExitClick(Sender: TObject);
begin
  Close;
end;
procedure TfrmSingle.FFVCLLog(const AIndex: Integer; const ALogLevel: TLogLevel;
  const AMsg: string);
begin
  
  
  
  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
  
  
  
  
  
  
  
  
  
  ProgressBar1.Position := ACurrentDuration * 100 div ATotalOutputDuration;
end;
procedure TfrmSingle.FFVCLTerminate(const AIndex: Integer; const AFinished,
  AException: Boolean; const AMessage: string);
begin
  
  
  
  
  
  if AIndex < 0 then
  begin
    btnOpen.Enabled := True;
    btnStart.Enabled := False;
    btnStop.Enabled := False;
    btnPause.Enabled := False;
    btnResume.Enabled := False;
    
    FFVCL.ClearInputFiles;
  end
  else if AFinished then
  begin 
    ProgressBar1.Position := 100;
  end;
  if AException then 
    Application.MessageBox(PChar(AMessage), PChar(Application.Title), MB_OK + MB_ICONWARNING);
end;
end.