[技术交流] 视频批量去片头片尾小工具源码分享

unit UnitMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  ExtClass, ExtWindows, Dialogs, StdCtrls, ExtCtrls, ComCtrls, vg_controls,
  vg_listbox, vg_scene, vg_objects, vg_layouts, vg_textbox, ActnList;

type
  TFormMain = class(TForm)
    vgScene: TvgScene;
    RootBackground: TvgBackground;
    VideoList: TvgListBox;
    Resources: TvgResources;
    LayoutSetting: TvgRectangle;
    ButtonClear: TvgBitmapButton;
    ButtonStart: TvgBitmapButton;
    ButtonAdd: TvgBitmapButton;
    ButtonHead: TvgRadioButton;
    ButtonFoot: TvgRadioButton;
    TextTime: TvgTextBox;
    ActionList: TActionList;
    ActionDelete: TAction;
    ActionForward: TAction;
    ActionBackward: TAction;
    procedure FormCreate(Sender: TObject);
    procedure TaskProgress(Sender: TObject; Progress: Single);
    procedure ButtonStartClick(Sender: TObject);
    procedure ButtonClearClick(Sender: TObject);
    procedure ButtonAddClick(Sender: TObject);
    procedure ButtonAddDragOver(Sender: TObject; const Data: TvgDragObject; const Point: TvgPoint; var Accept: Boolean);
    procedure ButtonAddDragDrop(Sender: TObject; const Data: TvgDragObject; const Point: TvgPoint);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ActionDeleteExecute(Sender: TObject);
    procedure ActionForwardExecute(Sender: TObject);
    procedure ActionBackwardExecute(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    TaskBar: ETaskBar;
    { Private declarations }
  public
    procedure AddVideo(FileName: TFileName);
    { Public declarations }
  end;

type
  TVideoItem = class(TvgListBoxItem)
  private
    iscut: Boolean;
    mTextTime, mTextInfo: TvgText;
    mImageBox: TvgHorzImageListBox;
    mButtonDel: TvgImage;
    procedure mDelClick(Sender: TObject);
    procedure mTuningOnclick(Sender: TObject);
    function GetVideoDuration(FileName: string): Int64;
  public
    FilePath, TempPath: string;
    VideoDuration: Int64;
    CutHead: Boolean;
    CutTime: string;
    constructor Create(FilePath: string; CutHead: Boolean; CutTime: string); reintroduce;
    destructor Destroy; override;
    function OutputFile(Infile: string): string;
    procedure LoadImageThumbnail(Timestr: string);
    procedure ThreadCutVideo(Sender: TObject);
  end;

type
  TImageItem = class(TvgListBoxItem)
  private
    ImagePath: string;
    ImageView: TvgImage;
    CutTime: Integer;
    VideoItem: TVideoItem;
  public
    constructor Create(VideoItem: TVideoItem; Remove: Boolean; CutTime: Integer); reintroduce;
  end;

var
  FormMain: TFormMain;

implementation

{$R *.dfm}

{ TImageItem }

constructor TImageItem.Create(VideoItem: TVideoItem; Remove: Boolean; CutTime: Integer);
begin
  inherited Create(nil);
  Self.VideoItem := VideoItem;
  Self.CutTime := CutTime;
  Resource := 'MyImageStyle';
  DragDisableHighlight := True;
  TvgRectangle(FindResource('back')).Fill.Color := iif(Remove, '#33FD0000', '#3300D851');
  ImageView := TvgImage(FindResource('image'));
  Parent := VideoItem.mImageBox;
  ImagePath := VideoItem.TempPath + '\' + IntToStr(CutTime) + '.jpg';
  ETaskManager.Singleton.AddTask(ETask.Create(FormMain,
    procedure
    begin
      if not FileExists(ImagePath) then
      try
        Sys.RunCommand('ffmpeg -ss ' + Str.SizeToTime(CutTime) + ' -i "' + VideoItem.FilePath + '" -y -vframes 1 ' + ImagePath);
      except
      end;
    end,
    procedure
    begin
      if FileExists(ImagePath) and Assigned(ImageView) then
      try
        ImageView.Bitmap.LoadThumbnailFromFile(ImagePath, 80, 80);
      except
      end;
    end));
end;

{ TVideoItem }

constructor TVideoItem.Create(FilePath: string; CutHead: Boolean; CutTime: string);
var
  i: Integer;
begin
  inherited Create(nil);
  Self.Font.Family := '微软雅黑';
  Self.Font.Size := 12;
  Self.Resource := 'MyItemStyle';
  Self.DragDisableHighlight := True;
  Self.FilePath := FilePath;
  Self.Text := FilePath;
  TempPath := Path.Create(Path.Temp + Md5.FromStr(FilePath));
  Self.CutHead := CutHead;
  mImageBox := TvgHorzImageListBox(FindResource('box'));
  mButtonDel := TvgImage(FindResource('del'));
  mButtonDel.OnClick := mDelClick;
  mTextInfo := TvgText(FindResource('info'));

  mTextTime := TvgText(FindResource('time'));
  for i := 1 to 6 do
    TvgCircleButton(FindResource('time' + IntToStr(i))).OnClick := mTuningOnclick;

  Self.Parent := FormMain.VideoList;
  Self.iscut := False;

  ETaskManager.Singleton.AddTask(ETask.Create(FormMain,
    procedure
    begin
      VideoDuration := GetVideoDuration(FilePath);
      Self.CutTime := iif(CutHead, CutTime, Str.SizeToTime(VideoDuration - Str.TimeToSize(CutTime)));
    end,
    procedure
    begin
      mTextInfo.Text := '总时长: ' + Str.SizeToTime(VideoDuration);
      LoadImageThumbnail(Self.CutTime);
    end));
end;

function TVideoItem.GetVideoDuration(FileName: string): Int64;
var
  cmdstring: string;
begin
  Result := 0;
  try
    cmdstring := Sys.RunCommand('ffmpeg -i "' + FileName + '"');
    Delete(cmdstring, 1, Pos('Duration: ', cmdstring) + 9);
    Result := Str.TimeToSize(Copy(cmdstring, 1, Pos('.', cmdstring) - 1));
  except
  end;
end;

procedure TVideoItem.LoadImageThumbnail(Timestr: string);
var
  timecenter, timeloop: Integer;
begin
  mImageBox.Clear;
  mTextTime.Text := Timestr;
  timecenter := Str.TimeToSize(Timestr);
  for timeloop := timecenter - 5 to timecenter + 5 do
    if (timeloop >= 0) and (timeloop <= VideoDuration) then
      TImageItem.Create(Self, (CutHead and (timeloop < timecenter)) or (not CutHead and (timeloop > timecenter)), timeloop);
end;

procedure TVideoItem.mTuningOnclick(Sender: TObject);
begin
  Self.CutTime := Str.SizeToTime(Str.TimeToSize(CutTime) + StrToInt(TvgCircleButton(Sender).Hint));
  LoadImageThumbnail(Self.CutTime);
end;

function TVideoItem.OutputFile(Infile: string): string;
begin
  Result := ExtractFilePath(Infile) + 'output\' + ExtractFileName(Infile);
  CreateDir(ExtractFileDir(Result));
  Api.DeleteFile(Result);
end;

procedure TVideoItem.ThreadCutVideo(Sender: TObject);
begin
  ETaskManager.Singleton.AddTask(ETask.Create(FormMain,
    procedure
    begin
      try
        if CutHead then
          Sys.RunCommand('ffmpeg -ss ' + CutTime + ' -to ' + Str.SizeToTime(VideoDuration) + ' -i "' + FilePath + '" -c copy "' + OutputFile(FilePath) + '"')
        else
          Sys.RunCommand('ffmpeg -ss ' + Str.SizeToTime(0) + ' -to ' + CutTime + ' -i "' + FilePath + '" -c copy "' + OutputFile(FilePath) + '"');
        isCut := True;
      except
      end;
    end));
end;

procedure TVideoItem.mDelClick(Sender: TObject);
begin
  Self.Free;
end;

destructor TVideoItem.Destroy;
begin
  if isCut then
  begin
    CreateDir(ExtractFilePath(FilePath) + 'oldput');
    Api.MoveFile(FilePath, ExtractFilePath(FilePath) + 'oldput\' + ExtractFileName(FilePath));
  end;
  Api.DeleteForever(TempPath);
  inherited Destroy;
end;

procedure TFormMain.ActionBackwardExecute(Sender: TObject);
begin
  if Assigned(VideoList.Selected) then
    TVideoItem(VideoList.Selected).mTuningOnclick(VideoList.Selected.FindResource('time3'));
end;

procedure TFormMain.ActionDeleteExecute(Sender: TObject);
begin
  if Assigned(VideoList.Selected) then
    VideoList.Selected.Free;
end;

procedure TFormMain.ActionForwardExecute(Sender: TObject);
begin
  if Assigned(VideoList.Selected) then
    TVideoItem(VideoList.Selected).mTuningOnclick(VideoList.Selected.FindResource('time4'));
end;

procedure TFormMain.AddVideo(FileName: TFileName);
var
  i: Integer;
begin
  if Files.CheckExt(FileName, ['mp4', 'wmv', 'mpg', 'avi', 'rmvb', 'rm', 'ts', 'mpeg', '3gp', 'mov', 'flv', 'mkv', 'webm']) then
  begin
    for i := 0 to VideoList.Count - 1 do
      if VideoList.Items[i].Text = FileName then
        Exit;
    TVideoItem.Create(FileName, ButtonHead.IsChecked, TextTime.Text);
  end;
end;

procedure TFormMain.ButtonStartClick(Sender: TObject);
var
  i: Integer;
begin
  TaskBar.SetProgressFinish;
  for i := 0 to VideoList.Count - 1 do
    TVideoItem(VideoList.Items[i]).ThreadCutVideo(Sender);
end;

procedure TFormMain.ButtonAddClick(Sender: TObject);
var
  tsl: TStrings;
  i: Integer;
begin
  tsl := Dialog.OpenFilesDialog(['mp4', 'wmv', 'mpg', 'avi', 'rmvb', 'rm', 'ts', 'mpeg', '3gp', 'mov', 'flv', 'mkv', 'webm'], '视频文件');
  for i := 0 to tsl.Count - 1 do
    AddVideo(tsl[i]);
  tsl.Free;
end;

procedure TFormMain.ButtonAddDragDrop(Sender: TObject; const Data: TvgDragObject; const Point: TvgPoint);
var
  i: Integer;
begin
  for i := 0 to Length(Data.Files) - 1 do
    AddVideo(Data.Files[i]);
end;

procedure TFormMain.ButtonAddDragOver(Sender: TObject; const Data: TvgDragObject; const Point: TvgPoint; var Accept: Boolean);
begin
  Accept := True;
end;

procedure TFormMain.ButtonClearClick(Sender: TObject);
begin
  VideoList.Clear;
end;

procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Reg.WriteString(HKEY_CURRENT_USER, 'Software\' + FormMain.Caption, 'time', TextTime.Text);
end;

procedure TFormMain.TaskProgress(Sender: TObject; Progress: Single);
begin
  TaskBar.SetProgressValue(Round(Progress * 100), 100);
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  FormMain.Caption := FormMain.Caption + ' by：[url]http://www.dupinsoft.com/thread-28.html';[/url]
  TextTime.Text := Reg.ReadString(HKEY_CURRENT_USER, 'Software\' + FormMain.Caption, 'time', '00:00:05');
  TaskBar := ETaskBar.Create(FormMain.Handle);
  ETaskManager.Init(Self, 20, TaskProgress);
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
  ETaskManager.UnInit(Self);
end;

end.