unit MainFrm;
interface
uses
  Windows, Messages, SysUtils,  Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Menus, FFmpeg, FFmpegVCL;
type
  TfrmMain = class(TForm)
    btnAdd: TButton;
    mmoLog: TMemo;
    OpenDialog1: TOpenDialog;
    btnStop: TButton;
    chkThreadMode: TCheckBox;
    chkVerNum: TCheckBox;
    btnPause: TButton;
    FFVCL: TFFmpegVCL;
    btnStart: TButton;
    btnResume: TButton;
    edtThreadCount: TEdit;
    Label7: TLabel;
    btnRemove: TButton;
    btnClear: TButton;
    grpOption: TGroupBox;
    lvFiles: TListView;
    btnExit: TButton;
    grpLogLevel: TRadioGroup;
    grpPriority: TRadioGroup;
    btnWebSite: TButton;
    PopupMenu1: TPopupMenu;
    mnuAdd: TMenuItem;
    mnuRemove: TMenuItem;
    mnuClear: TMenuItem;
    N1: TMenuItem;
    mnuOpenFolder: TMenuItem;
    mnuPlay: TMenuItem;
    procedure btnAddClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure chkVerNumClick(Sender: TObject);
    procedure btnPauseClick(Sender: TObject);
    procedure btnResumeClick(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FFVCLBeforeHook(const AIndex: Integer; const APTS: Int64;
      var AHookAction: THookAction);
    procedure FFVCLCustomHook(const AIndex: Integer; ABitmap: TBitmap;
      const AFrameNumber: Integer; const APTS: Int64; var AUpdate, AStopHook: Boolean);
    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 btnClearClick(Sender: TObject);
    procedure btnRemoveClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure btnWebSiteClick(Sender: TObject);
    procedure mnuOpenFolderClick(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure mnuPlayClick(Sender: TObject);
  private
    FFolderList: TStringList;
    FOutFileList: TStringList;
    procedure DoException(Sender: TObject; E: Exception);
    procedure DoAddFile(const AIO: TInputOptions; const AOO: TOutputOptions);
  public
  end;
var
  frmMain: TfrmMain;
implementation
uses
  XPMan,
  ShellAPI,
  OptionFrm;
var
  GfrmOption: TfrmOption = nil;
const
  CLibAVPath = 'LibAV';
  SAppTitle = 'Demo of FFVCL %s';
  SCaption = 'Demo of FFVCL - Delphi FFmpeg VCL Component %s';
  SWebSiteC = 'http://www.CCAVC.com';
  SWebSiteE = 'http://www.DelphiFFmpeg.com';
  DEMO_INFO =
    '* The Demo Version FFVCL only works in Delphi IDE' +
      #13#10 +
    '* Load VerNum DLL means "avcodec-51.dll" rather than "avcodec.dll"' +
      #13#10 +
    '* Thread Mode means creating new threads to do converting jobs, ' +
      'it dose not using the main thread so you can Stop/Pause/Resume ' +
      'converting without block.' +
      #13#10 +
    '  * Thread Count means the quantity of converting jobs in the same time.' +
      #13#10 +
    '  * WARNING: if you want to debug your code in IDE such as Breakpoints, ' +
      'please do not check Thread Mode, or choose Thread Priority below "Normal", ' +
      'because Delphi Debugger maybe fall into trouble in Thread Mode.' +
      #13#10 +
    '* Log Level means the log messages level' +
      #13#10 +
    '* Thread Priority only works in Thread Mode' +
      #13#10 +
      #13#10;
  
  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|*.*';
  SHookFrameNumber = 'FFVCL - Frame Number: %d';
  SHookTimeStamp = 'FFVCL - Time Stamp: %d';
  SHookTextImage = 'FFVCL';
  SHookReverseVertical = 'Reverse Picture Vertically';
  SHookReverseHorizontal = 'Reverse Picture Horizontally';
var
  SWebSite: string = SWebSiteE;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
  Application.Title := Format(SAppTitle, [FFVCL.Version]);
  Self.Caption := Format(SCaption, [FFVCL.Version]);
  if SysUtils.SysLocale.PriLangID = LANG_CHINESE then
    SWebSite := SWebSiteC
  else
    SWebSite := SWebSiteE;
  btnWebSite.Caption := SWebSite;
  mmoLog.Text := DEMO_INFO;
  FFolderList := TStringList.Create;
  FOutFileList := TStringList.Create;
  
  OpenDialog1.Options := CDialogOptions;
  OpenDialog1.Filter := CDialogFilter;
  
  Application.OnException := DoException;
  
  FFVCL.SetLicenseKey(LICENSE_KEY, LICENSE_SEED);
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FFolderList);
  FreeAndNil(FOutFileList);
end;
procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  with FFVCL do
  begin
    
    OnBeforeHook := nil;
    OnCustomHook := nil;
    OnLog := nil;
    OnProgress := nil;
    OnTerminate := nil;
    
    BreakConverting;
  end;
end;
procedure TfrmMain.DoException(Sender: TObject; E: Exception);
var
  LMsg: string;
begin
  LMsg := E.Message;
  if (LMsg <> '') and (AnsiLastChar(LMsg) > '.') then
    LMsg := LMsg + '.';
  if E is FFmpegException then
    
    Application.MessageBox(PChar(LMsg), PChar(Application.Title), MB_OK + MB_ICONWARNING)
  else
    
    Application.MessageBox(PChar(LMsg), PChar(Application.Title), MB_OK + MB_ICONERROR);
end;
procedure TfrmMain.chkVerNumClick(Sender: TObject);
begin
  
  
  
  FFVCL.UnloadAVLib;
end;
procedure TfrmMain.btnAddClick(Sender: TObject);
begin
  
  
  
  
  
  
  
  
  if not FFVCL.LoadAVLib(ExtractFilePath(Application.ExeName) + CLibAVPath, chkVerNum.Checked) then
  begin
    
    mmoLog.Lines.Add(FFVCL.LastErrMsg);
    Exit;
  end;
  
  FFVCL.LogLevel := TLogLevel(grpLogLevel.ItemIndex);
  if not OpenDialog1.Execute then
    
    Exit;
  
  
  
  
  if FFVCL.AVProbe.LoadFile(OpenDialog1.FileName) then
  begin 
    if not Assigned(GfrmOption) then
      
      GfrmOption := TfrmOption.Create(Self);
    
    GfrmOption.AVProbe := FFVCL.AVProbe;
    if GfrmOption.ShowModal = mrOk then
      
      DoAddFile(GfrmOption.InputOptions, GfrmOption.OutputOptions);
    
    FFVCL.AVProbe.CloseFile;
  end
  else
  begin 
    mmoLog.Lines.Add('');
    mmoLog.Lines.Add('***File load error: ' + FFVCL.AVProbe.LastErrMsg);
    mmoLog.Lines.Add('');
  end;
end;
procedure TfrmMain.DoAddFile(const AIO: TInputOptions; const AOO: TOutputOptions);
var
  LIndex: Integer;
begin
  
  LIndex := FFVCL.AddInputFile(AIO.FileName, @AIO);
  if LIndex < 0 then
  begin 
    mmoLog.Lines.Add('');
    mmoLog.Lines.Add('***File open error: ' + FFVCL.LastErrMsg);
    mmoLog.Lines.Add('');
  end
  else
  begin 
    
    if FFVCL.SetOutputFile(LIndex, AOO.FileName, @AOO) then
    begin 
      with lvFiles.Items.Add do
      begin
        
        Caption := ExtractFileName(AIO.FileName);
        
        SubItems.Add(IntToStr(FFVCL.AVProbe.FileStreamInfo.Duration div 1000000));
        SubItems.Add(IntToStr(FFVCL.AVProbe.FileSize));
        SubItems.Add(ExtractFileName(AOO.FileName));
        SubItems.Add('');
        SubItems.Add('');
        SubItems.Add('');
        SubItems.Add('');
      end;
      
      FFolderList.Add(ExtractFilePath(AOO.FileName));
      FOutFileList.AddObject(AOO.FileName, nil);
      mmoLog.Lines.Add('');
      mmoLog.Lines.Add('***File has been added to convert list.');
      mmoLog.Lines.Add('');
      btnRemove.Enabled := True;
      btnClear.Enabled := True;
      btnStart.Enabled := True;
    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 TfrmMain.btnRemoveClick(Sender: TObject);
begin
  if lvFiles.ItemIndex >= 0 then
  begin
    
    FFVCL.RemoveInputFile(lvFiles.ItemIndex);
    FFolderList.Delete(lvFiles.ItemIndex);
    FOutFileList.Delete(lvFiles.ItemIndex);
    lvFiles.Items.Delete(lvFiles.ItemIndex);
    btnRemove.Enabled := lvFiles.Items.Count > 0;
    btnClear.Enabled := lvFiles.Items.Count > 0;
    btnStart.Enabled := lvFiles.Items.Count > 0;
  end;
end;
procedure TfrmMain.btnClearClick(Sender: TObject);
begin
  
  FFVCL.ClearInputFiles;
  FFolderList.Clear;
  FOutFileList.Clear;
  lvFiles.Items.Clear;
  btnAdd.Enabled := True;
  btnRemove.Enabled := False;
  btnClear.Enabled := False;
  btnStart.Enabled := False;
end;
procedure TfrmMain.btnStartClick(Sender: TObject);
begin
  
  FFVCL.LogLevel := TLogLevel(grpLogLevel.ItemIndex);
  
  FFVCL.ThreadPriority := TThreadPriority(grpPriority.ItemIndex);
  btnAdd.Enabled := False;
  btnRemove.Enabled := False;
  btnClear.Enabled := False;
  btnStart.Enabled := False;
  btnStop.Enabled := chkThreadMode.Checked;
  btnPause.Enabled := chkThreadMode.Checked;
  btnResume.Enabled := False;
  
  
  
  
  if chkThreadMode.Checked then
    
    FFVCL.StartConvert(StrToIntDef(edtThreadCount.Text, 1))
  else
    
    FFVCL.StartConvert(0);
end;
procedure TfrmMain.btnStopClick(Sender: TObject);
begin
  btnStop.Enabled := False;
  FFVCL.BreakConverting; 
end;
procedure TfrmMain.btnPauseClick(Sender: TObject);
begin
  btnPause.Enabled := False;
  btnResume.Enabled := True;
  FFVCL.PauseConverting; 
end;
procedure TfrmMain.btnResumeClick(Sender: TObject);
begin
  btnPause.Enabled := True;
  btnResume.Enabled := False;
  FFVCL.ResumeConverting; 
end;
procedure TfrmMain.btnWebSiteClick(Sender: TObject);
begin
  ShellExecute(Application.Handle, 'Open',   
    PChar(LowerCase(SWebSite)), '',
    PChar(ExtractFilePath(Application.ExeName)), 1);
end;
procedure TfrmMain.btnExitClick(Sender: TObject);
begin
  Close;
end;
procedure TfrmMain.mnuOpenFolderClick(Sender: TObject);
var
  LPath: string;
begin
  if (lvFiles.ItemIndex >= 0) and (lvFiles.ItemIndex < FFolderList.Count) then
    LPath := FFolderList.Strings[lvFiles.ItemIndex]
  else if FFolderList.Count > 0 then
    LPath := FFolderList.Strings[FFolderList.Count - 1]
  else
    LPath := '';
  if (LPath <> '') and DirectoryExists(LPath) then
    ShellExecute(Application.Handle, 'Open', 
      PChar(LPath), nil,
      PChar(LPath), SW_SHOWDEFAULT);
end;
procedure TfrmMain.mnuPlayClick(Sender: TObject);
var
  I: Integer;
begin
  if (lvFiles.ItemIndex >= 0) and (lvFiles.ItemIndex < FFolderList.Count) then
    I := lvFiles.ItemIndex
  else
    I := FOutFileList.Count - 1;
  if (I >= 0) and Assigned(FOutFileList.Objects[I]) and FileExists(FOutFileList.Strings[I]) then
    ShellExecute(Application.Handle, 'Open',   
      PChar(FOutFileList.Strings[I]), '',
      PChar(ExtractFilePath(FOutFileList.Strings[I])), SW_SHOWNORMAL);
end;
procedure TfrmMain.PopupMenu1Popup(Sender: TObject);
var
  I: Integer;
begin
  mnuAdd.Enabled := btnAdd.Enabled;
  mnuRemove.Enabled := btnRemove.Enabled;
  mnuClear.Enabled := btnClear.Enabled;
  mnuOpenFolder.Enabled := lvFiles.Items.Count > 0;
  if (lvFiles.ItemIndex >= 0) and (lvFiles.ItemIndex < FFolderList.Count) then
    I := lvFiles.ItemIndex
  else
    I := FOutFileList.Count - 1;
  mnuPlay.Enabled := (I >= 0) and Assigned(FOutFileList.Objects[I]);
end;
procedure TfrmMain.FFVCLBeforeHook(const AIndex: Integer; const APTS: Int64;
  var AHookAction: THookAction);
begin
  
  
  
  
  
  
  
  
  
  
  if APTS < 5 * 1000 * 1000 then
    AHookAction := haContinue
  else if APTS < 10 * 1000 * 1000 then
    AHookAction := haIgnore
  else if APTS < 15 * 1000 * 1000 then
    AHookAction := haContinue
  else
    AHookAction := haStop;
end;
procedure TfrmMain.FFVCLCustomHook(const AIndex: Integer; ABitmap: TBitmap;
  const AFrameNumber: Integer; const APTS: Int64; var AUpdate, AStopHook: Boolean);
const
  CBytes = 3; 
var
  H, W: Integer;
  I, J, K: Integer;
  P1, P2: PChar;
  B: Char;
begin
  
  
  
  
  
  
  
  
  
  
  
  if AFrameNumber = 1 then
  begin 
    with ABitmap.Canvas.Font do
    begin 
      Color := clWhite;
      Name := 'Tahoma';
      Size := 12;
      Style := [fsBold, fsUnderline];
    end;
    
    
  end;
  if AFrameNumber < 100 then
    
    ABitmap.Canvas.TextOut(10, 10, Format(SHookFrameNumber, [AFrameNumber]))
  else if AFrameNumber < 150 then
    
    AUpdate := False
  else if AFrameNumber < 250 then
    
    ABitmap.Canvas.TextOut(10, 10, Format(SHookTimeStamp, [APTS]))
  else if AFrameNumber < 350 then
  begin
    
    if AFrameNumber = 250 then
      with ABitmap.Canvas.Font do
      begin 
        Color := clRed;
        Size := 16;
      end;
    ABitmap.Canvas.TextOut(10, 10, SHookTextImage);
    ABitmap.Canvas.Draw(ABitmap.Width - Application.Icon.Width - 10,
                        ABitmap.Height - Application.Icon.Height - 10,
                        Application.Icon);
  end
  else if AFrameNumber < 450 then
  begin
    if AFrameNumber = 350 then
      with ABitmap.Canvas.Font do
      begin 
        Color := clWhite;
        Style := [fsBold];
      end;
    ABitmap.Canvas.TextOut(10, 10, SHookReverseVertical);
    
    H := ABitmap.Height;
    W := ABitmap.Width;
    for I := 0 to H div 2 - 1 do
    begin
      P1 := PChar(ABitmap.ScanLine[I]);
      P2 := PChar(ABitmap.ScanLine[H - 1 - I]);
      for J := 0 to CBytes * W - 1 do
      begin
        B := P1^;
        P1^ := P2^;
        P2^ := B;
        Inc(P1);
        Inc(P2);
      end;
    end;
  end
  else if AFrameNumber < 550 then
  begin
    if AFrameNumber = 350 then
      with ABitmap.Canvas.Font do
      begin 
        Style := [];
      end;
    ABitmap.Canvas.TextOut(10, 10, SHookReverseHorizontal);
    
    H := ABitmap.Height;
    W := ABitmap.Width;
    for I := 0 to H - 1 do
    begin
      P1 := PChar(ABitmap.ScanLine[I]);
      P2 := P1 + CBytes * (W - 1);
      for J := 0 to W div 2 - 1 do
      begin
        for K := 0 to CBytes - 1 do
        begin
          B := (P1 + K)^;
          (P1 + K)^ := (P2 + K)^;
          (P2 + K)^ := B;
        end;
        Inc(P1, CBytes);
        Dec(P2, CBytes);
      end;
    end;
  end
  else
    
    AStopHook := True;
end;
procedure TfrmMain.FFVCLLog(const AIndex: Integer; const ALogLevel: TLogLevel; const AMsg: string);
begin
  
  
  
  mmoLog.Lines.Add('#' + IntToStr(AIndex) + '.' + IntToStr(Ord(ALogLevel)) + ': ' + AMsg);
end;
procedure TfrmMain.FFVCLProgress(const AIndex, AFrameNumber, AFPS,
  ACurrentDuration: Integer; const AQuality, ABitRate: Single;
  const ACurrentSize: Int64; const ATotalOutputDuration: Integer);
begin
  
  
  
  
  
  
  
  
  
  with lvFiles.Items.Item[AIndex].SubItems do
  begin
    Strings[3] := IntToStr(ACurrentDuration * 100 div ATotalOutputDuration) + '%';
    if AFPS > 0 then
      Strings[4] := IntToStr(AFPS);
    Strings[5] := IntToStr(ACurrentDuration div 1000); 
    Strings[6] := IntToStr(ACurrentSize);
  end;
  if not chkThreadMode.Checked then
  begin 
    lvFiles.Repaint;
  end;
end;
procedure TfrmMain.FFVCLTerminate(const AIndex: Integer; const AFinished,
  AException: Boolean; const AMessage: string);
begin
  
  
  
  
  
  if AIndex < 0 then
  begin
    btnAdd.Enabled := False;
    btnRemove.Enabled := False;
    btnClear.Enabled := True;
    btnStart.Enabled := False;
    btnStop.Enabled := False;
    btnPause.Enabled := False;
    btnResume.Enabled := False;
    
    FFVCL.ClearInputFiles;
  end
  else if AFinished then
  begin 
    lvFiles.Items.Item[AIndex].SubItems.Strings[3] := '100%';
    if not chkThreadMode.Checked then
    begin 
      lvFiles.Repaint;
    end;
  end;
  if (AIndex >= 0) and not AException then 
    FOutFileList.Objects[AIndex] := TObject(1);
  if AException then 
    Application.MessageBox(PChar(AMessage), PChar(Application.Title), MB_OK + MB_ICONWARNING);
end;
end.