Imports System.Drawing.Imaging Imports System.Text Imports Microsoft.VisualBasic.FileIO Imports StaxRip.UI Public Class VideoComparisonForm Shared Property Pos As Integer Shared Property TabBackColor As ColorHSL Private ShowMessageSavedPngs As Boolean = True Public CropLeft, CropTop, CropRight, CropBottom As Integer Shadows Menu As ContextMenuStripEx Sub New() InitializeComponent() RestoreClientSize(53, 36) Dim enabledFunc = Function() TabControl.SelectedTab IsNot Nothing Menu = New ContextMenuStripEx With { .Form = Me } AllowDrop = True KeyPreview = True bnMenu.ContextMenuStrip = Menu bnMenu.TabStop = False TabControl.AllowDrop = True TabControl.ContextMenuStrip = Menu TabControl.ShowToolTips = True TrackBar.NoMouseWheelEvent = True tlpMain.AllowDrop = True Menu.Add("Add files to compare...", AddressOf Add, Keys.O, "Video files to compare, the file browser has multiselect enabled.") Menu.Add("Close selected tab", AddressOf Remove, Keys.Delete, enabledFunc) Menu.Add("Select next tab", AddressOf NextTab, Keys.Space, enabledFunc) Menu.Add("Save PNGs at current position", AddressOf Save, Keys.S, enabledFunc, "Saves a PNG image for every file/tab at the current position in the directory of the source file.") Menu.Add("Crop and Zoom...", AddressOf CropZoom, Keys.C) Menu.Add("Go To Frame...", AddressOf GoToFrame, Keys.F, enabledFunc) Menu.Add("Go To Time...", AddressOf GoToTime, Keys.T, enabledFunc) Menu.Add("Navigate | 1 frame backward", Sub() TrackBar.Value -= 1, Keys.Left, enabledFunc) Menu.Add("Navigate | 1 frame forward", Sub() TrackBar.Value += 1, Keys.Right, enabledFunc) Menu.Add("Navigate | 100 frame backward", Sub() TrackBar.Value -= 100, Keys.Left Or Keys.Control, enabledFunc) Menu.Add("Navigate | 100 frame forward", Sub() TrackBar.Value += 100, Keys.Right Or Keys.Control, enabledFunc) Menu.Add("Reload all tabs", AddressOf Reload, Keys.R, enabledFunc) Menu.Add("Help", AddressOf Help, Keys.F1) Menu.ApplyMarginFix() AddHandler tlpMain.DragOver, AddressOf TabControlOnDragOver AddHandler tlpMain.DragDrop, AddressOf TabControlOnDragDrop AddHandler TabControl.DragOver, AddressOf TabControlOnDragOver AddHandler TabControl.DragDrop, AddressOf TabControlOnDragDrop AddHandler TabControl.Selected, AddressOf TabControlOnSelected ApplyTheme() AddHandler ThemeManager.CurrentThemeChanged, AddressOf OnThemeChanged End Sub Protected Overrides Sub Dispose(disposing As Boolean) RemoveHandler ThemeManager.CurrentThemeChanged, AddressOf OnThemeChanged components?.Dispose() MyBase.Dispose(disposing) End Sub Sub OnThemeChanged(theme As Theme) ApplyTheme(theme) End Sub Sub ApplyTheme() ApplyTheme(ThemeManager.CurrentTheme) End Sub Sub ApplyTheme(theme As Theme) If DesignHelp.IsDesignMode Then Exit Sub End If BackColor = theme.VideoComparisonForm.BackColor TabBackColor = theme.VideoComparisonForm.TabBackColor End Sub Protected Overrides Sub OnDragEnter(e As DragEventArgs) MyBase.OnDragEnter(e) Dim files = TryCast(e.Data.GetData(DataFormats.FileDrop), String()) If Not files.NothingOrEmpty Then e.Effect = DragDropEffects.Copy End If End Sub Protected Overrides Sub OnDragDrop(e As DragEventArgs) MyBase.OnDragDrop(e) Dim files = TryCast(e.Data.GetData(DataFormats.FileDrop), String()) If Not files.NothingOrEmpty Then BeginInvoke(Sub() Add(files)) End If End Sub Sub TabControlOnDragOver(sender As Object, e As DragEventArgs) Dim files = TryCast(e.Data.GetData(DataFormats.FileDrop), String()) If Not files.NothingOrEmpty Then e.Effect = DragDropEffects.Copy End If End Sub Sub TabControlOnDragDrop(sender As Object, e As DragEventArgs) Dim files = TryCast(e.Data.GetData(DataFormats.FileDrop), String()) If Not files.NothingOrEmpty Then BeginInvoke(Sub() Add(files)) End If End Sub Sub TabControlOnSelected(sender As Object, e As TabControlEventArgs) Dim tab = DirectCast(e.TabPage, VideoTab) If tab IsNot Nothing laFilePath.Text = tab.SourceFilePath End If End Sub Sub Add() If Not Package.AviSynth.VerifyOK(True) Then Exit Sub Dim sourcePath = p.SourceFile Dim sourceAlreadyOpen = If(TabControl.TabPages.Cast(Of VideoTab)?.Where(Function(x) x.SourceFilePath.Equals(sourcePath, StringComparison.InvariantCultureIgnoreCase))?.Any(), False) If Not sourceAlreadyOpen AndAlso File.Exists(sourcePath) Then Add(sourcePath) If File.Exists(p.TargetFile) Then Add(p.TargetFile) Else Using dialog As New OpenFileDialog dialog.SetFilter(FileTypes.VideoComparisonInput) dialog.Multiselect = True dialog.SetInitDir(s.Storage.GetString("video comparison folder")) If dialog.ShowDialog() = DialogResult.OK Then s.Storage.SetString("video comparison folder", dialog.FileName.Dir) Add(dialog.FileNames) End If End Using End If End Sub Sub Add(sourcePath As String) Dim tab = New VideoTab With { .AllowDrop = True, .Form = Me, .BackColor = TabBackColor, .ToolTipText = sourcePath } tab.VideoPanel.ContextMenuStrip = TabControl.ContextMenuStrip If tab.Open(sourcePath) Then TabControl.TabPages.Add(tab) AddHandler tab.DragOver, AddressOf TabControlOnDragOver AddHandler tab.DragDrop, AddressOf TabControlOnDragDrop Dim page = DirectCast(TabControl.SelectedTab, VideoTab) page.DoLayout() page.TrackBarValueChanged() Else tab.Dispose() End If Dim vt = DirectCast(TabControl.SelectedTab, VideoTab) laFilePath.Text = vt?.SourceFilePath End Sub Sub Add(sourcePaths As String()) For Each path In sourcePaths If File.Exists(path) Then Add(path) End If Next End Sub Sub Remove() If TabControl.SelectedTab IsNot Nothing Then Dim tab = TabControl.SelectedTab TabControl.TabPages.Remove(tab) tab.Dispose() End If End Sub Sub Save() For Each tab As VideoTab In TabControl.TabPages Dim outputPath = "" Select Case s.SaveImageVideoComparisonFrameNumberPosition Case ImageFrameNumberPosition.Prefix outputPath = Path.Combine(tab.SourceFilePath.Dir, $"{Pos:00000}_{tab.SourceFilePath.Base}.png") Case ImageFrameNumberPosition.Suffix outputPath = Path.Combine(tab.SourceFilePath.Dir, $"{tab.SourceFilePath.Base}_{Pos:00000}.png") Case Else Throw New NotSupportedException("VideoComparisonForm.Save()") End Select Using bmp = tab.GetBitmap bmp.Save(outputPath, ImageFormat.Png) End Using Next If ShowMessageSavedPngs Then Using td As New TaskDialog(Of String) td.Title = "Images were saved in the source file directory." td.AddCommand("OK") td.AddCommand("Dismiss this message for this session", "Dismiss") Select Case td.Show Case "OK" Case "Dismiss" ShowMessageSavedPngs = False End Select End Using End If End Sub Sub TrackBar_ValueChanged(sender As Object, e As EventArgs) Handles TrackBar.ValueChanged TrackBarValueChanged() End Sub Sub TrackBarValueChanged() If TabControl.TabPages.Count > 0 Then DirectCast(TabControl.SelectedTab, VideoTab).TrackBarValueChanged() End If End Sub Sub Help() Dim form As New HelpForm() form.Doc.WriteStart(Text) form.Doc.WriteParagraph("In the statistic tab of the x265 dialog select Log Level Frame and enable CSV log file creation, the video comparison tool can displays containing frame info.") form.Doc.WriteTips(Menu.GetTips) form.Doc.WriteTable("Shortcut Keys", Menu.GetKeys, False) form.Show() End Sub Sub NextTab() Dim index = TabControl.SelectedIndex + 1 If index >= TabControl.TabPages.Count Then index = 0 End If If index <> TabControl.SelectedIndex Then TabControl.SelectedIndex = index End If End Sub Sub Reload() For Each tab As VideoTab In TabControl.TabPages tab.Reload() Next End Sub Protected Overrides Sub OnMouseWheel(e As MouseEventArgs) MyBase.OnMouseWheel(e) Dim value = 100 If e.Delta < 0 Then value *= -1 End If If s.ReverseVideoScrollDirection Then value *= -1 End If TrackBar.Value += value End Sub Protected Overrides Sub OnFormClosed(e As FormClosedEventArgs) MyBase.OnFormClosed(e) Dispose() End Sub Protected Overrides Sub OnShown(e As EventArgs) MyBase.OnShown(e) Add() End Sub Sub CropZoom() Using form As New SimpleSettingsForm("Crop and Zoom") form.Height = CInt(form.Height * 0.6) form.Width = CInt(form.Width * 0.6) Dim ui = form.SimpleUI Dim page = ui.CreateFlowPage("main page") page.SuspendLayout() Dim nb = ui.AddNum(page) nb.Label.Text = "Crop Left:" nb.NumEdit.Config = {0, 10000, 10} nb.NumEdit.Value = CropLeft nb.NumEdit.SaveAction = Sub(value) CropLeft = CInt(value) nb = ui.AddNum(page) nb.Label.Text = "Crop Top:" nb.NumEdit.Config = {0, 10000, 10} nb.NumEdit.Value = CropTop nb.NumEdit.SaveAction = Sub(value) CropTop = CInt(value) nb = ui.AddNum(page) nb.Label.Text = "Crop Right:" nb.NumEdit.Config = {0, 10000, 10} nb.NumEdit.Value = CropRight nb.NumEdit.SaveAction = Sub(value) CropRight = CInt(value) nb = ui.AddNum(page) nb.Label.Text = "Crop Bottom:" nb.NumEdit.Config = {0, 10000, 10} nb.NumEdit.Value = CropBottom nb.NumEdit.SaveAction = Sub(value) CropBottom = CInt(value) page.ResumeLayout() If form.ShowDialog() = DialogResult.OK Then ui.Save() Reload() TrackBarValueChanged() End If End Using End Sub Sub GoToFrame() Dim value = InputBox.Show("Go To Frame", TrackBar.Value.ToString) Dim pos As Integer If Integer.TryParse(value, pos) Then TrackBar.Value = pos End If End Sub Sub GoToTime() Dim tab = DirectCast(TabControl.SelectedTab, VideoTab) Dim d As Date d = d.AddSeconds(Pos / tab.Server.FrameRate) Dim value = InputBox.Show("Go To Time", d.ToString("HH:mm:ss.fff")) Dim time As TimeSpan If value <> "" AndAlso TimeSpan.TryParse(value, time) Then TrackBar.Value = CInt(time.TotalMilliseconds / 1000 * tab.Server.FrameRate) End If End Sub Public Class VideoTab Inherits TabPage Property Server As IFrameServer Property Form As VideoComparisonForm Property FileType As VideoComparisonFileType = VideoComparisonFileType.Video Property TempFilePath As String Property SourceFilePath As String Property VideoPanel As PanelEx Private Renderer As VideoRenderer Private FrameInfo As String() Sub New() VideoPanel = New PanelEx AddHandler VideoPanel.Paint, Sub() Draw() Controls.Add(VideoPanel) End Sub Private Function AdjustName(name As String, Optional lengthLimit As Integer = 50) As String If String.IsNullOrWhiteSpace(name) Then Return "" Const replacement = "....." If name.Length > lengthLimit Then Dim firstHalfLength = lengthLimit \ 2 Dim secondHalfLength = lengthLimit - firstHalfLength Return $"{name.Substring(0, firstHalfLength)}{replacement}{name.Substring(name.Length - secondHalfLength)}" End If Return name End Function Sub Reload() Renderer.Dispose() Server.Dispose() Open(SourceFilePath) End Sub Function Open(sourcePath As String) As Boolean Text = AdjustName(sourcePath.Base) ToolTipText = sourcePath SourceFilePath = sourcePath Select Case sourcePath.Ext() Case "avs" FileType = VideoComparisonFileType.AviSynthScript TempFilePath = sourcePath.DirAndBase + "_compare" + sourcePath.ExtFull Case "vpy" FileType = VideoComparisonFileType.VapourSynthScript TempFilePath = sourcePath.DirAndBase + "_compare" + sourcePath.ExtFull Case "png" FileType = VideoComparisonFileType.Picture TempFilePath = Path.Combine(Folder.Temp, Guid.NewGuid.ToString + ".avs") Case Else FileType = VideoComparisonFileType.Video TempFilePath = Path.Combine(Folder.Temp, Guid.NewGuid.ToString + ".avs") End Select Dim script As New VideoScript With { .Engine = If(FileType = VideoComparisonFileType.VapourSynthScript, ScriptEngine.VapourSynth, ScriptEngine.AviSynth), .Path = TempFilePath } AddHandler Disposed, Sub() FileHelp.Delete(script.Path, RecycleOption.DeletePermanently) Select Case FileType Case VideoComparisonFileType.AviSynthScript script.Filters.Add(New VideoFilter("Source", "Source", File.ReadAllText(sourcePath))) Case VideoComparisonFileType.VapourSynthScript script.Filters.Add(New VideoFilter("Source", "Source", File.ReadAllText(sourcePath))) Case VideoComparisonFileType.Video If sourcePath.EndsWith("mp4") Then script.Filters.Add(New VideoFilter("Source", "Source", "LSMASHVideoSource(""" + sourcePath + "" + """, format = ""YUV420P12"")")) Else script.Filters.Add(New VideoFilter("Source", "Source", "FFVideoSource(""" + sourcePath + "" + """, colorspace = ""YV12"")")) End If script.Filters.Add(New VideoFilter("SetMemoryMax(512)")) Case VideoComparisonFileType.Picture script.Filters.Add(New VideoFilter("ImageSource(""" + sourcePath + """, end = 0)")) script.Filters.Add(New VideoFilter("SetMemoryMax(512)")) Case Else Throw New NotSupportedException("VideoComparisonFileType unhandled!") End Select Select Case FileType Case VideoComparisonFileType.Picture If (Form.CropLeft Or Form.CropTop Or Form.CropRight Or Form.CropBottom) <> 0 Then script.Filters.Add(New VideoFilter("Crop(" & Form.CropLeft & ", " & Form.CropTop & ", -" & Form.CropRight & ", -" & Form.CropBottom & ")")) End If Case VideoComparisonFileType.Video If (Form.CropLeft Or Form.CropTop Or Form.CropRight Or Form.CropBottom) <> 0 Then script.Filters.Add(New VideoFilter("Crop(" & Form.CropLeft & ", " & Form.CropTop & ", -" & Form.CropRight & ", -" & Form.CropBottom & ")")) End If Case VideoComparisonFileType.AviSynthScript Case VideoComparisonFileType.VapourSynthScript Case Else Throw New NotSupportedException("VideoComparisonFileType unhandled!") End Select Indexing(sourcePath, script) script.Synchronize(True, True, True) Server = FrameServerFactory.Create(script.Path) Renderer = New VideoRenderer(VideoPanel, Server) Dim maximum = Server.Info.FrameCount - 1 Form.TrackBar.Maximum = If(Form.TrackBar.Maximum < maximum, maximum, Form.TrackBar.Maximum) If Server.Error <> "" Then MsgError(Server.Error) Dim csvFile = sourcePath.DirAndBase + ".csv" If File.Exists(csvFile) Then Dim len = Form.TrackBar.Maximum Dim lines = File.ReadAllLines(csvFile) If lines.Length > len Then FrameInfo = New String(len) {} Dim headers = lines(0).Split({","c}) For x = 1 To len + 1 Dim values = lines(x).Split({","c}) For x2 = 0 To headers.Length - 1 Dim value = values(x2).Trim If value <> "" AndAlso value <> "-" Then FrameInfo(x - 1) += headers(x2).Trim + ": " + value + ", " End If Next FrameInfo(x - 1) = FrameInfo(x - 1).TrimEnd(" ,".ToCharArray) Next End If End If Return True End Function Sub Indexing(sourcePath As String, script As VideoScript) If String.IsNullOrWhiteSpace(sourcePath) Then Exit Sub If Not File.Exists(sourcePath) Then Exit Sub If script Is Nothing Then Exit Sub Dim sourceFilter = script.GetFilter("Source") If sourceFilter Is Nothing Then Exit Sub Dim codeLower = script.GetFilter("Source").Script.ToLowerInvariant If codeLower.Contains("ffvideosource(") OrElse codeLower.Contains("ffms2.source") Then If codeLower.Contains("cachefile") AndAlso p.TempDir <> "" AndAlso New DirectoryInfo(p.TempDir)?.Name?.EndsWithEx("_temp") Then g.ffmsindex(sourcePath, Path.Combine(p.TempDir, g.GetSourceBase + ".ffindex")) Else g.ffmsindex(sourcePath, sourcePath + ".ffindex") End If ElseIf codeLower.Contains("lwlibavvideosource(") OrElse codeLower.Contains("lwlibavsource(") Then If Not File.Exists(sourcePath + ".lwi") AndAlso Not File.Exists(Path.Combine(p.TempDir, g.GetSourceBase + ".lwi")) AndAlso File.Exists(script.Path) AndAlso Not FileTypes.VideoText.Contains(sourcePath.Ext) Then Using proc As New Proc proc.Header = "Index LWLibav" proc.Encoding = Encoding.UTF8 proc.SkipString = "Creating lwi" If script.IsAviSynth Then proc.File = Package.ffmpeg.Path proc.Arguments = "-i " + script.Path.Escape + " -hide_banner" Else proc.File = Package.vspipe.Path proc.Arguments = script.Path.Escape + " NUL -i" End If proc.AllowedExitCodes = {0, 1} proc.Start() End Using End If End If End Sub Sub Draw() Renderer.Position = Pos Renderer.Draw() End Sub Function GetBitmap() As Bitmap Return BitmapUtil.CreateBitmap(Server, Pos) End Function Sub TrackBarValueChanged() Try Pos = Form.TrackBar.Value Draw() If FrameInfo IsNot Nothing Then Form.laInfo.Text = FrameInfo(Form.TrackBar.Value) Else Dim frameRate = If(Calc.IsValidFrameRate(Server.FrameRate), Server.FrameRate, 25) Dim dt = DateTime.Today.AddSeconds(Pos / frameRate) Form.laInfo.Text = $"Position: {Pos,5}, Time: {dt:HH:mm:ss.fff}, Size: {Server.Info.Width} x {Server.Info.Height}" End If Form.laInfo.Refresh() Catch ex As Exception g.ShowException(ex) End Try End Sub Sub DoLayout() If Server Is Nothing Then Exit Sub End If Dim sizeToFit = New Size(Server.Info.Width, Server.Info.Height) If sizeToFit.IsEmpty Then Exit Sub End If Dim padding As Padding Dim rect As New Rectangle( padding.Left, padding.Top, Width - padding.Horizontal, Height - padding.Vertical) Dim targetPoint As Point Dim targetSize As Size Dim ar1 = rect.Width / rect.Height Dim ar2 = sizeToFit.Width / sizeToFit.Height If ar2 < ar1 Then targetSize.Height = rect.Height targetSize.Width = CInt(sizeToFit.Width / (sizeToFit.Height / rect.Height)) targetPoint.X = CInt((rect.Width - targetSize.Width) / 2) + padding.Left targetPoint.Y = padding.Top Else targetSize.Width = rect.Width targetSize.Height = CInt(sizeToFit.Height / (sizeToFit.Width / rect.Width)) targetPoint.Y = CInt((rect.Height - targetSize.Height) / 2) + padding.Top targetPoint.X = padding.Left End If Dim targetRect = New Rectangle(targetPoint, targetSize) Dim reg As New Region(ClientRectangle) reg.Exclude(targetRect) VideoPanel.Left = targetRect.Left VideoPanel.Top = targetRect.Top VideoPanel.Width = targetRect.Width VideoPanel.Height = targetRect.Height End Sub Protected Overrides Sub Dispose(disposing As Boolean) Server?.Dispose() MyBase.Dispose(disposing) End Sub Sub VideoTab_Resize(sender As Object, e As EventArgs) Handles Me.Resize DoLayout() End Sub End Class End Class