用 Delphi 7 实现基于 FFMS2 的视频转 GIF 工具 [原创]

儿子经常要把自拍的视频（ts格式）转成表情包，下载了几个工具都不大好用，更多的还要收费。那就想自己写一个吧，没想到这一下断断续续地，居然 3 个月过去了。现在总算弄出个作品来了，结个贴吧。唉，天资愚钝啊！

基本需求

1. 能解码绝大部分视频格式；
2. 能逐帧查看视频画面，并选择视频片段；
3. 能框选画面中的某个区域；
4. 对选中的视频片段、区域截图，生成 GIF 图片；
5. GIF 图片能预览和保存为文件。

设计思路

界面

界面由 3 部分组成，自上而下分别是：视频播放区（TPanel）、控制区（TTrackBar + TSpeedButton） 、GIF 播放区（TImage + TMaskEdit）。

视频播放区

本工具并非视频播放软件，直接用 TImage 的 TCanvas 来显示视频帧画面，也没什么太大关系，卡不卡无关紧要。为了最大程度降低播放时的资源占用率，还是没有采用这种最简单的方案。也曾研究了一周 DirectX 或 SDL，性能是最佳，但没啥必要。最终选择了折衷的方案，直接用 Windows API DrawDibDraw 在 TPanel 上绘制。可参阅本人的另一篇文章对StretchBlt、StretchDIBits、DrawDibDraw 的性能测试。

但是在选取画面区域时，还是出现了问题。因为自己编写的 RectTracker，依赖于控件自身 Canvas 的重绘，所以会把视频播放 TPanel 上已绘制的画面给抹了。简化起见，放弃了对视频播放 TPanel 的重绘控制，而是在 TPanel 上叠加了一个 TImage，专门用于显示 RectTracker。反正在连续播放视频时，不需要显示画面选择框，逐帧步进时，多画一个 TImage 也无伤大雅。这也在播放性能和画面绘制取得了一点平衡。关于自制 RectTracker，可参阅本人的另一篇文章Delphi 中的 RectTracker。

控制区

视频播放的进度控制和按钮区，主要实现视频逐帧播放、截图、GIF 生成和保存等功能。

GIF 播放区

利用 GifImage 控件实现 GIF 生成、TImage 中播放、文件保存等功能。

主程序

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComCtrls,Buttons, Mask, Menus,
  ffmpeg, MMTimer, GifImage, DXRectTracker, DXTrackBar,
  progress, about;

const
  EXENAME = 'DJ''s V2G';

type
  TMainForm = class(TForm)
    dlgOpenFile: TOpenDialog; 
    panControl: TPanel;
    btnLeft: TSpeedButton;          // 后退一帧按钮
    btnRight: TSpeedButton;        // 前进一帧按钮
    btnPlay: TSpeedButton;         // 播放按钮
    popMenuTrackbar: TPopupMenu;        // 进度控制条的右键菜单
    menuSetStart: TMenuItem;        // 进度控制条的右键菜单项，标记 GIF 截频的起始帧
    menuSetEnd: TMenuItem;         //  进度控制条的右键菜单项，标记 GIF 截频的结束帧
    btnOpenFile: TSpeedButton;     // 打开文件按钮
    btnSetStart: TSpeedButton;       // 标记 GIF 截频的起始帧按钮
    btnSetEnd: TSpeedButton;        // 标记 GIF 截频的结束帧按钮
    txtTime: TMaskEdit;                   // 显示当前播放时间（这里不妨可以实现按时间跳转）
    btnPause: TSpeedButton;         // 暂停播放按钮
    btnToGif: TSpeedButton;           // 将当前截取的画面转换为 GIF
    panGif: TPanel;                        
    Label1: TLabel;
    Label2: TLabel;
    dlgSaveFile: TSaveDialog;
    Label3: TLabel;
    txtGifFPS: TMaskEdit;            // 显示/设置 GIF 的显示速度（每秒帧数）
    txtGIFWidth: TMaskEdit;        // 显示/设置 GIF 的宽度
    txtGIFHeight: TMaskEdit;       // 显示/设置 GIF 的高度
    panPlayer: TPanel;                // 视频播放区域
    Trackbar: TDXTrackBar;        // 视频播放进度控制条（自定义控件）
    Panel1: TPanel;
    imgGif: TImage;                    // GIF 显示控件
    btnSave: TSpeedButton;       // GIF 保存按钮
    btnPlayAt: TSpeedButton;     // 播放已截取片段视频
    MainMenu: TPopupMenu;
    MenuAbout: TMenuItem;
    procedure btnOpenFileClick(Sender: TObject);
    procedure btnPlayClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure TrackBarMouseUp(Sender: TObject; Button: TMouseButton;
                              Shift: TShiftState; X, Y: Integer);            // 
    procedure TrackBarKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);                    // 
    procedure btnLeftClick(Sender: TObject);
    procedure btnRightClick(Sender: TObject);
    procedure menuSetStartClick(Sender: TObject);
    procedure menuSetEndClick(Sender: TObject);
    procedure btnPauseClick(Sender: TObject);
    procedure btnToGifClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure btnPlayGifClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure txtGIFHeightChange(Sender: TObject);
    procedure txtGIFWidthChange(Sender: TObject);
    procedure btnPlayAtClick(Sender: TObject);
    procedure FormContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
  private
    { Private declarations }
    FCanSetPosition:boolean;        // 标志可否设置进度条的位置，因为 Trackbar 的事件有限，只好用该标志同步，保证能同时实现进度控制和显示。
    FSelectionMessage:string;       // 当前选中时段的文字信息，暂时未用上

    procedure CheckGifSize;         // 根据视频区的选框自动设置 GIF 的大小
    procedure CheckSize;              // 根据视频的长宽比、窗口大小自动设置三大区域的大小
    procedure ShowSelection;       // 显示视频区中的选框
    procedure OnFileLoaded(Sender:TObject);            // TFFMpegPlayer 视频文件加载完毕的回调事件
    procedure OnPlayerRefreshed(Sender:TObject);   // TFFMpegPlayer 画面更新后的回调事件
    procedure OnPlayerPaused(Sender:TObject);        // TFFMpegPlayer 暂停播放后的回调事件
    procedure OnPlayerError(Sender:TObject);            // TFFMpegPlayer 出错后的回调事件
    procedure OnPlayerStartIndex(Sender:TObject; ExpectedCount: integer);    // TFFMpegPlayer 开始创建帧索引后的回调事件，暂时未用
    procedure OnPlayerEndIndex(Sender:TObject);        // TFFMpegPlayer 帧索引建立完成之后的回调事件，暂时未用
    procedure OnPlayerIndexChanged(Sender:TObject; index: integer);        // 暂时未用
    procedure OnPlayerSelectionResize(Sender:TObject);        // 视频区的选框调整回调事件
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;
  Player: TFFMpegPlayer;        // 视频解码、播放、截图控件（自定义控件）

其中，FFMpegPlayer、DXRectTracker、DXTrackBar 控件均为自定义控件，分别实现了视频播放、屏幕选框、进度控制条功能。MMTimer 控件则为精确计时器，用于精确控制播放时间。GifImage 则对 TImage 进行了扩展，实现了 GIF 图片的显示、创建和保存功能。

视频播放

视频播放器是个很大的话题，有些还得支持网络流读取。实现音视频的同步也有很多种方法，比如 AegiSub 是以物理时间为基础的，全都以当前时间作为控制参照。有兴趣的，或者也可以去看看 FFMPEG 官方的 FFPlayer 实现。

本程序不需要处理音频信息，播放视频本也不是主要功能，所以能省则省，简而化之。思路大致如下，详见 TFFMpegPlayer 的源码：

• 播放采用单独的工作线程（TPlaybackThread）；
• 工作线程唤醒后只向前读取并播放一帧，然后挂起；
• 精确计时器（FTimer）负责唤醒播放工作线程，时间间隔由视频文件 FPS 而定；
• 开始播放、停止播放的动作，只需要启用、禁用计时器即可；
• 用变量记录当前帧号、结束帧号，播放均以帧号为基础，不以时间戳为基础；

这里会有一个问题，读取并播放一帧的时间必须得小于 1/FPS 才行。如果视频分辨率很高（比如 4K）、CPU 不够快，视频看起来就是慢动作。这对于播放器程序而言是致命的，但对于本程序却无关紧要。当读取/解压速度固定时，只能提高播放速度了，换用 DirectX 或 OpenGL（SDL）吧。

画面框选

C 里有个 CRectTracker 控件，可以直接拿来用。可是 Delphi 里居然没有这个控件，只好自己写一个了。详见 Delphi 中的 RectTracker。因为要用 Canvas 绘制界面，所以继承的是 TGraphicControl。

进度控制条

Delphi 的 TTrackBar 是没法响应鼠标动作的，也就是说无法合理控制进度条。又只好自己动手了。原理可参阅带OnMouseUp、OnMouseDown、OnMouseMove事件的TrackBar控件。

因为是可视化控件，为了方便布局，还是得先安装一下才好用。不然打开项目会报错。

关于视频解码库

FFMPEG 陡峭的学习曲线

当然 FFMPG 是不二之选了，但实在是难啃啊。前后花了近 1 个月，还没摸到啥门道，一直是“按了葫芦起了瓢”的状态。其实也不能怪 FFMPEG，谁让视频格式那么庞杂无序，光一个 PTS 就没啥标准可统，基本就是靠猜！对于逐帧定位并播放的需求，用 FFMPEG 实现真是太过“谋乱”了。

虽然最终放弃了直接调用 FFMEPG 库，但这 1 个月也不算是白花，摸索 FFMPEG 的使用过程，也就是了解视频格式及播放原理的过程。由于 FFMPEG 没有什么好文档，各版本之间的差异也很大，一切尽在代码注释中。

建议不管出于什么目的，要了解 FFMPEG，请务必：

• 下个 FFMPEG源码；
• 装个 Visual Studio 2015。

然后，你就可以利用微软宇宙无敌的编辑器，方便地查看源码了，比千辛万苦在网上搜要强多了，至少我就是这么干的。

FFMPEG 的开发库还是在 zeranoe下载吧，想在 Windows 下自己编译还是有相当难度的，我是没这个时间去搞了。

FFMPEG 的学习资源

雷神的帖子必须读！虽然有几篇是翻老外的，但大都是通俗易懂啊。都不长，请全读一遍，下载源码编译运行一下就能明白。我一开始主要参考的是最简单的基于FFMPEG+SDL的视频播放器 ver2 。可惜仙人已逝，看来天堂也缺视频处理的程序员啊！

此外，我还读了一些 FFMPEG 的文章，有用的大概有：

• FFMPEG 如何提取码流的基本信息
• How to Write a Video Player in Less Than 1000 Lines
• H264编码原理以及I帧B帧P帧
• ffmpeg time_base详解
• FFmpeg解码流程

强大的 FFMS2

因为在字幕组用的是 AegiSub，所以就很好奇，它到底用了什么招让视频能逐帧播放呢？虽然编译 dll 死活没成功，但用 Visual Studio 2015 查看源码还是挺方便的。原来 AegiSub 用的就是 FFMS2，于是就一头栽进 FFMS2 去泡着了。我对 FFMS2 的官方说明 做了翻译。

FFMS2 并没有将所有 FFMPEG 的源码都包含进来，只是选取了解码这部分，所以 dll 比完整的 FFMPEG 小多了，大约只有一半大小，这个适合我。

为了精确读取每一帧，FFMS2 必须先对视频、音频进行索引。如果视频文件很大，这个过程就很耗时，这里未及处理，程序会假死。倒是有个 API 可以设置显示进度的回调函数（FFMS_SetProgressCallback），可那是给 C 用的，不知 Delphi 能否成功，期待有高手解决。

在 Delphi 中调用 FFMS2.dll，得注意参数的声明，详见 LibFFMS2.pas。详情可参阅 cdecl、stdcall、fastcall、declspec 的用法和区别。

结束语

虽然有了这么个半成品，但有待完善的地方太多了，比如对耗时较多的步骤没有进度显示（程序假死）、某些视频格式（关键帧较少）无法正确逐帧截图。权当抛砖引玉吧。

源码
可执行文件
FFMS2 库
FFMS2 源码 及 我的译文
FFMS2 API文档 及 我的译文
FFMPEG 源码 及 开发库