视频批量去片头片尾小工具源码分享

视频批量去片头片尾小工具源码分享（基于FFmpeg视频流复制切割，快速无损）
开发环境Delphi2010，框架VGScene（新版本用FMX）
特点：直观的预览界面，秒级的微调定位，批量预设、单个微调，多任务线程，快速无损（FFmpeg）

视频批量去片头片尾小工具源码分享,演示视频

程序源码打包下载：https://download.csdn.net/download/u012762790/19595572

unit UnitMain;interfaceusesWindows, 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;typeTFormMain = 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);privateTaskBar: ETaskBar;{ Private declarations }publicprocedure AddVideo(FileName: TFileName);{ Public declarations }end;typeTVideoItem = class(TvgListBoxItem)privateiscut: Boolean;mTextTime, mTextInfo: TvgText;mImageBox: TvgHorzImageListBox;mButtonDel: TvgImage;procedure mDelClick(Sender: TObject);procedure mTuningOnclick(Sender: TObject);function GetVideoDuration(FileName: string): Int64;publicFilePath, 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;typeTImageItem = class(TvgListBoxItem)privateImagePath: string;ImageView: TvgImage;CutTime: Integer;VideoItem: TVideoItem;publicconstructor Create(VideoItem: TVideoItem; Remove: Boolean; CutTime: Integer); reintroduce;end;varFormMain: TFormMain;implementation{$R *.dfm}{ TImageItem }constructor TImageItem.Create(VideoItem: TVideoItem; Remove: Boolean; CutTime: Integer);
begininherited 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,procedurebeginif not FileExists(ImagePath) thentrySys.RunCommand('ffmpeg -ss ' + Str.SizeToTime(CutTime) + ' -i "' + VideoItem.FilePath + '" -y -vframes 1 ' + ImagePath);exceptend;end,procedurebeginif FileExists(ImagePath) and Assigned(ImageView) thentryImageView.Bitmap.LoadThumbnailFromFile(ImagePath, 80, 80);exceptend;end));
end;{ TVideoItem }constructor TVideoItem.Create(FilePath: string; CutHead: Boolean; CutTime: string);
vari: Integer;
begininherited 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 doTvgCircleButton(FindResource('time' + IntToStr(i))).OnClick := mTuningOnclick;Self.Parent := FormMain.VideoList;Self.iscut := False;ETaskManager.Singleton.AddTask(ETask.Create(FormMain,procedurebeginVideoDuration := GetVideoDuration(FilePath);Self.CutTime := iif(CutHead, CutTime, Str.SizeToTime(VideoDuration - Str.TimeToSize(CutTime)));end,procedurebeginmTextInfo.Text := '总时长: ' + Str.SizeToTime(VideoDuration);LoadImageThumbnail(Self.CutTime);end));
end;function TVideoItem.GetVideoDuration(FileName: string): Int64;
varcmdstring: string;
beginResult := 0;trycmdstring := Sys.RunCommand('ffmpeg -i "' + FileName + '"');Delete(cmdstring, 1, Pos('Duration: ', cmdstring) + 9);Result := Str.TimeToSize(Copy(cmdstring, 1, Pos('.', cmdstring) - 1));exceptend;
end;procedure TVideoItem.LoadImageThumbnail(Timestr: string);
vartimecenter, timeloop: Integer;
beginmImageBox.Clear;mTextTime.Text := Timestr;timecenter := Str.TimeToSize(Timestr);for timeloop := timecenter - 5 to timecenter + 5 doif (timeloop >= 0) and (timeloop <= VideoDuration) thenTImageItem.Create(Self, (CutHead and (timeloop < timecenter)) or (not CutHead and (timeloop > timecenter)), timeloop);
end;procedure TVideoItem.mTuningOnclick(Sender: TObject);
beginSelf.CutTime := Str.SizeToTime(Str.TimeToSize(CutTime) + StrToInt(TvgCircleButton(Sender).Hint));LoadImageThumbnail(Self.CutTime);
end;function TVideoItem.OutputFile(Infile: string): string;
beginResult := ExtractFilePath(Infile) + 'output\' + ExtractFileName(Infile);CreateDir(ExtractFileDir(Result));Api.DeleteFile(Result);
end;procedure TVideoItem.ThreadCutVideo(Sender: TObject);
beginETaskManager.Singleton.AddTask(ETask.Create(FormMain,procedurebegintryif CutHead thenSys.RunCommand('ffmpeg -ss ' + CutTime + ' -to ' + Str.SizeToTime(VideoDuration) + ' -i "' + FilePath + '" -c copy "' + OutputFile(FilePath) + '"')elseSys.RunCommand('ffmpeg -ss ' + Str.SizeToTime(0) + ' -to ' + CutTime + ' -i "' + FilePath + '" -c copy "' + OutputFile(FilePath) + '"');isCut := True;exceptend;end));
end;procedure TVideoItem.mDelClick(Sender: TObject);
beginSelf.Free;
end;destructor TVideoItem.Destroy;
beginif isCut thenbeginCreateDir(ExtractFilePath(FilePath) + 'oldput');Api.MoveFile(FilePath, ExtractFilePath(FilePath) + 'oldput\' + ExtractFileName(FilePath));end;Api.DeleteForever(TempPath);inherited Destroy;
end;procedure TFormMain.ActionBackwardExecute(Sender: TObject);
beginif Assigned(VideoList.Selected) thenTVideoItem(VideoList.Selected).mTuningOnclick(VideoList.Selected.FindResource('time3'));
end;procedure TFormMain.ActionDeleteExecute(Sender: TObject);
beginif Assigned(VideoList.Selected) thenVideoList.Selected.Free;
end;procedure TFormMain.ActionForwardExecute(Sender: TObject);
beginif Assigned(VideoList.Selected) thenTVideoItem(VideoList.Selected).mTuningOnclick(VideoList.Selected.FindResource('time4'));
end;procedure TFormMain.AddVideo(FileName: TFileName);
vari: Integer;
beginif Files.CheckExt(FileName, ['mp4', 'wmv', 'mpg', 'avi', 'rmvb', 'rm', 'ts', 'mpeg', '3gp', 'mov', 'flv', 'mkv', 'webm']) thenbeginfor i := 0 to VideoList.Count - 1 doif VideoList.Items[i].Text = FileName thenExit;TVideoItem.Create(FileName, ButtonHead.IsChecked, TextTime.Text);end;
end;procedure TFormMain.ButtonStartClick(Sender: TObject);
vari: Integer;
beginTaskBar.SetProgressFinish;for i := 0 to VideoList.Count - 1 doTVideoItem(VideoList.Items[i]).ThreadCutVideo(Sender);
end;procedure TFormMain.ButtonAddClick(Sender: TObject);
vartsl: TStrings;i: Integer;
begintsl := Dialog.OpenFilesDialog(['mp4', 'wmv', 'mpg', 'avi', 'rmvb', 'rm', 'ts', 'mpeg', '3gp', 'mov', 'flv', 'mkv', 'webm'], '视频文件');for i := 0 to tsl.Count - 1 doAddVideo(tsl[i]);tsl.Free;
end;procedure TFormMain.ButtonAddDragDrop(Sender: TObject; const Data: TvgDragObject; const Point: TvgPoint);
vari: Integer;
beginfor i := 0 to Length(Data.Files) - 1 doAddVideo(Data.Files[i]);
end;procedure TFormMain.ButtonAddDragOver(Sender: TObject; const Data: TvgDragObject; const Point: TvgPoint; var Accept: Boolean);
beginAccept := True;
end;procedure TFormMain.ButtonClearClick(Sender: TObject);
beginVideoList.Clear;
end;procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
beginReg.WriteString(HKEY_CURRENT_USER, 'Software\' + FormMain.Caption, 'time', TextTime.Text);
end;procedure TFormMain.TaskProgress(Sender: TObject; Progress: Single);
beginTaskBar.SetProgressValue(Round(Progress * 100), 100);
end;procedure TFormMain.FormCreate(Sender: TObject);
beginFormMain.Caption := FormMain.Caption + ' by：https://blog.csdn.net/u012762790';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);
beginETaskManager.UnInit(Self);
end;end.

视频批量去片头片尾小工具源码分享相关推荐

小程序祝福小工具源码分享
2019.小程序的市场依旧是那么火爆...... 所在我在这里,想给大家分享一套关于送祝福的工具类的小程序源码.这不马上元旦.除夕夜等等一系列节日了,我们大家送给亲朋好友的祝福肯定是不能少的,那么我们 ...
自媒体软件批量去水印批量加减速度批量去片头片尾智能测量水印
自媒体软件批量去水印批量加减速度批量去片头片尾智能测量水印在这里插入图片描述重点是,自媒体软件是完全免费的,可以随时批量化使用,让你事半功倍
MFC自用小工具源码
效果:快速打开计算机内常用的软件,功能,设置 // 自用小工具Dlg.cpp : 实现文件 // #include "stdafx.h" #include "自用小工具. ...
2023 易语言查看系统信息小工具源码
使用精易模块,调用电脑自带的系统信息,一次性查询,做电脑店的可以拿去用,看配件很方便 2023 易语言查看系统信息小工具源码
短视频去水印多功能工具箱微信小程序源码下载支持多种流量主
没错这是一款以去水印为主的一款多功能微信小程序源码该小程序源码除了拥有去水印功能以外还拥有N款其它实用的功能比如喝酒神器,短网址生成,历史上的今天等等如下: 短视频去水印(自带接口,速度非常快) ...
2022冬-DownKyi 辅助使用的小插件源码分享
DownKyi 辅助使用的小插件源码分享 DownKyi 是一款非常好用的b站下载软件,可以实现b站视频批量下载. 但是在大量下载后会产生缓存没有及时清理,自己写了个小插件,放在运行程序的文件夹下, ...
【小程序源码】王者战力查询改名工具箱微信小程序源码分享下载，战力查询小程序
介绍今天分享一款战力查询小程序源码, 微端Q苹卓四端战力查询带改名工具,空白名.重复名.符号名改名小程序源码界面精美,无需服务器后台. 至于更多,就大家自行研究咯! 小编测试演示图小程序源码下 ...
贪吃蛇小游戏源码分享
创建2个文件夹,一个是放源码还有一个文件夹是发图片的. 然后创建三个实体类. package com.Bubbles.snake; import javax.swing.*; import java. ...
【源码分享】一键打开禅意生活——电子木鱼微信小程序源码分享
为大家推荐一个在线的AI聊天:魔术AI-8080n点cn界面简洁精美,免费点开即用在快节奏的现代生活中,我们需要一种方式来减轻压力和焦虑,让我们的身心得到放松和平静.电子木鱼微信小程序是一款专门为人 ...

视频批量去片头片尾小工具源码分享

视频批量去片头片尾小工具源码分享相关推荐

最新文章

热门文章