视频批量去片头片尾小工具源码分享(基于FFmpeg视频流复制切割,快速无损)
开发环境Delphi2010,框架VGScene(新版本用FMX)
特点:直观的预览界面,秒级的微调定位,批量预设、单个微调,多任务线程,快速无损(FFmpeg)
[Delphi] 纯文本查看 复制代码
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.