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

unit AVProbeFrm;

interface

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

type
  TfrmAVProbe = class(TForm)
    lblPTS: TLabel;
    Image1: TImage;
    btnOpen: TButton;
    btnWebSite: TButton;
    btnExit: TButton;
    btnNextFrame: TButton;
    mmoLog: TMemo;
    TrackBar1: TTrackBar;
    FAVProbe: TAVProbe;
    FFLogger: TFFLogger;
    OpenDialog1: TOpenDialog;
    cboLogLevel: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Image1Click(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure btnOpenClick(Sender: TObject);
    procedure btnNextFrameClick(Sender: TObject);
    procedure btnWebSiteClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure cboLogLevelChange(Sender: TObject);
    procedure FFLoggerLog(Sender: TObject; AThreadID: Cardinal;
      ALogLevel: TLogLevel; const ALogMsg: string);
  private
    { Private declarations }
    FBitmap: TBitmap;
    FPosition: Double;
    FDuration: Int64;
    FFrames: Integer;
    FChanging: Boolean;
    FPTS: Int64;
    FLastPosition: Integer;
    procedure DoActualFormClick(Sender: TObject);
    procedure ClearFrameView;
    procedure SetupTrackBar;
    procedure UpdatePosition(APTS: Int64);
    procedure ReadAndDrawFrame(APTS: Int64);
  public
    { Public declarations }
  end;

var
  frmAVProbe: TfrmAVProbe;

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 AVProbe';
  SCaption = 'Demo of AVProbe - Delphi FFmpeg VCL Components';
  SWebSiteC = 'http://www.CCAVC.com';
  SWebSiteE = 'http://www.DelphiFFmpeg.com';
  SViewActual = 'Click to view current picture in actual size';

  // 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|*.*';

var
  SWebSite: string = SWebSiteE;

{ Utils }

function DurationToStr(ADuration: Int64): string;
begin
  Result := Format('%.2d:%.2d:%.2d.%.3d',
    [ADuration div AV_TIME_BASE div 60 div 60,
     ADuration div AV_TIME_BASE div 60 mod 60,
     ADuration div AV_TIME_BASE mod 60,
     ADuration mod AV_TIME_BASE * 1000 div AV_TIME_BASE]);
end;

// scale source rect into destination rect
function FitRect(ASrcRect, ADestRect: TRect): TRect;
var
  LWFactor: Double;
  LHFactor: Double;
  LSpace: Integer;
begin
  LWFactor := (ASrcRect.Right - ASrcRect.Left) / (ADestRect.Right - ADestRect.Left);
  LHFactor := (ASrcRect.Bottom - ASrcRect.Top) / (ADestRect.Bottom - ADestRect.Top);
  if LWFactor < LHFactor then
  begin
    Result.Top := ADestRect.Top;
    Result.Bottom := ADestRect.Bottom;
    LSpace := Round(((ADestRect.Right - ADestRect.Left) - (ASrcRect.Right - ASrcRect.Left) / LHFactor) / 2);
    Result.Left := ADestRect.Left + LSpace;
    Result.Right := ADestRect.Right - LSpace;
  end
  else
  begin
    Result.Left := ADestRect.Left;
    Result.Right := ADestRect.Right;
    LSpace := Round(((ADestRect.Bottom - ADestRect.Top) - (ASrcRect.Bottom - ASrcRect.Top) / LWFactor) / 2);
    Result.Top := ADestRect.Top + LSpace;
    Result.Bottom := ADestRect.Bottom - LSpace;
  end;
end;

// stretch draw bitmap on image with fit scale
procedure FitDraw(ACanvas: TCanvas; ABitmap: TBitmap);
var
  R: TRect;
begin
  if ABitmap.Width * ABitmap.Height = 0 then Exit;
  R := ACanvas.ClipRect;
  // calculate scaled rect then draw bitmap on image
{$IFDEF DRAW_FRAME}
  InflateRect(R, -1, -1);
{$ENDIF}
  R := FitRect(ABitmap.Canvas.ClipRect, R);
  ACanvas.StretchDraw(R, ABitmap);
{$IFDEF DRAW_FRAME}
  ACanvas.Brush.Color := clGreen;
  InflateRect(R, 1, 1);
  ACanvas.FrameRect(R);
{$ENDIF}
end;

procedure TfrmAVProbe.FormCreate(Sender: TObject);
begin
  Application.Title := SAppTitle;
  Self.Caption := SCaption;
  if SysUtils.SysLocale.PriLangID = LANG_CHINESE then
    SWebSite := SWebSiteC
  else
    SWebSite := SWebSiteE;
  btnWebSite.Caption := SWebSite;
  mmoLog.Text := SCaption + #13#10;
  Image1.Hint := SViewActual;
  Image1.ShowHint := True;

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

  // create instance
  FBitmap := TBitmap.Create;

  // clear frame view
  ClearFrameView;

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

procedure TfrmAVProbe.FormResize(Sender: TObject);
begin
  // setup track bar
  SetupTrackBar;
  Image1.Picture.Graphic.Width := Image1.Width;
  Image1.Picture.Graphic.Height := Image1.Height;
  Image1.Canvas.Brush.Color := clSkyBlue;
  Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
  if FBitmap.Width <> 0 then
    FitDraw(Image1.Canvas, FBitmap)
  else
    ClearFrameView;
end;

procedure TfrmAVProbe.FormDestroy(Sender: TObject);
begin
  FBitmap.Free;
end;

procedure TfrmAVProbe.ClearFrameView;
begin
  // reset global variables
  FPosition := 0;
  FDuration := 0;
  FFrames := 0;
  FPTS := 0;
  // clear cached frame picture
  FBitmap.Width := 0;
  FBitmap.Height := 0;
  // fill background
  Image1.Canvas.Brush.Color := clSkyBlue;
  Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
  // diable track bar
  TrackBar1.Enabled := False;
  TrackBar1.Position := 0;
  SetupTrackBar;

  lblPTS.Caption := DurationToStr(0);
end;

procedure TfrmAVProbe.SetupTrackBar;
var
  LEnabled: Boolean;
begin
  LEnabled := TrackBar1.Enabled;

  TrackBar1.Enabled := False;

  if FFrames > 0 then
    TrackBar1.Max := FFrames;

  if TrackBar1.Max > 10 then
    TrackBar1.Frequency := TrackBar1.Max div 10
  else
    TrackBar1.Frequency := 1;

  if TrackBar1.Max < 10 then
    TrackBar1.PageSize := 2
  else if TrackBar1.Max < 100 then
    TrackBar1.PageSize := 5
  else
    TrackBar1.PageSize := TrackBar1.Max div 20;

  TrackBar1.Position := Round(TrackBar1.Max * FPosition);
  FLastPosition := TrackBar1.Position;

  TrackBar1.Enabled := LEnabled;
  TrackBar1.SliderVisible := LEnabled;
end;

procedure TfrmAVProbe.UpdatePosition(APTS: Int64);
var
  LPosition: Integer;
begin
  FPTS := APTS;
  lblPTS.Caption := DurationToStr(FPTS);
  if not FChanging and (FDuration <> 0) then
  begin
    FChanging := True;
    try
      LPosition := Round(TrackBar1.Max * FPTS / FDuration);
      if LPosition > TrackBar1.Max then
        LPosition := TrackBar1.Max;
      TrackBar1.Position := LPosition;
    finally
      FChanging := False;
    end;
  end;
end;

procedure TfrmAVProbe.ReadAndDrawFrame(APTS: Int64);
begin
{
  function Decode(AStreamIndex: Integer = -1): Boolean;
    AStreamIndex: special video stream to seek, must set as video stream's index.
      -1 means using the first video stream.
    if Decode() successfully, use property FrameInfo to get the information.
    NOTICE: after Decode() call, the position will change to next frame.

  function CopyToBitmap(ABitmap: TBitmap): Boolean;
    if Decode() successfully, copy the decoded frame picture to ABtimap.
}
  while True do
  begin
    if FAVProbe.Decode then
    begin
      if (FAVProbe.FrameInfo.PTS >= APTS) or (APTS <= 0) then
      begin
        UpdatePosition(FAVProbe.FrameInfo.PTS);
        if FAVProbe.CopyToBitmap(FBitmap) then
          FitDraw(Image1.Canvas, FBitmap)
        else
          mmoLog.Lines.Add('***CopyToBitmap failed: ' + FAVProbe.LastErrMsg);
        Break;
      end;
    end
    else
    begin
      mmoLog.Lines.Add('***Decode failed: ' + FAVProbe.LastErrMsg);
      Break;
    end;
  end;
end;

procedure TfrmAVProbe.DoActualFormClick(Sender: TObject);
begin
  if Assigned(Sender) and (Sender is TControl) and ((Sender as TControl).Parent is TForm) then
    ((Sender as TControl).Parent as TForm).Close;
end;

procedure TfrmAVProbe.Image1Click(Sender: TObject);
var
  F: TForm;
  I: TImage;
  B: TButton;
begin
  if FBitmap.Width * FBitmap.Height = 0 then Exit;

  // show current frame picture in actual size
  F := TForm.Create(Self);
  try
    F.BorderIcons := [biSystemMenu];
    B := TButton.Create(F);
    B.Parent := F;
    B.Default := True;
    B.Cancel := True;
    B.ModalResult := mrCancel;
    B.Top := 0;
    B.Left := 0;
    B.Width := 0;
    B.Height := 0;
    B.Visible := True;
    I := TImage.Create(F);
    I.Parent := F;
    I.OnClick := Self.DoActualFormClick;
    I.Visible := True;
    I.Left := 0;
    I.Top := 0;
    I.Width := FBitmap.Width;
    I.Height := FBitmap.Height;
    I.Picture.Assign(FBitmap);
    F.Position := poScreenCenter;
    F.BorderStyle := bsSingle;
    F.Caption := Format('%dx%d @ %s', [FBitmap.Width, FBitmap.Height,
      DurationToStr(FPTS)]);;
    F.ClientWidth := I.Width;
    F.ClientHeight := I.Height;
    F.ShowModal;
  finally
    F.Free;
  end;
end;

procedure TfrmAVProbe.TrackBar1Change(Sender: TObject);
begin
  if FLastPosition = TrackBar1.Position then
    Exit;

  if not FChanging and TrackBar1.Enabled and (FAVProbe.VideoStreamCount > 0) then
  begin
    if TrackBar1.Max > 0 then
      FPosition := TrackBar1.Position / TrackBar1.Max
    else
      FPosition := 0;
    FChanging := True;
    try
{
  function Seek(const APTS: Int64; ASeekFlags: TSeekFlags = []): Boolean;
    if sfByte in ASeekFlags then
      APTS: Position in bytes, its bound is 0 to size of the file.
    else
      APTS: Presentation Time Stamp in microsecond, its bound is 0 to
        total duration of the file.
    ASeekFlags: TSeekFlags = set of TSeekFlag
      sfBackward: // seek backward
      sfByte:     // seeking based on position in bytes
      sfAny:      // seek to any frame, even non key-frames
}
      if TrackBar1.Position = FLastPosition + 1 then
      begin
        // next frame
        ReadAndDrawFrame(-1);
      end
      else if TrackBar1.Position = FLastPosition - 1 then
      begin
        // try to seek and then decode the previous frame
        // these code is not a good one and maybe cannot reach the accurate previous frame.
        if FAVProbe.Seek(Round(FPosition * FDuration), [sfBackward]) or
          FAVProbe.Seek(Round(FPosition * FDuration), [sfBackward, sfAny]) or
          FAVProbe.Seek(Round(FPosition * FDuration)) or
          FAVProbe.Seek(Round(FPosition * FDuration), [sfAny]) then
        begin
          ReadAndDrawFrame(Round(FPosition * FDuration));
        end
        else
          mmoLog.Lines.Add('***SeeFrame failed: ' + FAVProbe.LastErrMsg);
      end
      else if FAVProbe.Seek(Round(FPosition * FDuration)) or
        FAVProbe.Seek(Round(FPosition * FDuration), [sfBackward]) or
        FAVProbe.Seek(Round(FPosition * FDuration), [sfAny]) then
      begin
        ReadAndDrawFrame(Round(FPosition * FDuration));
      end
      else
        mmoLog.Lines.Add('***SeeFrame failed: ' + FAVProbe.LastErrMsg);
    finally
      FLastPosition := TrackBar1.Position;
      FChanging := False;
    end;
  end;
end;

procedure TfrmAVProbe.btnNextFrameClick(Sender: TObject);
begin
  ReadAndDrawFrame(-1);
end;

procedure TfrmAVProbe.btnOpenClick(Sender: TObject);
var
  I: Integer;
begin
  // Load dynamic link libraries
  if not FAVProbe.AVLibLoaded then
  begin
    // TPathFileName = type WideString;
    // AVProbe.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 FAVProbe.LoadAVLib(ExtractFilePath(Application.ExeName) + CLibAVPath) then
    // the routine ExePath() is implemented in unit MyUtils which returns WideString type
    // of ExtractFilePath(Application.ExeName)
    if not FAVProbe.LoadAVLib(ExePath + CLibAVPath) then
    begin
      mmoLog.Lines.Add(FAVProbe.LastErrMsg);
      Exit;
    end;
  end;

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

  // clear frame view
  ClearFrameView;

  if not FAVProbe.LoadFile(OpenDialog1.FileName) then
  begin // load av file failed
    mmoLog.Lines.Add('');
    mmoLog.Lines.Add('***File load error: ' + FAVProbe.LastErrMsg);
    mmoLog.Lines.Add('');
    Exit;
  end;

  mmoLog.Lines.Add('***AVProbe.FileInfoText');
  mmoLog.Lines.Add(Trim(FAVProbe.FileInfoText));
  mmoLog.Lines.Add('');

  mmoLog.Lines.Add(Format('File Size: %d',[FAVProbe.FileSize]));
  with FAVProbe.FileStreamInfo do
  begin
    if Duration <> AV_NOPTS_VALUE then
      mmoLog.Lines.Add(Format('File Duration: %s', [DurationToStr(Duration)]))
    else
      mmoLog.Lines.Add('File Duration is not preseted');
  end;

  for I := 0 to FAVProbe.StreamCount - 1 do
  begin
    if FAVProbe.IsVideoStream(I) then
    begin
      mmoLog.Lines.Add(Format('Stream #%d: Video', [I]));
      with FAVProbe.VideoStreamInfos[I] do
      begin
        if Duration <> AV_NOPTS_VALUE then
          mmoLog.Lines.Add(Format('  Video Length: %s', [DurationToStr(DurationScaled)]))
        else
          mmoLog.Lines.Add('  Video Length is not preseted');
        mmoLog.Lines.Add(Format('  Video Frame Rate: %f', [FrameRate.num / FrameRate.den]));
        if BitRate > 0 then
          mmoLog.Lines.Add(Format('  Video Bit Rate: %d kb', [BitRate div 1000]))
        else
          mmoLog.Lines.Add('  Video Bit Rate is not preseted');
        mmoLog.Lines.Add(Format('  Frame size (width X height): %dx%d', [Width, Height]));
      end;
    end
    else if FAVProbe.IsAudioStream(I) then
    begin
      mmoLog.Lines.Add(Format('Stream #%d: Audio', [I]));
      with FAVProbe.AudioStreamInfos[I] do
      begin
        if Duration <> AV_NOPTS_VALUE then
          mmoLog.Lines.Add(Format('  Audio Length: %s', [DurationToStr(DurationScaled)]))
        else
          mmoLog.Lines.Add('  Audio Length is not preseted');
        mmoLog.Lines.Add(Format('  Audio Sample Rate: %d hz', [SampleRate]));
        if BitRate > 0 then
          mmoLog.Lines.Add(Format('  Audio Bit Rate: %d kb', [BitRate div 1000]))
        else
          mmoLog.Lines.Add('  Audio Bit Rate is not preseted');
      end;
    end;
  end;

  with FAVProbe do
  begin
    TrackBar1.Enabled := (FileStreamInfo.Duration <> AV_NOPTS_VALUE) and (FormatName <> 'image2') and
                         (VideoStreamCount > 0);

    if FileStreamInfo.Duration <> AV_NOPTS_VALUE then
      FDuration := FileStreamInfo.Duration;

    if (VideoStreamCount > 0) and (FirstVideoStreamInfo.FrameRate.den > 0) then
    begin
      if FirstVideoStreamInfo.DurationScaled > 0 then
        FFrames := Round(FirstVideoStreamInfo.DurationScaled / AV_TIME_BASE *
          FirstVideoStreamInfo.FrameRate.num / FirstVideoStreamInfo.FrameRate.den)
      else if FileStreamInfo.Duration <> AV_NOPTS_VALUE then
        FFrames := Round(FileStreamInfo.Duration / AV_TIME_BASE *
          FirstVideoStreamInfo.FrameRate.num / FirstVideoStreamInfo.FrameRate.den);
    end;
  end;

  if FAVProbe.VideoStreamCount > 0 then
    ReadAndDrawFrame(0);
  SetupTrackBar;
end;

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

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

procedure TfrmAVProbe.cboLogLevelChange(Sender: TObject);
begin
  FFLogger.LogLevel := TLogLevel(cboLogLevel.ItemIndex);
end;

procedure TfrmAVProbe.FFLoggerLog(Sender: TObject; AThreadID: Cardinal;
  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 AVProbe Demo
