4aiman
44c0a5de24
Полоса ползла по догадке, а подпись показывала замер — и человек видел полосу, заполненную на девять десятых, рядом с нулём процентов. Что в этот момент происходит, по такой паре понять нельзя. Теперь доля одна на обоих. Берётся она у самого ffmpeg: сборка участка с затуханием идёт минуту и дольше, а «кусок 1 из 1» всё это время не меняется, поэтому ffmpeg спрашивают ключом -progress, докуда он дошёл. Пока он не ответил ни разу, полоса трогается с места на пару процентов и там стоит — пустая полоса и есть правда о только что начатой работе. Догадка заодно перестала закрывать промежуток до вехи целиком: предел — девять десятых, остаток виден глазом. Проверка на это добавлена в tests/progress. Полоса в окне сборки была системной, и под gtk2 заполнялась ступенями по восемь кусков на ширину. Теперь там та же своя полоса, что и внизу главного окна, — заполняется сплошь. Чтобы она читалась из файла формы, у неё опубликованы Anchors, Align и Visible: читатель формы берёт только опубликованные свойства, и без этого окно падало при открытии. Проверено глазами на невидимом экране: «Собираю наложение 1 из 1 — 2%» при полосе в 2%, через четыре секунды 69% при полосе в 69%.
5212 lines
210 KiB
ObjectPascal
5212 lines
210 KiB
ObjectPascal
{
|
||
uMainForm — главное окно редактора.
|
||
|
||
Собирает вместе всё остальное: список файлов проекта, монтажный стол,
|
||
предпросмотр через mpv и сборку через ffmpeg.
|
||
|
||
Как связаны монтаж и предпросмотр. После каждой правки монтаж
|
||
раскладывается в плоский список кусков, из него собирается строка EDL,
|
||
и она отдаётся плееру. Пересборка отложена на несколько десятых секунды:
|
||
иначе при перетаскивании клипа плеер дёргался бы на каждое движение мыши.
|
||
|
||
Время на монтаже и время в предпросмотре совпадают в точности, потому
|
||
что список кусков покрывает отрезок от нуля до конца монтажа без
|
||
пропусков — дыры превращаются в чёрные вставки. Благодаря этому курсор
|
||
можно двигать в обе стороны: щелчок по линейке перематывает плеер, а
|
||
воспроизведение двигает курсор.
|
||
}
|
||
unit uMainForm;
|
||
|
||
{$mode objfpc}{$H+}
|
||
|
||
interface
|
||
|
||
uses
|
||
Classes, SysUtils, contnrs, Forms, Controls, Graphics, Dialogs, ExtCtrls,
|
||
StdCtrls,
|
||
ComCtrls, Menus, Buttons, LCLType, LMessages,
|
||
uAppTypes, uEdl, uMpvLib, uMpvPlayer, uProject, uMediaProbe, uTimelineCtrl,
|
||
uFlatten, uGenerate, uExport, uEncodeForm, uAboutForm, uProgressForm,
|
||
uRemuxForm, uMismatchForm,
|
||
uFfmpegJob, uSettings, uThumbs, uTransform, uPanCropForm,
|
||
uProjectInfoForm, ImgList, uTheme, uLogView, uDepsForm, uWaveform,
|
||
uIconData, uSubtitles, uTextMeasure, uTextForm, uExportForm,
|
||
uColorKeyForm;
|
||
|
||
const
|
||
{ Номера системных сообщений о перерисовке рамки окна. Берём числами, а
|
||
не из модуля Windows: тот переопределяет TRect и Point, и обычные
|
||
вызовы LCL начинают разбираться как системные. }
|
||
MsgNcPaint = $0085;
|
||
MsgNcActivate = $0086;
|
||
|
||
type
|
||
|
||
{ TMainForm }
|
||
|
||
TMainForm = class(TForm)
|
||
|
||
btnSnap: TThemedButton;
|
||
btnGlue: TThemedButton;
|
||
btnCenter: TThemedButton;
|
||
btnRipple: TThemedButton;
|
||
btnRippleMenu: TThemedButton;
|
||
btnSelectMode: TThemedButton;
|
||
lblPoolInfo: TLabel;
|
||
lblStatus: TLabel;
|
||
lblTime: TLabel;
|
||
|
||
lstPool: TListBox;
|
||
memoLog: TLogView;
|
||
OpenMediaDialog: TOpenDialog;
|
||
OpenProjectDialog: TOpenDialog;
|
||
pnlBottom: TPanel;
|
||
pnlLeft: TPanel;
|
||
pnlMain: TPanel;
|
||
pnlTimelineHost: TPanel;
|
||
pnlVideo: TPanel;
|
||
SaveExportDialog: TSaveDialog;
|
||
SaveProjectDialog: TSaveDialog;
|
||
splitVideo: TSplitter;
|
||
procedure btnSnapClick(Sender: TObject);
|
||
procedure btnGlueClick(Sender: TObject);
|
||
procedure btnCenterClick(Sender: TObject);
|
||
procedure btnRippleClick(Sender: TObject);
|
||
procedure btnRippleMenuClick(Sender: TObject);
|
||
procedure btnSelectModeClick(Sender: TObject);
|
||
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
||
procedure FormCreate(Sender: TObject);
|
||
procedure FormDestroy(Sender: TObject);
|
||
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||
procedure FormShow(Sender: TObject);
|
||
{$IFDEF LCLWIN32}
|
||
{ Остаток полосы меню закрашивается после того, как система нарисовала
|
||
рамку окна. Раньше — бесполезно: она закрасит поверх. }
|
||
procedure WMNCPaint(var Msg: TLMessage); message MsgNcPaint;
|
||
procedure WMNCActivate(var Msg: TLMessage); message MsgNcActivate;
|
||
{$ENDIF}
|
||
procedure lstPoolClick(Sender: TObject);
|
||
procedure lstPoolMouseDown(Sender: TObject; Button: TMouseButton;
|
||
Shift: TShiftState; X, Y: Integer);
|
||
procedure lstPoolDrawItem(Control: TWinControl; Index: Integer;
|
||
ARect: TRect; State: TOwnerDrawState);
|
||
private
|
||
FProject: TProject;
|
||
FTimeline: TTimelineControl;
|
||
FPlayer: TMpvPlayer;
|
||
FStarted: Boolean;
|
||
|
||
FPreviewTimer: TTimer;
|
||
{ Автосохранение: копия проекта пишется сама собой, пока человек
|
||
работает. Нужна ровно на один случай — работа пропала, а сохранить
|
||
её забыли или сохранение не дошло до файла. }
|
||
FAutoSaveTimer: TTimer;
|
||
FPreviewDirty: Boolean;
|
||
FUpdatingFromPlayer: Boolean;
|
||
FLastLoadedEdl: string;
|
||
FLastLoadedAudioEdl: string;
|
||
{ Наложение для плеера: список кусков оверлея и окна показа. }
|
||
{ Журнал текущей сборки: файл рядом с готовым роликом. }
|
||
FExportLogPath: string;
|
||
{ Разметка текста, отданная плееру в прошлый раз. }
|
||
FLastAss: string;
|
||
{ Клип, с которого скопированы свойства. Хранится копией, а не
|
||
ссылкой: исходный клип могут удалить, а свойства должны остаться. }
|
||
FLookClip: TClip;
|
||
{ Скопированные клипы: сами копии, имя дорожки каждого, смещение от
|
||
начала выделения и прежняя связка. Хранятся копиями по той же
|
||
причине — исходные могут исчезнуть. }
|
||
FClipboard: TObjectList;
|
||
FClipTrackNames: array of string;
|
||
FClipOffsets: array of Double;
|
||
FClipGroups: array of string;
|
||
{ Проект открыт из командной строки: спросить про клипы на чужих
|
||
дорожках можно только когда окно уже показано. }
|
||
FCheckMisplacedOnShow: Boolean;
|
||
FPreviewOverlayUrl: string;
|
||
FPreviewOverlayWindows: TOverlayWindows;
|
||
{ Списки кусков звуковых дорожек для плеера. }
|
||
FPreviewAudioUrls: array of string;
|
||
{ Звуковые дорожки предпросмотра — их номера в проекте, а не сами
|
||
объекты.
|
||
|
||
Указатели здесь были ловушкой: отмена и открытие проекта
|
||
пересоздают все дорожки, а этот список продолжал показывать на
|
||
освобождённую память. Обращение к нему идёт на каждое обновление
|
||
времени при воспроизведении, то есть десятки раз в секунду. }
|
||
FPreviewAudioTracks: array of string;
|
||
FLastHwdec: string;
|
||
FLastAudioNote: string;
|
||
FLogFilePath: string;
|
||
FLogFileStarted: Boolean;
|
||
FLogFileBroken: Boolean;
|
||
FMenu: TMainMenu;
|
||
{ Отложенный показ списка меню. Номер списка и точка, где его
|
||
раскрыть; таймер срабатывает один раз. }
|
||
{ Показ фоновой работы. Пока что-то считается в стороне от окна,
|
||
здесь видно, что именно и сколько осталось. }
|
||
FJobLabel: TLabel;
|
||
FJobBar: TThemedProgress;
|
||
FJobTimer: TTimer;
|
||
{ Что выбрали в окне сборки в прошлый раз. Держится между вызовами,
|
||
чтобы не задавать один и тот же вопрос заново. }
|
||
FExportChoice: TExportChoice;
|
||
{ Сколько внутренних ошибок уже случилось. Окно показываем только на
|
||
первую. }
|
||
FErrorCount: Integer;
|
||
FLogButton: TThemedButton;
|
||
{ Пункт «Ключ и прозрачность в предпросмотре»: галку в нём приходится
|
||
держать за руку — она не следует за настройкой сама. }
|
||
FKeyPreviewItem: TMenuItem;
|
||
FSelectModeItem: TMenuItem;
|
||
{ Показанная доля выполнения. Отдельно от настоящей, потому что растёт
|
||
она по своим правилам — см. AdvanceJobBar. }
|
||
FJobShown: Double;
|
||
{ Настоящая доля и доля следующей вехи. Между вехами полоска ползёт
|
||
сама, замедляясь. }
|
||
FJobReal: Double;
|
||
FJobNext: Double;
|
||
{ Какая именно работа идёт. При смене занятия полоска начинается
|
||
заново: иначе новая работа унаследовала бы почти полную полосу от
|
||
предыдущей и стояла бы на месте до самого конца. }
|
||
FJobKind: Integer;
|
||
{ Уплощённый монтаж, отданный плееру. Хранится, чтобы по времени
|
||
находить звучащий кусок и брать у него громкость. }
|
||
FPreviewSegments: TFlatSegmentArray;
|
||
FLastVolumeSent: Double;
|
||
FLastVolumeKey: string;
|
||
{ Что сейчас показано обрезкой на выводе: лишний раз её не трогаем. }
|
||
FLastCropKey: string;
|
||
|
||
FGenerate: TGenerateThread;
|
||
FGenerateBusy: Boolean;
|
||
|
||
FExport: TExportThread;
|
||
FExportUi: TProgressForm;
|
||
|
||
FNormalize: TFfmpegJob;
|
||
FNormalizeUi: TProgressForm;
|
||
|
||
FSettings: TSettings;
|
||
|
||
FThumbs: TImageList;
|
||
FThumbThread: TThumbThread;
|
||
FPeaksThread: TPeaksThread;
|
||
FPeaksRestart: Boolean;
|
||
FPeaksFinished: Boolean;
|
||
{ Соответствие «путь к файлу -> номер картинки в списке изображений».
|
||
По пути, а не по номеру в списке проекта: пока миниатюра делается,
|
||
файлы могут добавиться или пропасть. Номер хранится увеличенным на
|
||
единицу, потому что ноль в Objects неотличим от «ничего нет». }
|
||
FThumbMap: TStringList;
|
||
|
||
{ Меню библиотеки и меню выбора режима схлопывания. }
|
||
FPoolMenu: TPopupMenu;
|
||
FPoolAddMenu: TMenuItem;
|
||
FRippleMenu: TPopupMenu;
|
||
{ Меню дорожки по правому щелчку в её заголовке. }
|
||
FTrackMenu: TPopupMenu;
|
||
{ Дорожка, для которой открыто меню. }
|
||
FTrackMenuIndex: Integer;
|
||
{ Пункт «Недавние проекты» в меню «Файл». Его содержимое собирается
|
||
заново при каждом изменении списка. }
|
||
FRecentMenu: TMenuItem;
|
||
|
||
{ Пока плеер не доехал до запрошенного места, его сообщения о позиции
|
||
игнорируются. Без этого перезагрузка предпросмотра после правки
|
||
сбрасывала бы курсор в начало. }
|
||
FSeekPending: Boolean;
|
||
FSeekTarget: Double;
|
||
{ Сколько сообщений о позиции ждём прибытия, прежде чем сдаться.
|
||
|
||
Без этого ограничения признак «ждём» мог зависнуть навсегда: если
|
||
после правки монтажа запрошенное время оказалось за его концом,
|
||
плеер туда никогда не доедет, и курсор переставал двигаться
|
||
совсем. }
|
||
FSeekWaitTicks: Integer;
|
||
{ До какого времени ответ на команду держится в строке состояния. }
|
||
FStatusHoldUntil: TDateTime;
|
||
{ Автосохранение не удалось — жалуемся один раз, а не каждые полминуты. }
|
||
FAutoSaveBroken: Boolean;
|
||
{ Что было в строке состояния до того, как её занял рассказ о кнопке
|
||
под указателем, и чья именно это подсказка. Кнопка нужна затем, что
|
||
при переходе с одной на соседнюю события приходят вперемешку: уход
|
||
со старой может прийти после прихода на новую, и без проверки он
|
||
затёр бы свежую подсказку. }
|
||
FStatusBeforeHint: string;
|
||
FHintControl: TControl;
|
||
|
||
procedure ApplyVolumeAt(const ATime: Double);
|
||
{ Показывает кадрирование клипа, который виден сейчас. }
|
||
procedure ApplyCropAt(const ATime: Double);
|
||
{ Переписывает файл субтитров и отдаёт его плееру. }
|
||
procedure UpdateSubtitles;
|
||
procedure UpdateRippleButton;
|
||
procedure CheckMisplacedClips;
|
||
procedure BuildTrackMenu;
|
||
procedure TimelineTrackMenu(Sender: TObject; ATrackIndex: Integer;
|
||
const AScreenPos: TPoint);
|
||
procedure TimelineRegionChange(Sender: TObject);
|
||
procedure TrackMenuDelete(Sender: TObject);
|
||
procedure TrackMenuRename(Sender: TObject);
|
||
procedure TimelineTrackRename(Sender: TObject; ATrackIndex: Integer);
|
||
procedure TrackMenuUp(Sender: TObject);
|
||
procedure TrackMenuDown(Sender: TObject);
|
||
procedure UpdateSnapButton;
|
||
procedure UpdateGlueButton;
|
||
procedure UpdateSelectModeButton;
|
||
{ Подсказки нижних кнопок показываются строкой состояния, а не
|
||
всплывающим окном. }
|
||
procedure BarButtonEnter(Sender: TObject);
|
||
procedure BarButtonLeave(Sender: TObject);
|
||
procedure UseStatusHints(const AButtons: array of TThemedButton);
|
||
{ Перечитывает подсказку кнопки, над которой стоит указатель. }
|
||
procedure RefreshBarHint;
|
||
{ Ширина строки состояния: до показателя работы или до края панели. }
|
||
procedure UpdateStatusWidth;
|
||
procedure TimelineSelectModeChange(Sender: TObject);
|
||
procedure UpdateCenterButton;
|
||
procedure ToggleCenterPlayhead;
|
||
procedure RippleModeChosen(Sender: TObject);
|
||
procedure ToggleRipple;
|
||
procedure BuildPoolMenu;
|
||
procedure RefreshRecentMenu;
|
||
procedure OpenRecentProject(Sender: TObject);
|
||
function OpenProjectFile(const APath: string): Boolean;
|
||
procedure PoolMenuPopup(Sender: TObject);
|
||
procedure PoolAddToTrack(Sender: TObject);
|
||
procedure PoolRemoveFromTracks(Sender: TObject);
|
||
procedure PoolRemoveFromProject(Sender: TObject);
|
||
procedure PoolEditTransform(Sender: TObject);
|
||
procedure TimelineClipTransform(Sender: TObject; AClip: TClip);
|
||
procedure MenuProjectInfo(Sender: TObject);
|
||
procedure MenuRepairProject(Sender: TObject);
|
||
procedure FormFilesDropped(Sender: TObject; const FileNames: array of string);
|
||
function ThumbIndexFor(const APath: string): Integer;
|
||
procedure ApplySettings;
|
||
procedure CollectSettings;
|
||
procedure StartThumbs;
|
||
procedure StartPeaks;
|
||
procedure PeaksReady(Sender: TObject; const ASourcePath: string);
|
||
procedure PeaksDone(Sender: TObject);
|
||
procedure ThumbReady(Sender: TObject; const ASourcePath,
|
||
AThumbPath: string);
|
||
procedure SeekPlayerTo(const ATime: Double);
|
||
procedure TogglePlayback;
|
||
|
||
procedure TimelineMediaDrop(Sender: TObject; ASource: TObject;
|
||
ATrackIndex: Integer; const ATime: Double);
|
||
procedure TimelineTrackAdded(Sender: TObject);
|
||
procedure TimelineActiveTrackChange(Sender: TObject);
|
||
function AddClipFromPool(APoolIndex, ATrackIndex: Integer;
|
||
const ATime: Double): Boolean;
|
||
|
||
{ --- окно и меню --- }
|
||
procedure BuildMenu;
|
||
{ Разбор внутренней ошибки: пишет в журнал место, где она случилась. }
|
||
procedure HandleException(Sender: TObject; E: Exception);
|
||
procedure ApplyWindowIcon;
|
||
procedure BuildJobIndicator;
|
||
procedure JobTimerTick(Sender: TObject);
|
||
procedure AdvanceJobBar;
|
||
procedure LogButtonClick(Sender: TObject);
|
||
procedure MenuToggleLog(Sender: TObject);
|
||
procedure MenuTogglePreviewKey(Sender: TObject);
|
||
procedure MenuAbout(Sender: TObject);
|
||
procedure MenuAddText(Sender: TObject);
|
||
{ Открывает редактор текста для клипа. True — что-то изменилось. }
|
||
function EditTextOf(AClip: TClip): Boolean;
|
||
procedure ApplyLogVisible(AVisible: Boolean);
|
||
procedure BuildTimeline;
|
||
procedure StartPlayer;
|
||
{ Чего не хватает для работы. Пустая строка — всё на месте. }
|
||
function MissingDeps: string;
|
||
procedure RemindAboutDeps;
|
||
procedure Log(const AText: string);
|
||
procedure LogToFile(const AText: string);
|
||
{ Урезает файл журнала, когда он перерос предел. }
|
||
procedure TrimLogFile;
|
||
{ AAnswer — это ответ на команду человека, а не проходное сообщение:
|
||
такой ответ держится в строке несколько секунд. }
|
||
procedure SetStatus(const AText: string; AAnswer: Boolean = False);
|
||
{ Автосохранение: копия рядом с проектом. }
|
||
function AutoSavePath: string;
|
||
procedure DropAutoSave;
|
||
procedure AutoSaveTick(Sender: TObject);
|
||
procedure OfferAutoSave;
|
||
procedure UpdateCaption;
|
||
procedure UpdateTimeLabel;
|
||
procedure RefreshPool;
|
||
|
||
|
||
{ --- предпросмотр --- }
|
||
procedure PrewarmInserts;
|
||
procedure SchedulePreview;
|
||
procedure PreviewTimerTick(Sender: TObject);
|
||
{ Есть ли на монтаже файл другого соотношения сторон. Только ради
|
||
таких файлов и нужен фильтр в предпросмотре. }
|
||
function PreviewNeedsFitting: Boolean;
|
||
{ Заставляет предпросмотр показывать кадр проекта, а не кадр исходника. }
|
||
procedure ApplyPreviewFrame;
|
||
procedure RebuildPreview;
|
||
procedure LoadPreviewEdl(const ASegments, AAudio: TFlatSegmentArray);
|
||
procedure BuildOverlayPreview(const AOverlays: TPreviewOverlays;
|
||
const ATotal: Double);
|
||
{ Нужно ли ещё то, что делает идущая генерация. }
|
||
function GenerationStillNeeded: Boolean;
|
||
procedure GenerateDone(Sender: TObject);
|
||
procedure GenerateProgress(Sender: TObject);
|
||
procedure GenerateLog(Sender: TObject);
|
||
|
||
{ --- обработчики компонентов --- }
|
||
procedure TimelinePlayheadChange(Sender: TObject);
|
||
procedure TimelineStructureChange(Sender: TObject);
|
||
procedure TimelineSelectionChange(Sender: TObject);
|
||
procedure PlayerLog(Sender: TObject; const APrefix, ALevel, AText: string);
|
||
procedure PlayerTimePos(Sender: TObject);
|
||
procedure PlayerDuration(Sender: TObject);
|
||
procedure PlayerPauseChange(Sender: TObject);
|
||
|
||
{ --- пункты меню --- }
|
||
procedure MenuNewProject(Sender: TObject);
|
||
procedure MenuOpenProject(Sender: TObject);
|
||
procedure MenuSaveProject(Sender: TObject);
|
||
procedure MenuSaveProjectAs(Sender: TObject);
|
||
procedure MenuExport(Sender: TObject);
|
||
procedure MenuExportEncode(Sender: TObject);
|
||
procedure DoExport(const AProfile: TEncodeProfile);
|
||
procedure MenuRemux(Sender: TObject);
|
||
procedure MenuDeps(Sender: TObject);
|
||
procedure MenuQuit(Sender: TObject);
|
||
procedure MenuUndo(Sender: TObject);
|
||
procedure MenuRedo(Sender: TObject);
|
||
procedure MenuSplit(Sender: TObject);
|
||
procedure MenuDelete(Sender: TObject);
|
||
procedure MenuColorKey(Sender: TObject);
|
||
procedure MenuCopyLook(Sender: TObject);
|
||
procedure MenuPasteLook(Sender: TObject);
|
||
procedure MenuCopyClips(Sender: TObject);
|
||
procedure MenuPasteClips(Sender: TObject);
|
||
{ Куда положить вставляемый клип: дорожка того же вида, где это время
|
||
свободно. }
|
||
function TrackForPaste(AClip: TClip; const AName: string): TTrack;
|
||
function FirstSelectedClip: TClip;
|
||
procedure MenuRegionIn(Sender: TObject);
|
||
procedure MenuRegionOut(Sender: TObject);
|
||
procedure MenuRegionClear(Sender: TObject);
|
||
{ Что и откуда собирать: с учётом отмеченного участка. }
|
||
procedure DescribeRegion(out AFrom, ATo: Double);
|
||
procedure MenuSelectAll(Sender: TObject);
|
||
procedure MenuSelectMode(Sender: TObject);
|
||
procedure MenuRipple(Sender: TObject);
|
||
procedure MenuToggleRipple(Sender: TObject);
|
||
procedure MenuGoStart(Sender: TObject);
|
||
procedure MenuGoEnd(Sender: TObject);
|
||
procedure MenuZoomFit(Sender: TObject);
|
||
procedure MenuZoomIn(Sender: TObject);
|
||
procedure MenuZoomOut(Sender: TObject);
|
||
procedure MenuAddTrack(Sender: TObject);
|
||
procedure MenuRemoveTrack(Sender: TObject);
|
||
|
||
{ --- вспомогательное --- }
|
||
function SaveProjectAs: Boolean;
|
||
function DoSaveProject: Boolean;
|
||
function ConfirmDiscard: Boolean;
|
||
procedure AddMediaFile(const APath: string);
|
||
procedure ChooseAndAddFiles(Sender: TObject);
|
||
procedure ExportProgress(Sender: TObject);
|
||
procedure ExportLog(Sender: TObject);
|
||
procedure ExportDone(Sender: TObject);
|
||
procedure ExportCancel(Sender: TObject);
|
||
procedure ShowExportReport(const AReport: TExportReport);
|
||
{ Строка и в общий журнал программы, и в журнал этой сборки. }
|
||
procedure LogExport(const AText: string);
|
||
{ Предлагает продолжить прерванную сборку с готовых кусков. }
|
||
{ Предупреждение о выбранном контейнере. False — человек передумал
|
||
собирать. }
|
||
function AskContainer(AHasPrecise: Boolean): Boolean;
|
||
function AskResume(const AOutputPath: string): Boolean;
|
||
procedure NormalizeProgress(Sender: TObject);
|
||
procedure NormalizeLog(Sender: TObject);
|
||
procedure NormalizeDone(Sender: TObject);
|
||
procedure NormalizeCancel(Sender: TObject);
|
||
end;
|
||
|
||
var
|
||
MainFormInstance: TMainForm;
|
||
|
||
implementation
|
||
|
||
{$R *.lfm}
|
||
|
||
uses
|
||
Math, uProcRunner, uFfmpegCmd;
|
||
|
||
const
|
||
{ Задержка пересборки предпросмотра. Правка монтажа сообщается один раз,
|
||
по окончании перетаскивания, поэтому задержка нужна лишь чтобы склеить
|
||
несколько правок подряд — и должна быть маленькой: пока она идёт,
|
||
предпросмотр играет старую расстановку, а на монтаже уже новая. }
|
||
PreviewDebounceMs = 120;
|
||
|
||
{ Сколько сообщений о позиции ждать прибытия после перемотки.
|
||
Сообщения приходят на каждый кадр, так что это доли секунды. }
|
||
MaxSeekWaitTicks = 90;
|
||
|
||
{ Сколько ответ на команду держится в строке состояния, не давая себя
|
||
затереть проходным сообщением. Четыре секунды — успеть прочесть. }
|
||
StatusHoldTime = 4 / (24 * 60 * 60);
|
||
|
||
{ Как часто пишется копия проекта для восстановления. Полминуты — это
|
||
потолок потерь: больше получаса работы человек в неё не вложит, а
|
||
запись проекта стоит миллисекунды. }
|
||
AutoSaveIntervalMs = 30 * 1000;
|
||
|
||
{ Приставка к имени файла проекта у автосохранённой копии. }
|
||
AutoSaveSuffix = '.autosave';
|
||
|
||
{ Предел для файла журнала. Больше двух мегабайт читать всё равно
|
||
никто не станет, а место жалко. }
|
||
MaxLogFileSize = 2 * 1024 * 1024;
|
||
|
||
function FormatTimecode(const Seconds: Double): string;
|
||
var
|
||
Total, H, M, S, Ms: Integer;
|
||
begin
|
||
if Seconds < 0 then
|
||
Exit('--:--:--.---');
|
||
Total := Trunc(Seconds);
|
||
Ms := Round(Frac(Seconds) * 1000);
|
||
if Ms > 999 then
|
||
Ms := 999;
|
||
H := Total div 3600;
|
||
M := (Total mod 3600) div 60;
|
||
S := Total mod 60;
|
||
Result := Format('%.2d:%.2d:%.2d.%.3d', [H, M, S, Ms]);
|
||
end;
|
||
|
||
{ --- Создание окна --- }
|
||
|
||
procedure TMainForm.FormCreate(Sender: TObject);
|
||
begin
|
||
FSettings := TSettings.Create;
|
||
FSettings.Load;
|
||
|
||
FProject := TProject.Create;
|
||
FProject.NewProject;
|
||
|
||
BuildMenu;
|
||
BuildTimeline;
|
||
ApplySettings;
|
||
|
||
pnlVideo.Color := clBlack;
|
||
memoLog.Clear;
|
||
FLogFilePath := ProgramDir + 'nlve.log';
|
||
|
||
FPlayer := TMpvPlayer.Create(pnlVideo);
|
||
FPlayer.OnLog := @PlayerLog;
|
||
FPlayer.OnTimePos := @PlayerTimePos;
|
||
FPlayer.OnDuration := @PlayerDuration;
|
||
FPlayer.OnPauseChange := @PlayerPauseChange;
|
||
|
||
FPreviewTimer := TTimer.Create(Self);
|
||
FPreviewTimer.Enabled := False;
|
||
FPreviewTimer.Interval := PreviewDebounceMs;
|
||
FPreviewTimer.OnTimer := @PreviewTimerTick;
|
||
|
||
FAutoSaveTimer := TTimer.Create(Self);
|
||
FAutoSaveTimer.Interval := AutoSaveIntervalMs;
|
||
FAutoSaveTimer.OnTimer := @AutoSaveTick;
|
||
FAutoSaveTimer.Enabled := True;
|
||
|
||
{ Список изображений держит миниатюры. Размер задан жёстко, и ffmpeg
|
||
делает их ровно такими: список изображений в LCL требует одинакового
|
||
размера у всех элементов. }
|
||
FThumbs := TImageList.Create(Self);
|
||
FThumbs.Width := ThumbWidth;
|
||
FThumbs.Height := ThumbHeight;
|
||
|
||
FThumbMap := TStringList.Create;
|
||
FThumbMap.Sorted := True;
|
||
FThumbMap.Duplicates := dupIgnore;
|
||
|
||
{ Список рисуется вручную.
|
||
|
||
Готовый режим значков в LCL под gtk2 работает плохо: там TListView
|
||
построен на дереве, и крупные значки он попросту игнорирует. Своя
|
||
отрисовка надёжнее и заодно позволяет показать рядом с кадром
|
||
название и параметры файла. }
|
||
lstPool.Style := lbOwnerDrawFixed;
|
||
lstPool.ItemHeight := ThumbHeight + 10;
|
||
{ Перетаскивание из списка на монтаж начинается само. }
|
||
lstPool.DragMode := dmAutomatic;
|
||
|
||
BuildPoolMenu;
|
||
BuildTrackMenu;
|
||
{ Буфер владеет копиями: подлинники могут исчезнуть, а вставлять надо
|
||
по-прежнему. }
|
||
FClipboard := TObjectList.Create(True);
|
||
RefreshRecentMenu;
|
||
AllowDropFiles := True;
|
||
OnDropFiles := @FormFilesDropped;
|
||
|
||
RefreshPool;
|
||
UpdateRippleButton;
|
||
UpdateSnapButton;
|
||
UpdateGlueButton;
|
||
UpdateSelectModeButton;
|
||
UpdateCenterButton;
|
||
UpdateCaption;
|
||
SetStatus('Готов. Добавьте файлы в проект.');
|
||
|
||
{ Цвета задаём сами: системная тема может быть светлой, и тогда тёмный
|
||
таймлайн оказался бы в белой рамке. Вызов идёт последним — меню и
|
||
всплывающие меню строятся выше по ходу, и раньше их не существует. }
|
||
ApplyDarkTheme(Self);
|
||
end;
|
||
|
||
{ Каждый шаг закрытия отмечается в журнале.
|
||
|
||
Под Wine программа зависала при выходе, и по молчаливому журналу
|
||
понять, на чём именно, нельзя: последняя запись оставалась от работы, а
|
||
не от закрытия. Записи дешёвые, а без них искать пришлось бы наугад. }
|
||
procedure TMainForm.FormDestroy(Sender: TObject);
|
||
begin
|
||
Log('Закрытие: останавливаю предпросмотр.');
|
||
FreeAndNil(FLookClip);
|
||
FreeAndNil(FClipboard);
|
||
FPreviewTimer.Enabled := False;
|
||
if Assigned(FThumbThread) then
|
||
begin
|
||
Log('Закрытие: жду поток миниатюр.');
|
||
{ Поток обращается к форме через Synchronize, поэтому дожидаться его
|
||
обязательно: иначе он попробует достучаться до уже разрушенного окна. }
|
||
FThumbThread.Terminate;
|
||
FThumbThread.WaitFor;
|
||
FreeAndNil(FThumbThread);
|
||
end;
|
||
if Assigned(FPeaksThread) then
|
||
begin
|
||
Log('Закрытие: жду разбор звука.');
|
||
{ При закрытии ждать приходится: поток обращается к окну. Ждать
|
||
недолго — запущенный ffmpeg прерывается по тому же признаку. }
|
||
FPeaksRestart := False;
|
||
FPeaksThread.Terminate;
|
||
FPeaksThread.WaitFor;
|
||
FreeAndNil(FPeaksThread);
|
||
end;
|
||
FreeAndNil(FThumbMap);
|
||
Log('Закрытие: сохраняю настройки.');
|
||
CollectSettings;
|
||
FSettings.Save;
|
||
FreeAndNil(FSettings);
|
||
Log('Закрытие: закрываю плеер.');
|
||
FreeAndNil(FPlayer);
|
||
|
||
{ Библиотеку не выгружаем.
|
||
|
||
Плеер отсоединяется от mpv, не дожидаясь, пока ядро добьёт свои
|
||
потоки, — иначе под Wine ожидание не кончалось вовсе. Значит, в
|
||
момент выхода эти потоки могут ещё жить внутри библиотеки, и
|
||
выгружать её из-под них нельзя. Программа всё равно закрывается,
|
||
и система освободит всё сама. }
|
||
Log('Закрытие: освобождаю проект.');
|
||
FreeAndNil(FProject);
|
||
Log('Закрытие завершено.');
|
||
{ Сами списки принадлежат форме и уничтожатся с ней; здесь только
|
||
перечень ссылок на них. }
|
||
end;
|
||
|
||
procedure TMainForm.ApplySettings;
|
||
begin
|
||
if (FSettings.WindowLeft >= 0) and (FSettings.WindowTop >= 0) then
|
||
begin
|
||
Position := poDesigned;
|
||
Left := FSettings.WindowLeft;
|
||
Top := FSettings.WindowTop;
|
||
end;
|
||
Width := FSettings.WindowWidth;
|
||
Height := FSettings.WindowHeight;
|
||
if FSettings.WindowMaximized then
|
||
WindowState := wsMaximized;
|
||
|
||
pnlVideo.Height := FSettings.VideoPanelHeight;
|
||
FTimeline.TrackHeight := FSettings.TrackHeight;
|
||
FTimeline.WaveGain := FSettings.WaveGain;
|
||
|
||
{ Режим схлопывания и его состояние переживают перезапуск. }
|
||
if FSettings.RippleAllTracks then
|
||
FProject.RippleMode := rmAllTracks
|
||
else
|
||
FProject.RippleMode := rmCurrentTrack;
|
||
FProject.RippleEnabled := FSettings.RippleEnabled;
|
||
FTimeline.PlayheadSnap := FSettings.PlayheadSnap;
|
||
|
||
{ Каталоги подставляем в диалоги, чтобы не искать одно и то же место
|
||
заново при каждом запуске. }
|
||
if FSettings.LastMediaDir <> '' then
|
||
OpenMediaDialog.InitialDir := FSettings.LastMediaDir;
|
||
if FSettings.LastProjectDir <> '' then
|
||
begin
|
||
OpenProjectDialog.InitialDir := FSettings.LastProjectDir;
|
||
SaveProjectDialog.InitialDir := FSettings.LastProjectDir;
|
||
end;
|
||
if FSettings.LastExportDir <> '' then
|
||
SaveExportDialog.InitialDir := FSettings.LastExportDir;
|
||
end;
|
||
|
||
procedure TMainForm.CollectSettings;
|
||
begin
|
||
FSettings.WindowMaximized := WindowState = wsMaximized;
|
||
{ Развёрнутое окно запоминать по координатам бессмысленно: они не те,
|
||
что были до разворачивания. }
|
||
if WindowState = wsNormal then
|
||
begin
|
||
FSettings.WindowLeft := Left;
|
||
FSettings.WindowTop := Top;
|
||
FSettings.WindowWidth := Width;
|
||
FSettings.WindowHeight := Height;
|
||
end;
|
||
FSettings.VideoPanelHeight := pnlVideo.Height;
|
||
FSettings.LogVisible := memoLog.Visible;
|
||
FSettings.RippleAllTracks := FProject.RippleMode = rmAllTracks;
|
||
FSettings.RippleEnabled := FProject.RippleEnabled;
|
||
FSettings.PlayheadSnap := FTimeline.PlayheadSnap;
|
||
FSettings.WaveGain := FTimeline.WaveGain;
|
||
end;
|
||
|
||
procedure TMainForm.BuildTimeline;
|
||
begin
|
||
{ Компонент создаётся кодом, а не кладётся на форму: он свой, в палитре
|
||
его нет, а регистрировать пакет ради одного контрола незачем. }
|
||
FTimeline := TTimelineControl.Create(Self);
|
||
FTimeline.Parent := pnlTimelineHost;
|
||
FTimeline.Align := alClient;
|
||
FTimeline.Project := FProject;
|
||
FTimeline.OnPlayheadChange := @TimelinePlayheadChange;
|
||
FTimeline.OnStructureChange := @TimelineStructureChange;
|
||
FTimeline.OnSelectionChange := @TimelineSelectionChange;
|
||
FTimeline.OnMediaDrop := @TimelineMediaDrop;
|
||
FTimeline.OnClipTransform := @TimelineClipTransform;
|
||
FTimeline.OnTrackAdded := @TimelineTrackAdded;
|
||
FTimeline.OnTrackMenu := @TimelineTrackMenu;
|
||
FTimeline.OnTrackRename := @TimelineTrackRename;
|
||
FTimeline.OnRegionChange := @TimelineRegionChange;
|
||
FTimeline.OnSelectionModeChange := @TimelineSelectModeChange;
|
||
FTimeline.OnActiveTrackChange := @TimelineActiveTrackChange;
|
||
end;
|
||
|
||
{ Меню строится кодом: в файле формы оно заняло бы сотню строк описания
|
||
вложенных пунктов, где легко ошибиться и трудно что-то найти.
|
||
|
||
Полоса меню — настоящая, TMainMenu.
|
||
|
||
Некоторое время она была своя, из обычных кнопок: под Windows системную
|
||
полосу нашим цветом не закрасить, SetMenuInfo меняет подложку пунктов, но
|
||
не саму полосу. Цена оказалась велика, и вся она в поведении: наведение
|
||
на соседнее название не перекидывало на него раскрытый список, не
|
||
работал переход по меню с Alt и стрелками. Подражать настоящему меню
|
||
своими руками пришлось бы до бесконечности.
|
||
|
||
Цвет решается иначе, на каждой системе своим способом: под gtk2 строкой
|
||
стиля (ApplyMenuStyle), под win32 отрисовкой пунктов своими руками
|
||
(ApplyDarkMenu). Остаток полосы правее последнего названия под Windows
|
||
по-прежнему рисует система — это известная и принятая уступка. }
|
||
procedure TMainForm.BuildMenu;
|
||
|
||
function AddTop(const ACaption: string): TMenuItem;
|
||
begin
|
||
Result := TMenuItem.Create(Self);
|
||
Result.Caption := ACaption;
|
||
FMenu.Items.Add(Result);
|
||
end;
|
||
|
||
{ Возвращает созданный пункт: у пунктов с галкой её потом надо ставить
|
||
и снимать, а искать пункт по названию — способ ненадёжный. }
|
||
function AddItem(AParent: TMenuItem; const ACaption: string;
|
||
AHandler: TNotifyEvent; AShortCut: TShortCut = 0): TMenuItem;
|
||
var
|
||
Item: TMenuItem;
|
||
begin
|
||
Item := TMenuItem.Create(Self);
|
||
Item.Caption := ACaption;
|
||
Item.OnClick := AHandler;
|
||
Item.ShortCut := AShortCut;
|
||
AParent.Add(Item);
|
||
Result := Item;
|
||
end;
|
||
|
||
procedure AddSep(AParent: TMenuItem);
|
||
var
|
||
Item: TMenuItem;
|
||
begin
|
||
Item := TMenuItem.Create(Self);
|
||
Item.Caption := '-';
|
||
AParent.Add(Item);
|
||
end;
|
||
|
||
var
|
||
MFile, MEdit, MView, MProject, MHelp: TMenuItem;
|
||
begin
|
||
{ Подсказки всплывают почти сразу: на кнопке со значком они не
|
||
украшение, а единственный способ узнать, что она делает. Держатся
|
||
долго — читать там больше, чем одно слово. }
|
||
Application.ShowHint := True;
|
||
Application.HintPause := 100;
|
||
Application.HintHidePause := 15000;
|
||
|
||
{ Точный замер текста ставится до первой сборки субтитров: без него
|
||
размер подбирался бы по грубой оценке. }
|
||
InstallTextMeasure;
|
||
Application.OnException := @HandleException;
|
||
|
||
ApplyWindowIcon;
|
||
|
||
BuildJobIndicator;
|
||
FMenu := TMainMenu.Create(Self);
|
||
|
||
MFile := AddTop('Файл');
|
||
AddItem(MFile, 'Новый проект', @MenuNewProject, ShortCut(VK_N, [ssCtrl]));
|
||
AddItem(MFile, 'Открыть проект...', @MenuOpenProject, ShortCut(VK_O, [ssCtrl]));
|
||
|
||
FRecentMenu := TMenuItem.Create(Self);
|
||
FRecentMenu.Caption := 'Недавние проекты';
|
||
MFile.Add(FRecentMenu);
|
||
|
||
AddItem(MFile, 'Сохранить проект', @MenuSaveProject, ShortCut(VK_S, [ssCtrl]));
|
||
AddItem(MFile, 'Сохранить проект как...', @MenuSaveProjectAs);
|
||
AddSep(MFile);
|
||
AddItem(MFile, 'Добавить файлы в проект...', @ChooseAndAddFiles,
|
||
ShortCut(VK_I, [ssCtrl]));
|
||
AddSep(MFile);
|
||
AddItem(MFile, 'Собрать ролик...', @MenuExport, ShortCut(VK_E, [ssCtrl]));
|
||
AddItem(MFile, 'Собрать с перекодированием...', @MenuExportEncode,
|
||
ShortCut(VK_E, [ssCtrl, ssShift]));
|
||
AddItem(MFile, 'Перепаковка файлов...', @MenuRemux);
|
||
AddSep(MFile);
|
||
AddItem(MFile, 'Зависимости...', @MenuDeps);
|
||
AddSep(MFile);
|
||
AddItem(MFile, 'Выход', @MenuQuit, ShortCut(VK_Q, [ssCtrl]));
|
||
|
||
MEdit := AddTop('Правка');
|
||
AddItem(MEdit, 'Отменить', @MenuUndo, ShortCut(VK_Z, [ssCtrl]));
|
||
AddItem(MEdit, 'Повторить', @MenuRedo, ShortCut(VK_Y, [ssCtrl]));
|
||
AddSep(MEdit);
|
||
{ Вид реза теперь один. Раньше их было два — обычный, который при
|
||
сборке притягивался к опорному кадру, и точный. Притянутый рез уводил
|
||
картинку от звука, поэтому точным стал всякий, а отдельный пункт
|
||
потерял смысл. }
|
||
AddItem(MEdit, 'Разрезать по курсору', @MenuSplit, ShortCut(VK_S, []));
|
||
AddItem(MEdit, 'Удалить выделенное', @MenuDelete, ShortCut(VK_DELETE, []));
|
||
AddItem(MEdit, 'Выделить всё', @MenuSelectAll, ShortCut(VK_A, [ssCtrl]));
|
||
{ Пункт держит и подпись режима: по одному значку на кнопке не угадать,
|
||
что сейчас делает протяжка мышью. }
|
||
FSelectModeItem := AddItem(MEdit, 'Режим выделения', @MenuSelectMode,
|
||
ShortCut(VK_D, []));
|
||
AddItem(MEdit, 'Цветовой ключ клипа...', @MenuColorKey);
|
||
AddSep(MEdit);
|
||
AddItem(MEdit, 'Копировать клипы', @MenuCopyClips, ShortCut(VK_C, [ssCtrl]));
|
||
AddItem(MEdit, 'Вставить клипы по курсору', @MenuPasteClips,
|
||
ShortCut(VK_V, [ssCtrl]));
|
||
AddSep(MEdit);
|
||
AddItem(MEdit, 'Скопировать свойства клипа', @MenuCopyLook,
|
||
ShortCut(VK_C, [ssCtrl, ssShift]));
|
||
AddItem(MEdit, 'Применить свойства к выделенным', @MenuPasteLook,
|
||
ShortCut(VK_V, [ssCtrl, ssShift]));
|
||
AddSep(MEdit);
|
||
AddItem(MEdit, 'Отметить начало участка', @MenuRegionIn, ShortCut(VK_I, []));
|
||
AddItem(MEdit, 'Отметить конец участка', @MenuRegionOut, ShortCut(VK_O, []));
|
||
AddItem(MEdit, 'Снять отметки участка', @MenuRegionClear);
|
||
AddSep(MEdit);
|
||
AddItem(MEdit, 'Схлопнуть дыру под курсором', @MenuRipple,
|
||
ShortCut(VK_R, [ssCtrl, ssShift]));
|
||
AddItem(MEdit, 'Автосхлопывание при перетаскивании', @MenuToggleRipple,
|
||
ShortCut(VK_K, [ssCtrl]));
|
||
|
||
MView := AddTop('Вид');
|
||
{ Home и End назначены пунктами меню, а не обрабатываются в компоненте:
|
||
так они работают независимо от того, где сейчас фокус. Иначе их
|
||
перехватывал бы список файлов, переводя в нём выделение. }
|
||
AddItem(MView, 'В начало монтажа', @MenuGoStart, ShortCut(VK_HOME, []));
|
||
AddItem(MView, 'В конец монтажа', @MenuGoEnd, ShortCut(VK_END, []));
|
||
AddSep(MView);
|
||
AddItem(MView, 'Вписать весь проект', @MenuZoomFit, ShortCut(VK_0, [ssCtrl]));
|
||
AddItem(MView, 'Приблизить', @MenuZoomIn, ShortCut(VK_ADD, [ssCtrl]));
|
||
AddItem(MView, 'Отдалить', @MenuZoomOut, ShortCut(VK_SUBTRACT, [ssCtrl]));
|
||
AddSep(MView);
|
||
AddItem(MView, 'Журнал сообщений', @MenuToggleLog, ShortCut(VK_L, [ssCtrl]));
|
||
AddSep(MView);
|
||
FKeyPreviewItem := AddItem(MView, 'Ключ и прозрачность в предпросмотре',
|
||
@MenuTogglePreviewKey);
|
||
FKeyPreviewItem.AutoCheck := False;
|
||
FKeyPreviewItem.Checked := FSettings.PreviewKey;
|
||
|
||
MProject := AddTop('Проект');
|
||
AddItem(MProject, 'Сведения о проекте...', @MenuProjectInfo);
|
||
AddItem(MProject, 'Проверить и починить проект...', @MenuRepairProject);
|
||
AddSep(MProject);
|
||
AddItem(MProject, 'Добавить текст', @MenuAddText, ShortCut(VK_T, [ssCtrl]));
|
||
AddSep(MProject);
|
||
AddItem(MProject, 'Добавить дорожку', @MenuAddTrack);
|
||
AddItem(MProject, 'Удалить последнюю дорожку', @MenuRemoveTrack);
|
||
|
||
MHelp := AddTop('Справка');
|
||
AddItem(MHelp, 'О программе...', @MenuAbout);
|
||
|
||
{ Дважды, и оба раза нужны.
|
||
|
||
До присваивания — чтобы обработчики отрисовки стояли к первому показу.
|
||
После — чтобы задать подложку полосы: она задаётся через SetMenuInfo по
|
||
дескриптору меню, а дескриптор появляется только когда меню отдано
|
||
окну. Первый вызов до этого просто пропускал подложку, и справа от
|
||
последнего названия оставалась светлая полоса. }
|
||
ApplyDarkMenu(FMenu);
|
||
Menu := FMenu;
|
||
ApplyDarkMenu(FMenu);
|
||
end;
|
||
|
||
{ Показ фоновой работы.
|
||
|
||
Разбор звука читает файл целиком — на шести гигабайтах это больше
|
||
десяти секунд, и всё это время программа выглядит просто задумчивой.
|
||
Молчать об этом нельзя: непонятно, идёт ли что-то вообще.
|
||
|
||
Место справа в нижней полосе отводится сразу и насовсем, а надпись с
|
||
полоской показываются только когда работа есть. Так строка состояния и
|
||
показатель не наезжают друг на друга. }
|
||
{ Внутренняя ошибка не должна оставаться загадкой.
|
||
|
||
Окно «Access violation» без единого слова о том, где именно, не даёт
|
||
ничего: ошибка повторяется на каждый кадр воспроизведения, а найти её
|
||
негде. Поэтому мы перехватываем её сами и пишем в журнал разбор стека —
|
||
сборка идёт с отладочными сведениями, поэтому в нём видны имена файлов
|
||
и номера строк.
|
||
|
||
Окно показывается только на первую ошибку. Дальше они лишь считаются:
|
||
повторяющееся окно поверх воспроизведения невозможно закрыть. }
|
||
procedure TMainForm.HandleException(Sender: TObject; E: Exception);
|
||
var
|
||
Trace: string;
|
||
I: Integer;
|
||
Frames: PPointer;
|
||
begin
|
||
Inc(FErrorCount);
|
||
|
||
Trace := BackTraceStrFunc(ExceptAddr);
|
||
Frames := ExceptFrames;
|
||
for I := 0 to ExceptFrameCount - 1 do
|
||
Trace := Trace + LineEnding + ' ' + BackTraceStrFunc(Frames[I]);
|
||
|
||
Log(Format('ВНУТРЕННЯЯ ОШИБКА %d: %s: %s', [FErrorCount, E.ClassName,
|
||
E.Message]));
|
||
Log(' где: ' + Trace);
|
||
|
||
if FErrorCount = 1 then
|
||
ThemedMessageDlg('nlve',
|
||
E.ClassName + ': ' + E.Message + LineEnding + LineEnding +
|
||
'Разбор записан в журнал (nlve.log рядом с программой). ' +
|
||
'Следующие такие же ошибки будут только записываться.',
|
||
mtError, [mbOK], 0);
|
||
end;
|
||
|
||
{ Значок окна. Вшит в программу, потому что рядом с ней может ничего не
|
||
лежать. Значок самого файла программы под Windows задаётся не здесь, а
|
||
ресурсом при сборке — это отдельная история. }
|
||
procedure TMainForm.ApplyWindowIcon;
|
||
var
|
||
Stream: TMemoryStream;
|
||
begin
|
||
Stream := TMemoryStream.Create;
|
||
try
|
||
Stream.WriteBuffer(IconAppData[0], Length(IconAppData));
|
||
Stream.Position := 0;
|
||
try
|
||
Icon.LoadFromStream(Stream);
|
||
Application.Icon.Assign(Icon);
|
||
except
|
||
{ Со значком не вышло — работать это не мешает. }
|
||
end;
|
||
finally
|
||
Stream.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TMainForm.BuildJobIndicator;
|
||
const
|
||
JobWidth = 330;
|
||
LogButtonWidth = 28;
|
||
{ Журнал стоит после переключателя выделения: сперва то, что меняет
|
||
работу с монтажом, потом то, что показывает сообщения. }
|
||
LogButtonLeft = 478;
|
||
begin
|
||
FJobLabel := TLabel.Create(Self);
|
||
FJobLabel.Parent := pnlBottom;
|
||
FJobLabel.AutoSize := False;
|
||
FJobLabel.Alignment := taRightJustify;
|
||
FJobLabel.Anchors := [akTop, akRight];
|
||
FJobLabel.SetBounds(pnlBottom.ClientWidth - JobWidth - 12, 6,
|
||
JobWidth, 16);
|
||
FJobLabel.ParentColor := False;
|
||
FJobLabel.Font.Color := ThemeTextDim;
|
||
FJobLabel.Visible := False;
|
||
|
||
FJobBar := TThemedProgress.Create(Self);
|
||
FJobBar.Parent := pnlBottom;
|
||
FJobBar.Anchors := [akTop, akRight];
|
||
FJobBar.SetBounds(pnlBottom.ClientWidth - JobWidth - 12, 26, JobWidth, 6);
|
||
FJobBar.Visible := False;
|
||
|
||
{ Переключатель журнала. Стоит рядом с показателем работы: это две
|
||
вещи про одно и то же — что программа делает и что она об этом
|
||
рассказала. }
|
||
FLogButton := TThemedButton.Create(Self);
|
||
FLogButton.Parent := pnlBottom;
|
||
{ Рядом с прилипанием и схлопыванием: три переключателя читаются как
|
||
один набор, а не как случайно разбросанные значки. }
|
||
FLogButton.SetBounds(LogButtonLeft, 6, LogButtonWidth, 28);
|
||
FLogButton.Icon := tiLog;
|
||
{ Фокус переключателям не нужен: по ним щёлкают, а обходить их клавишей
|
||
Tab при работе с монтажом только мешает. }
|
||
FLogButton.TabStop := False;
|
||
FLogButton.Down := True;
|
||
FLogButton.OnClick := @LogButtonClick;
|
||
FLogButton.Hint := 'Журнал: спрятать или показать полосу с сообщениями';
|
||
|
||
{ Все кнопки нижней панели рассказывают о себе строкой состояния. }
|
||
UseStatusHints([btnSnap, btnGlue, btnCenter, btnRipple, btnRippleMenu,
|
||
btnSelectMode, FLogButton]);
|
||
|
||
UpdateStatusWidth;
|
||
|
||
{ Сто миллисекунд, а не триста: полоска должна ползти, а не дёргаться
|
||
ступеньками. }
|
||
FJobTimer := TTimer.Create(Self);
|
||
FJobTimer.Interval := 100;
|
||
FJobTimer.OnTimer := @JobTimerTick;
|
||
FJobTimer.Enabled := True;
|
||
end;
|
||
|
||
{ Как растёт полоска — см. AdvanceProgress в uAppTypes: там же она и
|
||
проверяется числами. }
|
||
procedure TMainForm.AdvanceJobBar;
|
||
const
|
||
{ Доля оставшегося до вехи расстояния за один шаг таймера. При ста
|
||
миллисекундах на шаг это примерно половина расстояния за секунду. }
|
||
StepShare = 0.07;
|
||
begin
|
||
FJobShown := AdvanceProgress(FJobShown, FJobReal, FJobNext, StepShare);
|
||
end;
|
||
|
||
procedure TMainForm.LogButtonClick(Sender: TObject);
|
||
begin
|
||
ApplyLogVisible(not memoLog.Visible);
|
||
end;
|
||
|
||
{ Новая надпись.
|
||
|
||
Кладётся на текстовую дорожку в место курсора. Дорожки нет — заводится:
|
||
просить сначала создать дорожку, а потом положить на неё текст значило
|
||
бы заставлять человека знать наше устройство. }
|
||
procedure TMainForm.MenuAddText(Sender: TObject);
|
||
var
|
||
Track: TTrack;
|
||
Clip: TClip;
|
||
I: Integer;
|
||
begin
|
||
Track := nil;
|
||
for I := 0 to FProject.TrackCount - 1 do
|
||
if FProject.Tracks[I].Kind = tkText then
|
||
begin
|
||
Track := FProject.Tracks[I];
|
||
Break;
|
||
end;
|
||
|
||
FProject.BeginChange;
|
||
|
||
if Track = nil then
|
||
Track := FProject.AddTrackOfKind(FProject.UniqueTrackName('Т'), tkText);
|
||
|
||
Clip := TClip.Create;
|
||
Clip.Id := FProject.NewId('c');
|
||
Clip.Kind := ckText;
|
||
Clip.TlStart := Max(0, FTimeline.Playhead);
|
||
{ Три секунды — столько держится короткая надпись, чтобы её успели
|
||
прочесть. Дальше человек растянет клип как захочет. }
|
||
Clip.Duration := 3;
|
||
Clip.Text := 'Надпись';
|
||
Clip.TextStyle := DefaultTextStyle;
|
||
Track.Add(Clip);
|
||
Track.Sort;
|
||
|
||
if not EditTextOf(Clip) then
|
||
begin
|
||
{ Передумал — клипа быть не должно, иначе на монтаже останется
|
||
пустая надпись, которую он не заказывал. }
|
||
Track.Remove(Clip);
|
||
FProject.CancelChange;
|
||
FTimeline.Invalidate;
|
||
Exit;
|
||
end;
|
||
|
||
FProject.ClearSelection;
|
||
Clip.Selected := True;
|
||
TimelineStructureChange(nil);
|
||
end;
|
||
|
||
function TMainForm.EditTextOf(AClip: TClip): Boolean;
|
||
var
|
||
{ Не Text: так называется свойство самой формы. }
|
||
Body: string;
|
||
Style: TTextStyle;
|
||
W, H: Integer;
|
||
begin
|
||
Result := False;
|
||
if AClip = nil then
|
||
Exit;
|
||
|
||
Body := AClip.Text;
|
||
Style := AClip.TextStyle;
|
||
W := FProject.Master.Width;
|
||
H := FProject.Master.Height;
|
||
if (W < 2) or (H < 2) then
|
||
begin
|
||
W := 1920;
|
||
H := 1080;
|
||
end;
|
||
|
||
if not EditTextClip(Body, Style, W, H) then
|
||
Exit;
|
||
|
||
AClip.Text := Body;
|
||
AClip.TextStyle := Style;
|
||
Result := True;
|
||
end;
|
||
|
||
procedure TMainForm.MenuAbout(Sender: TObject);
|
||
begin
|
||
ShowAboutForm;
|
||
end;
|
||
|
||
procedure TMainForm.MenuToggleLog(Sender: TObject);
|
||
begin
|
||
ApplyLogVisible(not memoLog.Visible);
|
||
end;
|
||
|
||
procedure TMainForm.ApplyLogVisible(AVisible: Boolean);
|
||
begin
|
||
memoLog.Visible := AVisible;
|
||
if not Assigned(FLogButton) then
|
||
Exit;
|
||
FLogButton.Down := AVisible;
|
||
if AVisible then
|
||
FLogButton.Hint := 'Журнал виден. Нажмите, чтобы спрятать.'
|
||
else
|
||
FLogButton.Hint := 'Журнал спрятан. Нажмите, чтобы показать.';
|
||
RefreshBarHint;
|
||
end;
|
||
|
||
{ Как растёт полоска.
|
||
|
||
Настоящая доля известна только вехами: файл разобран, вставка готова.
|
||
Между вехами не происходит ничего видимого, и полоска, стоящая на месте,
|
||
выглядит как зависшая программа.
|
||
|
||
Поэтому она ползёт сама — к следующей вехе, но никогда её не достигая:
|
||
каждый шаг покрывает малую долю оставшегося расстояния. Пока работа идёт
|
||
как задумано, веха приходит быстро и полоска прыгает к ней. Если работа
|
||
затянулась, шаги становятся всё мельче, и заполнение само собой
|
||
замедляется — ровно то поведение, которого ждут от такой полоски.
|
||
|
||
Назад она не идёт никогда: доля, единожды показанная, остаётся. }
|
||
|
||
|
||
{ Опрос по таймеру, а не уведомления из потоков: поток сообщает о готовом
|
||
файле, а не о ходе внутри файла, и на шестигигабайтном файле между
|
||
сообщениями проходят десятки секунд. Опрос показывает движение и там. }
|
||
procedure TMainForm.JobTimerTick(Sender: TObject);
|
||
var
|
||
{ Не Text: так называется свойство самой формы, а имена в Паскале
|
||
нечувствительны к регистру. }
|
||
Note: string;
|
||
Frac, Step: Double;
|
||
StepKnown: Boolean;
|
||
Total, Done, Kind: Integer;
|
||
begin
|
||
{$IFDEF LCLWIN32}
|
||
{ Заодно подновляем закраску остатка полосы меню.
|
||
|
||
Обработчика перерисовки рамки может не хватить: система трогает
|
||
полосу и по другим поводам, а рисуем мы поверх неё. Прямоугольник тот
|
||
же и цвет тот же, поэтому подновление не видно. }
|
||
PaintMenuBarTail(Self);
|
||
{$ENDIF}
|
||
|
||
Note := '';
|
||
Total := 0;
|
||
Done := 0;
|
||
Kind := 0;
|
||
{ Доля сделанного внутри текущего шага и есть ли она вообще. }
|
||
Step := 0;
|
||
StepKnown := False;
|
||
|
||
{ Порядок важен: показываем то, чего человек ждёт прямо сейчас.
|
||
|
||
Сборка вставок держит предпросмотр — до её конца монтаж играет
|
||
по-старому. Разбор звука и миниатюры не держат ничего, они лишь
|
||
дорисовывают то, что уже видно. }
|
||
if FGenerateBusy and Assigned(FGenerate) then
|
||
begin
|
||
Kind := 1;
|
||
Total := FGenerate.Total;
|
||
Done := FGenerate.Done;
|
||
Step := FGenerate.StepFraction;
|
||
StepKnown := FGenerate.StepKnown;
|
||
Note := FGenerate.StageText;
|
||
if Note = '' then
|
||
Note := 'Готовлю участки монтажа';
|
||
{ Заодно показываем на монтаже, какой именно участок пересобирается. }
|
||
FTimeline.SetBusyRange(FGenerate.BusyFrom, FGenerate.BusyTo);
|
||
end
|
||
else if Assigned(FPeaksThread) and (not FPeaksFinished) then
|
||
begin
|
||
Kind := 2;
|
||
Total := FPeaksThread.Total;
|
||
Done := FPeaksThread.Done;
|
||
if Total > 0 then
|
||
Note := Format('Разбор звука: %d из %d', [Min(Done + 1, Total), Total]);
|
||
end
|
||
else if Assigned(FThumbThread) then
|
||
begin
|
||
Kind := 3;
|
||
Total := FThumbThread.Total;
|
||
Done := FThumbThread.Done;
|
||
if (Total > 0) and (Done < Total) then
|
||
Note := Format('Миниатюры: %d из %d', [Min(Done + 1, Total), Total]);
|
||
end;
|
||
|
||
if Note = '' then
|
||
begin
|
||
if FJobLabel.Visible then
|
||
begin
|
||
FJobLabel.Visible := False;
|
||
FJobBar.Visible := False;
|
||
UpdateStatusWidth;
|
||
end;
|
||
{ Следующая работа начинается с пустой полоски, а не с того места, где
|
||
кончилась прошлая. }
|
||
FJobShown := 0;
|
||
FJobReal := 0;
|
||
FJobNext := 0;
|
||
FJobKind := 0;
|
||
FTimeline.SetBusyRange(0, 0);
|
||
Exit;
|
||
end;
|
||
|
||
if Kind <> FJobKind then
|
||
begin
|
||
FJobKind := Kind;
|
||
FJobShown := 0;
|
||
end;
|
||
|
||
if Total > 0 then
|
||
begin
|
||
FJobReal := (Done + Step) / Total;
|
||
if StepKnown then
|
||
{ Работа сама говорит, докуда дошла. Догадываться тут нечего и
|
||
нельзя: догадка разойдётся с числом, которое мы же и показываем,
|
||
и получится полная полоса рядом с нулём процентов. }
|
||
FJobNext := FJobReal
|
||
else
|
||
{ Замера ещё нет — только запустились. Полоса трогается с места,
|
||
чтобы было видно, что работа жива, но уходит недалеко: пустая
|
||
полоса и есть правда о начале работы. }
|
||
FJobNext := FJobReal + 0.05 / Total;
|
||
end
|
||
else
|
||
begin
|
||
{ Работа без счёта: ползём к концу, никогда его не достигая. }
|
||
FJobReal := 0;
|
||
FJobNext := 1;
|
||
end;
|
||
AdvanceJobBar;
|
||
Frac := FJobShown;
|
||
|
||
{ Число и полоса — одно и то же число.
|
||
|
||
Раньше полоса показывала догадку, а подпись — замер, и человек видел
|
||
полосу, заполненную на девять десятых, рядом с нулём процентов. Что
|
||
в этот момент происходит, по такой паре понять нельзя. Теперь
|
||
показывается ровно то, что нарисовано. }
|
||
FJobLabel.Caption := Note + Format(' — %d%%', [Round(Frac * 100)]);
|
||
FJobBar.Fraction := Frac;
|
||
if not FJobLabel.Visible then
|
||
begin
|
||
FJobLabel.Visible := True;
|
||
FJobBar.Visible := True;
|
||
UpdateStatusWidth;
|
||
end;
|
||
end;
|
||
|
||
{$IFDEF LCLWIN32}
|
||
procedure TMainForm.WMNCPaint(var Msg: TLMessage);
|
||
begin
|
||
inherited;
|
||
PaintMenuBarTail(Self);
|
||
end;
|
||
|
||
procedure TMainForm.WMNCActivate(var Msg: TLMessage);
|
||
begin
|
||
inherited;
|
||
PaintMenuBarTail(Self);
|
||
end;
|
||
{$ENDIF}
|
||
|
||
procedure TMainForm.FormShow(Sender: TObject);
|
||
var
|
||
I: Integer;
|
||
Added: Boolean;
|
||
Err: string;
|
||
begin
|
||
if FStarted then
|
||
Exit;
|
||
FStarted := True;
|
||
|
||
{ Журнал прячется здесь, а не при чтении настроек.
|
||
|
||
Спрятанный до первого показа окна, он не получает своего виджета
|
||
вовсе, и вернуть его потом уже нечем: свойство переключается,
|
||
а на экране ничего не меняется. Проверено на невидимом экране:
|
||
щелчок по кнопке журнала не менял ни пикселя, при том что запись в
|
||
журнале показывала Visible=True, высоту 135 и верх 743.
|
||
|
||
HandleNeeded — на случай, если до этого места дескриптор всё же не
|
||
создан: прятать можно только то, что уже существует. }
|
||
memoLog.HandleNeeded;
|
||
ApplyLogVisible(FSettings.LogVisible);
|
||
|
||
{ Подложка полосы меню задаётся здесь, а не при создании формы.
|
||
|
||
Она задаётся через SetMenuInfo по дескриптору меню, а тот появляется
|
||
вместе с дескриптором окна — то есть уже после создания формы. Вызов
|
||
из BuildMenu поэтому попадал на несозданный дескриптор и молча ничего
|
||
не делал: пункты рисовались нашими руками, а полоса правее последнего
|
||
названия оставалась светлой. }
|
||
ApplyDarkMenu(Menu);
|
||
PaintMenuBarTail(Self);
|
||
{$IFDEF LCLWIN32}
|
||
Log(MenuBarTailNote);
|
||
{$ENDIF}
|
||
|
||
StartPlayer;
|
||
RemindAboutDeps;
|
||
|
||
{ Файлы из командной строки попадают в список проекта. Так на программу
|
||
можно перетащить файлы из файлового менеджера.
|
||
|
||
Файл проекта — особый случай: его надо открыть, а не пытаться
|
||
разобрать как видео. }
|
||
Added := False;
|
||
for I := 1 to ParamCount do
|
||
begin
|
||
if not FileExists(ParamStr(I)) then
|
||
Continue;
|
||
|
||
if LowerCase(ExtractFileExt(ParamStr(I))) = '.nlve' then
|
||
begin
|
||
if FProject.LoadFromFile(ExpandFileName(ParamStr(I)), Err) then
|
||
begin
|
||
Log('Открыт проект: ' + FProject.FileName);
|
||
FTimeline.ZoomToFit;
|
||
FLastLoadedEdl := '';
|
||
RefreshPool;
|
||
UpdateRippleButton;
|
||
UpdateCaption;
|
||
SchedulePreview;
|
||
FCheckMisplacedOnShow := True;
|
||
end
|
||
else
|
||
Log('Не удалось открыть проект: ' + Err);
|
||
Continue;
|
||
end;
|
||
|
||
AddMediaFile(ExpandFileName(ParamStr(I)));
|
||
Added := True;
|
||
end;
|
||
if Added then
|
||
begin
|
||
RefreshPool;
|
||
UpdateCaption;
|
||
if lstPool.Items.Count > 0 then
|
||
lstPool.ItemIndex := 0;
|
||
end;
|
||
|
||
{ Спрашивать можно только теперь: окно показано, и вопрос не окажется
|
||
за кадром. Автосохранённая копия — первым делом: если прошлая работа
|
||
не дошла до файла, человек должен узнать об этом до того, как начнёт
|
||
правку поверх старого. }
|
||
if FCheckMisplacedOnShow then
|
||
begin
|
||
FCheckMisplacedOnShow := False;
|
||
OfferAutoSave;
|
||
CheckMisplacedClips;
|
||
end;
|
||
end;
|
||
|
||
{ Проверка не по одному месту, а разом: человеку нужен ответ «чего не
|
||
хватает», а не «на чём именно споткнулись первым». }
|
||
function TMainForm.MissingDeps: string;
|
||
var
|
||
Err: string;
|
||
begin
|
||
Result := '';
|
||
if not MpvLibLoaded then
|
||
Result := 'libmpv — без неё нет предпросмотра';
|
||
if not ToolsAvailable(Err) then
|
||
begin
|
||
if Result <> '' then
|
||
Result := Result + LineEnding;
|
||
Result := Result + 'ffmpeg — без него не собрать ролик';
|
||
end;
|
||
end;
|
||
|
||
{ Напоминание при запуске.
|
||
|
||
Программа без ffmpeg и libmpv открывается и даже даёт разложить клипы,
|
||
но ничего не покажет и ничего не соберёт. Молча об этом сообщать в
|
||
журнал мало: журнал можно и спрятать.
|
||
|
||
Три кнопки: открыть окно зависимостей, отложить, больше не напоминать.
|
||
Последняя запоминается в настройках. }
|
||
procedure TMainForm.RemindAboutDeps;
|
||
var
|
||
Missing: string;
|
||
Choice: Integer;
|
||
begin
|
||
if not FSettings.DepsReminder then
|
||
Exit;
|
||
Missing := MissingDeps;
|
||
if Missing = '' then
|
||
Exit;
|
||
|
||
Choice := ThemedChoiceDlg('nlve',
|
||
'Не хватает того, на чём программа работает:' + LineEnding +
|
||
LineEnding + Missing + LineEnding + LineEnding +
|
||
'Окно «Зависимости» умеет скачать недостающее с официальных сайтов.' +
|
||
LineEnding + 'Открыть его сейчас?',
|
||
['Открыть', 'Потом', 'Не напоминать']);
|
||
|
||
case Choice of
|
||
0: MenuDeps(nil);
|
||
2: FSettings.DepsReminder := False;
|
||
end;
|
||
end;
|
||
|
||
procedure TMainForm.StartPlayer;
|
||
var
|
||
Err: string;
|
||
begin
|
||
if not LoadMpvLib(Err) then
|
||
begin
|
||
Log('ОШИБКА: ' + Err);
|
||
SetStatus('Предпросмотр недоступен: нет libmpv.');
|
||
Exit;
|
||
end;
|
||
Log('libmpv загружена: ' + MpvLibFileName);
|
||
|
||
pnlVideo.HandleNeeded;
|
||
|
||
if not FPlayer.Initialize(Err) then
|
||
begin
|
||
Log('ОШИБКА: ' + Err);
|
||
SetStatus('Предпросмотр недоступен.');
|
||
Exit;
|
||
end;
|
||
Log('Предпросмотр готов.');
|
||
|
||
if not ToolsAvailable(Err) then
|
||
begin
|
||
Log('ВНИМАНИЕ: ' + Err);
|
||
SetStatus('ffmpeg не найден — сборка и генерация работать не будут.');
|
||
end;
|
||
end;
|
||
|
||
{ --- Мелочи интерфейса --- }
|
||
|
||
{ Урезание журнала до последних строк, когда файл перерос предел.
|
||
|
||
Читается целиком: предел небольшой, и возиться с чтением с конца ради
|
||
пары мегабайт незачем. }
|
||
procedure TMainForm.TrimLogFile;
|
||
var
|
||
L: TStringList;
|
||
Keep: Integer;
|
||
Found: TSearchRec;
|
||
Size: Int64;
|
||
begin
|
||
if not FileExists(FLogFilePath) then
|
||
Exit;
|
||
Size := 0;
|
||
if FindFirst(FLogFilePath, faAnyFile, Found) = 0 then
|
||
begin
|
||
Size := Found.Size;
|
||
FindClose(Found);
|
||
end;
|
||
if Size <= MaxLogFileSize then
|
||
Exit;
|
||
L := TStringList.Create;
|
||
try
|
||
try
|
||
L.LoadFromFile(FLogFilePath);
|
||
Keep := L.Count div 2;
|
||
while L.Count > Keep do
|
||
L.Delete(0);
|
||
L.Insert(0, '=== начало журнала урезано ===');
|
||
L.SaveToFile(FLogFilePath);
|
||
except
|
||
{ Не вышло урезать — не беда: журнал не работа, ради которой сюда
|
||
пришли. }
|
||
end;
|
||
finally
|
||
L.Free;
|
||
end;
|
||
end;
|
||
|
||
{ Дублирование журнала в файл рядом с программой.
|
||
|
||
Нужно ровно для одного случая: программа падает до того, как окно
|
||
успело появиться. Тогда всё, что она о себе рассказала, пропадает
|
||
вместе с окном, и причина остаётся неизвестной.
|
||
|
||
Файл не переписывается при запуске, а дописывается: разбираться обычно
|
||
приходится не с тем запуском, который идёт сейчас, а с прошлым, и
|
||
затирать его нельзя — второй запуск программы уносил бы единственное
|
||
свидетельство. Каждый запуск отделён строкой с датой и временем. Файл
|
||
урезается, когда перерастёт предел: бесконечно растущий журнал никому
|
||
не нужен.
|
||
|
||
Неудача записи ничего не значит — каталог может быть закрыт на запись,
|
||
и работать это мешать не должно. }
|
||
procedure TMainForm.LogToFile(const AText: string);
|
||
var
|
||
F: TextFile;
|
||
begin
|
||
if FLogFileBroken then
|
||
Exit;
|
||
try
|
||
if not FLogFileStarted then
|
||
begin
|
||
TrimLogFile;
|
||
FLogFileStarted := True;
|
||
LogToFile('');
|
||
LogToFile('=== запуск ' + FormatDateTime('dd.mm.yyyy hh:nn:ss', Now) +
|
||
' ===');
|
||
end;
|
||
AssignFile(F, FLogFilePath);
|
||
if FileExists(FLogFilePath) then
|
||
Append(F)
|
||
else
|
||
Rewrite(F);
|
||
try
|
||
WriteLn(F, AText);
|
||
finally
|
||
CloseFile(F);
|
||
end;
|
||
except
|
||
FLogFileBroken := True;
|
||
end;
|
||
end;
|
||
|
||
procedure TMainForm.Log(const AText: string);
|
||
begin
|
||
memoLog.Add(AText);
|
||
LogToFile(AText);
|
||
end;
|
||
|
||
{ Строка состояния — единственное место, где программа отвечает на
|
||
команду. Ответ команды нельзя затирать проходным сообщением: пересборка
|
||
предпросмотра случается после каждой правки и приходит через долю
|
||
секунды после нажатия, так что «Разрезано 3 клипа» человек просто не
|
||
успевал прочесть.
|
||
|
||
Поэтому у ответа на команду есть небольшой срок, в течение которого
|
||
проходные сообщения его не трогают. Другой ответ на команду его
|
||
заменяет сразу: свежий ответ важнее прежнего. }
|
||
procedure TMainForm.SetStatus(const AText: string; AAnswer: Boolean);
|
||
begin
|
||
if (not AAnswer) and (FStatusHoldUntil > Now) then
|
||
Exit;
|
||
if AAnswer then
|
||
FStatusHoldUntil := Now + StatusHoldTime
|
||
else
|
||
FStatusHoldUntil := 0;
|
||
{ Указатель стоит на кнопке нижней панели, и в строке сейчас её
|
||
подсказка. Затирать подсказку нельзя: человек читает её ровно
|
||
потому, что навёл мышь. Ответ ложится под подсказку и покажется,
|
||
как только указатель уйдёт с кнопки. }
|
||
if FHintControl <> nil then
|
||
FStatusBeforeHint := AText
|
||
else
|
||
lblStatus.Caption := AText;
|
||
end;
|
||
|
||
procedure TMainForm.UpdateCaption;
|
||
var
|
||
{ Не Name и не Position: оба имени заняты свойствами формы. }
|
||
ProjectName: string;
|
||
begin
|
||
if FProject.FileName = '' then
|
||
ProjectName := 'без имени'
|
||
else
|
||
ProjectName := ExtractFileName(FProject.FileName);
|
||
if FProject.Modified then
|
||
ProjectName := ProjectName + ' *';
|
||
Caption := 'nlve — ' + ProjectName;
|
||
end;
|
||
|
||
procedure TMainForm.UpdateTimeLabel;
|
||
begin
|
||
lblTime.Caption := FormatTimecode(FTimeline.Playhead) + ' / ' +
|
||
FormatTimecode(FProject.EndTime);
|
||
end;
|
||
|
||
procedure TMainForm.RefreshPool;
|
||
var
|
||
I: Integer;
|
||
Item: TMediaItem;
|
||
begin
|
||
lstPool.Items.BeginUpdate;
|
||
try
|
||
lstPool.Items.Clear;
|
||
{ Строки только несут номер: всё, что видно, рисуется вручную по
|
||
данным проекта, поэтому дублировать их в списке незачем. }
|
||
for I := 0 to FProject.PoolCount - 1 do
|
||
lstPool.Items.Add(ExtractFileName(FProject.Pool[I].Path));
|
||
finally
|
||
lstPool.Items.EndUpdate;
|
||
end;
|
||
lblPoolInfo.Caption := Format('%d %s в проекте',
|
||
[FProject.PoolCount,
|
||
Plural(FProject.PoolCount, 'файл', 'файла', 'файлов')]);
|
||
StartThumbs;
|
||
StartPeaks;
|
||
end;
|
||
|
||
{ Запускает изготовление недостающих миниатюр.
|
||
|
||
Один поток на всю очередь: миниатюры делаются последовательно, чтобы
|
||
не устраивать драку за диск при добавлении десятка файлов сразу. }
|
||
function TMainForm.ThumbIndexFor(const APath: string): Integer;
|
||
var
|
||
Idx: Integer;
|
||
begin
|
||
Result := -1;
|
||
if FThumbMap = nil then
|
||
Exit;
|
||
Idx := FThumbMap.IndexOf(APath);
|
||
if Idx >= 0 then
|
||
Result := PtrUInt(FThumbMap.Objects[Idx]) - 1;
|
||
end;
|
||
|
||
procedure TMainForm.StartThumbs;
|
||
var
|
||
Requests: TThumbRequests = nil;
|
||
I, N: Integer;
|
||
Item: TMediaItem;
|
||
begin
|
||
if Assigned(FThumbThread) then
|
||
begin
|
||
{ Предыдущая очередь ещё идёт — прерываем её: список изменился, и
|
||
часть работы могла стать ненужной. }
|
||
FThumbThread.Terminate;
|
||
FThumbThread.WaitFor;
|
||
FreeAndNil(FThumbThread);
|
||
end;
|
||
|
||
if FProject.PoolCount = 0 then
|
||
Exit;
|
||
|
||
SetLength(Requests, FProject.PoolCount);
|
||
N := 0;
|
||
for I := 0 to FProject.PoolCount - 1 do
|
||
begin
|
||
Item := FProject.Pool[I];
|
||
if ThumbIndexFor(Item.Path) >= 0 then
|
||
Continue;
|
||
{ Кадр берём из исходника, а не из приведённой копии: копии может ещё
|
||
не быть, а миниатюра нужна сразу. Ключом при этом остаётся исходный
|
||
путь — он не меняется. }
|
||
Requests[N].SourcePath := Item.Path;
|
||
Requests[N].TargetPath := ThumbPath(FProject.CacheDir, Item.Path);
|
||
Requests[N].Key := Item.Path;
|
||
if Item.Info.Kind = mkImage then
|
||
Requests[N].AtTime := 0
|
||
else
|
||
Requests[N].AtTime := ThumbTimeFor(Item.Info.Duration);
|
||
Inc(N);
|
||
end;
|
||
SetLength(Requests, N);
|
||
if N = 0 then
|
||
Exit;
|
||
|
||
FThumbThread := TThumbThread.Create(Requests);
|
||
FThumbThread.OnReady := @ThumbReady;
|
||
FThumbThread.Start;
|
||
end;
|
||
|
||
{ Разбор звука для формы волны. Отдельная очередь от миниатюр: разбор
|
||
идёт дольше, и держать миниатюры в ожидании звука незачем. }
|
||
procedure TMainForm.StartPeaks;
|
||
var
|
||
Requests: TPeaksRequests = nil;
|
||
I, N: Integer;
|
||
Item: TMediaItem;
|
||
Dummy: TPeaks;
|
||
begin
|
||
{ Ждать окончания разбора нельзя: он читает файл целиком, а это
|
||
гигабайты и десяток секунд. Ожидание идёт в главном потоке, и всё это
|
||
время окно не отвечает — меню не открывается вовсе.
|
||
|
||
Поэтому просто отмечаем, что список изменился: текущий проход
|
||
доработает и запустится заново. }
|
||
if Assigned(FPeaksThread) then
|
||
begin
|
||
if not FPeaksFinished then
|
||
begin
|
||
FPeaksRestart := True;
|
||
Exit;
|
||
end;
|
||
{ Уже завершился — ожидание мгновенное. }
|
||
FPeaksThread.WaitFor;
|
||
FreeAndNil(FPeaksThread);
|
||
end;
|
||
|
||
FPeaksRestart := False;
|
||
FPeaksFinished := False;
|
||
if FProject.PoolCount = 0 then
|
||
Exit;
|
||
|
||
SetLength(Requests, FProject.PoolCount);
|
||
N := 0;
|
||
for I := 0 to FProject.PoolCount - 1 do
|
||
begin
|
||
Item := FProject.Pool[I];
|
||
if not Item.Info.HasAudio then
|
||
Continue;
|
||
if CachedPeaks(FProject.CacheDir, Item.EffectivePath, Dummy) then
|
||
Continue;
|
||
Requests[N].SourcePath := Item.EffectivePath;
|
||
Requests[N].TargetPath := PeaksPath(FProject.CacheDir, Item.EffectivePath);
|
||
Inc(N);
|
||
end;
|
||
SetLength(Requests, N);
|
||
if N = 0 then
|
||
Exit;
|
||
|
||
FPeaksThread := TPeaksThread.Create(Requests);
|
||
FPeaksThread.OnReady := @PeaksReady;
|
||
FPeaksThread.OnTerminate := @PeaksDone;
|
||
{ Разбор звука не должен мешать работе: он тяжёлый и никуда не спешит. }
|
||
FPeaksThread.Priority := tpLowest;
|
||
FPeaksThread.Start;
|
||
end;
|
||
|
||
{ Проход разбора закончился. Освобождаем поток и, если за это время
|
||
список файлов менялся, начинаем заново. }
|
||
procedure TMainForm.PeaksDone(Sender: TObject);
|
||
begin
|
||
{ Освобождать поток прямо здесь нельзя: он ещё доживает свой цикл.
|
||
Отмечаем, что он закончил, а освободит его следующий заход. }
|
||
FPeaksFinished := True;
|
||
if FPeaksRestart then
|
||
StartPeaks;
|
||
end;
|
||
|
||
procedure TMainForm.PeaksReady(Sender: TObject; const ASourcePath: string);
|
||
begin
|
||
{ Запомненную неудачу надо забыть: пики только что появились. }
|
||
ForgetPeaks;
|
||
FTimeline.Invalidate;
|
||
end;
|
||
|
||
procedure TMainForm.ThumbReady(Sender: TObject; const ASourcePath,
|
||
AThumbPath: string);
|
||
var
|
||
Png: TPortableNetworkGraphic;
|
||
Bmp: TBitmap;
|
||
ImgIdx: Integer;
|
||
begin
|
||
if not FileExists(AThumbPath) then
|
||
Exit;
|
||
if ThumbIndexFor(ASourcePath) >= 0 then
|
||
Exit;
|
||
|
||
Png := TPortableNetworkGraphic.Create;
|
||
Bmp := TBitmap.Create;
|
||
try
|
||
try
|
||
Png.LoadFromFile(AThumbPath);
|
||
{ Список изображений принимает растр, а не картинку произвольного
|
||
формата, поэтому перерисовываем PNG в растр нужного размера. }
|
||
Bmp.SetSize(ThumbWidth, ThumbHeight);
|
||
Bmp.Canvas.Brush.Color := clBlack;
|
||
Bmp.Canvas.FillRect(0, 0, ThumbWidth, ThumbHeight);
|
||
Bmp.Canvas.Draw(0, 0, Png);
|
||
ImgIdx := FThumbs.Add(Bmp, nil);
|
||
except
|
||
{ Битая миниатюра — просто оставляем строку без картинки. }
|
||
Exit;
|
||
end;
|
||
finally
|
||
Bmp.Free;
|
||
Png.Free;
|
||
end;
|
||
|
||
FThumbMap.AddObject(ASourcePath, TObject(PtrUInt(ImgIdx + 1)));
|
||
lstPool.Invalidate;
|
||
end;
|
||
|
||
{ Колесо с Shift над журналом прокручивает его вбок.
|
||
|
||
Строки там бывают длиной в несколько экранов — команды ffmpeg целиком, —
|
||
и добраться до их конца иначе нечем: полоса прокрутки внизу есть, но
|
||
колесо само по себе на неё не действует. }
|
||
{ Своя отрисовка строки: кадр слева, название и параметры справа. }
|
||
procedure TMainForm.lstPoolDrawItem(Control: TWinControl; Index: Integer;
|
||
ARect: TRect; State: TOwnerDrawState);
|
||
var
|
||
C: TCanvas;
|
||
Item: TMediaItem;
|
||
ImgIdx, TextLeft: Integer;
|
||
begin
|
||
C := lstPool.Canvas;
|
||
|
||
{ Цвета берём свои, а не системные. clWindowText под Windows почти
|
||
чёрный, и на тёмном списке подписи к файлам пропадали. }
|
||
if odSelected in State then
|
||
C.Brush.Color := ThemeSelection
|
||
else
|
||
C.Brush.Color := ThemeSurface;
|
||
C.FillRect(ARect);
|
||
|
||
if (Index < 0) or (Index >= FProject.PoolCount) then
|
||
Exit;
|
||
Item := FProject.Pool[Index];
|
||
|
||
ImgIdx := ThumbIndexFor(Item.Path);
|
||
if ImgIdx >= 0 then
|
||
FThumbs.Draw(C, ARect.Left + 4, ARect.Top + 5, ImgIdx)
|
||
else
|
||
begin
|
||
{ Кадр ещё готовится — рисуем заглушку того же размера, чтобы строки
|
||
не прыгали, когда картинка появится. }
|
||
C.Brush.Color := clBlack;
|
||
C.FillRect(ARect.Left + 4, ARect.Top + 5,
|
||
ARect.Left + 4 + ThumbWidth, ARect.Top + 5 + ThumbHeight);
|
||
C.Font.Color := ThemeTextDim;
|
||
C.Brush.Style := bsClear;
|
||
C.TextOut(ARect.Left + 20, ARect.Top + 5 + ThumbHeight div 2 - 8, 'готовится...');
|
||
C.Brush.Style := bsSolid;
|
||
end;
|
||
|
||
TextLeft := ARect.Left + ThumbWidth + 12;
|
||
C.Brush.Style := bsClear;
|
||
if odSelected in State then
|
||
C.Font.Color := ThemeSelText
|
||
else
|
||
C.Font.Color := ThemeText;
|
||
|
||
C.Font.Style := [fsBold];
|
||
C.TextOut(TextLeft, ARect.Top + 8, ExtractFileName(Item.Path));
|
||
C.Font.Style := [];
|
||
if not (odSelected in State) then
|
||
C.Font.Color := ThemeTextDim;
|
||
C.TextOut(TextLeft, ARect.Top + 30, DescribeMedia(Item.Info));
|
||
if Item.Info.Duration > 0 then
|
||
C.TextOut(TextLeft, ARect.Top + 50,
|
||
SecondsToStr(Item.Info.Duration) + ' с');
|
||
if Item.NormalizedPath <> '' then
|
||
C.TextOut(TextLeft, ARect.Top + 70, 'приведён к проекту');
|
||
C.Brush.Style := bsSolid;
|
||
end;
|
||
|
||
{ Номер выбранного файла в списке проекта, минус один если ничего не выбрано. }
|
||
function SelectedPoolIndex(AList: TListBox): Integer;
|
||
begin
|
||
Result := AList.ItemIndex;
|
||
end;
|
||
|
||
procedure TMainForm.lstPoolClick(Sender: TObject);
|
||
var
|
||
Item: TMediaItem;
|
||
Idx: Integer;
|
||
begin
|
||
Idx := SelectedPoolIndex(lstPool);
|
||
if (Idx < 0) or (Idx >= FProject.PoolCount) then
|
||
Exit;
|
||
Item := FProject.Pool[Idx];
|
||
SetStatus(ExtractFileName(Item.Path) + ' — ' + DescribeMedia(Item.Info) +
|
||
', ' + SecondsToStr(Item.Info.Duration) + ' с');
|
||
end;
|
||
|
||
{ --- Список файлов --- }
|
||
|
||
procedure TMainForm.AddMediaFile(const APath: string);
|
||
var
|
||
Info: TMediaInfo;
|
||
Err: string;
|
||
Item: TMediaItem;
|
||
begin
|
||
if FProject.FindMediaByPath(APath) <> nil then
|
||
begin
|
||
Log('Уже в проекте: ' + ExtractFileName(APath));
|
||
Exit;
|
||
end;
|
||
|
||
Screen.Cursor := crHourGlass;
|
||
try
|
||
if not ProbeMedia(APath, Info, Err) then
|
||
begin
|
||
Log('Не удалось прочитать ' + ExtractFileName(APath) + ': ' + Err);
|
||
Exit;
|
||
end;
|
||
finally
|
||
Screen.Cursor := crDefault;
|
||
end;
|
||
|
||
FProject.BeginChange;
|
||
Item := FProject.AddMedia(APath, Info);
|
||
Log('Добавлен ' + ExtractFileName(APath) + ' — ' + DescribeMedia(Info));
|
||
if Info.ExtraStreams > 0 then
|
||
Log(' в файле ещё ' + IntToStr(Info.ExtraStreams) +
|
||
' поток(ов) — телеметрия или обложка, при сборке они отбрасываются');
|
||
if Item = FProject.Pool[0] then
|
||
begin
|
||
Log(' параметры проекта взяты из этого файла');
|
||
PrewarmInserts;
|
||
end;
|
||
end;
|
||
|
||
procedure TMainForm.ChooseAndAddFiles(Sender: TObject);
|
||
var
|
||
I: Integer;
|
||
begin
|
||
if not OpenMediaDialog.Execute then
|
||
Exit;
|
||
FSettings.LastMediaDir := ExtractFilePath(OpenMediaDialog.FileName);
|
||
for I := 0 to OpenMediaDialog.Files.Count - 1 do
|
||
AddMediaFile(OpenMediaDialog.Files[I]);
|
||
RefreshPool;
|
||
UpdateCaption;
|
||
end;
|
||
|
||
{ Кладёт файл из списка проекта на дорожку.
|
||
|
||
Общая точка для кнопки «На таймлайн» и для перетаскивания мышью:
|
||
предупреждение о несовпадении параметров и выбор места должны работать
|
||
одинаково, каким бы способом файл ни попал на монтаж.
|
||
|
||
ATrackIndex = -1 означает «завести новую дорожку внизу». }
|
||
function TMainForm.AddClipFromPool(APoolIndex, ATrackIndex: Integer;
|
||
const ATime: Double): Boolean;
|
||
var
|
||
Item: TMediaItem;
|
||
Track: TTrack;
|
||
Mismatches: TMismatches;
|
||
Duration, PlaceAt: Double;
|
||
NormPath, Wanted: string;
|
||
NeedKind: TTrackKind;
|
||
I: Integer;
|
||
begin
|
||
Result := False;
|
||
if (APoolIndex < 0) or (APoolIndex >= FProject.PoolCount) then
|
||
begin
|
||
SetStatus('Сначала выберите файл в списке.');
|
||
Exit;
|
||
end;
|
||
Item := FProject.Pool[APoolIndex];
|
||
|
||
if ATrackIndex < 0 then
|
||
begin
|
||
FProject.AddTrack(FProject.UniqueTrackName('V'));
|
||
ATrackIndex := FProject.TrackCount - 1;
|
||
Log('Заведена дорожка ' + FProject.Tracks[ATrackIndex].Name);
|
||
end;
|
||
if ATrackIndex >= FProject.TrackCount then
|
||
ATrackIndex := FProject.TrackCount - 1;
|
||
Track := FProject.Tracks[ATrackIndex];
|
||
|
||
{ Дорожка чужого вида не годится: клип на ней не увидит ни сборка, ни
|
||
предпросмотр — уплощение обходит дорожки по видам. Поэтому не кладём
|
||
туда молча, а находим подходящую и говорим, куда положили. }
|
||
{ Файл без картинки — только звук; всё остальное идёт на дорожку
|
||
картинки, а парный звук программа положит сама. }
|
||
if Item.Info.HasVideo or (Item.Info.Kind = mkImage) then
|
||
NeedKind := tkVideo
|
||
else
|
||
NeedKind := tkAudio;
|
||
if Track.Kind <> NeedKind then
|
||
begin
|
||
Wanted := Track.Name;
|
||
Track := nil;
|
||
for I := 0 to FProject.TrackCount - 1 do
|
||
if FProject.Tracks[I].Kind = NeedKind then
|
||
begin
|
||
Track := FProject.Tracks[I];
|
||
Break;
|
||
end;
|
||
if Track = nil then
|
||
begin
|
||
if NeedKind = tkAudio then
|
||
Track := FProject.AddTrackOfKind(FProject.UniqueTrackName('A'), tkAudio)
|
||
else
|
||
Track := FProject.AddTrack(FProject.UniqueTrackName('V'));
|
||
end;
|
||
Log(Format('Дорожка %s не для этого вида клипов — положил на %s.',
|
||
[Wanted, Track.Name]));
|
||
end;
|
||
|
||
{ Предупреждаем именно здесь, при попадании на монтаж: пока файл просто
|
||
лежит в списке, он ни с чем не склеивается. }
|
||
Mismatches := CompareToMaster(FProject.Master, Item.Info);
|
||
if Length(Mismatches) > 0 then
|
||
case AskAboutMismatch(Self, Item.Path, Mismatches) of
|
||
mcCancel:
|
||
Exit;
|
||
mcNormalize:
|
||
begin
|
||
NormPath := FProject.CacheDir + 'norm' + PathDelim +
|
||
ChangeFileExt(ExtractFileName(Item.Path), '') + '.mkv';
|
||
if not ForceDirectories(ExtractFilePath(NormPath)) then
|
||
begin
|
||
Log('Не удалось создать каталог для приведённых файлов.');
|
||
Exit;
|
||
end;
|
||
|
||
FNormalize := TFfmpegJob.Create(
|
||
ArgsNormalize(Item.Path, NormPath,
|
||
FProject.Master.Width, FProject.Master.Height,
|
||
FProject.Master.FpsNum, FProject.Master.FpsDen,
|
||
FProject.Master.VideoCodec, FProject.Master.PixFmt,
|
||
FProject.Master.AudioCodec,
|
||
FProject.Master.SampleRate, FProject.Master.Channels,
|
||
TransformFilter(Item.Transform, Item.Info.Width, Item.Info.Height,
|
||
FProject.Master.Width, FProject.Master.Height)),
|
||
Item.Info.Duration, 'Привожу к параметрам проекта', NormPath);
|
||
|
||
FNormalize.OnProgress := @NormalizeProgress;
|
||
FNormalize.OnLog := @NormalizeLog;
|
||
FNormalize.OnTerminate := @NormalizeDone;
|
||
|
||
FNormalizeUi := TProgressForm.Create(Self);
|
||
try
|
||
FNormalizeUi.Caption := 'Приведение к параметрам проекта';
|
||
FNormalizeUi.OnCancelRequest := @NormalizeCancel;
|
||
FNormalize.Start;
|
||
FNormalizeUi.ShowModal;
|
||
finally
|
||
FreeAndNil(FNormalizeUi);
|
||
end;
|
||
|
||
FNormalize.WaitFor;
|
||
if not FNormalize.Succeeded then
|
||
begin
|
||
Log('Приведение не удалось: ' + FNormalize.Message);
|
||
FreeAndNil(FNormalize);
|
||
Exit;
|
||
end;
|
||
FreeAndNil(FNormalize);
|
||
|
||
Item.NormalizedPath := NormPath;
|
||
{ Индекс опорных кадров относился к исходнику, у приведённой
|
||
копии он свой. }
|
||
Item.IndexLoaded := False;
|
||
Log('Файл приведён к параметрам проекта: ' + NormPath);
|
||
end;
|
||
end;
|
||
|
||
if Item.Info.Kind = mkImage then
|
||
Duration := DefaultImageDuration
|
||
else
|
||
Duration := Item.Info.Duration;
|
||
if Duration <= 0 then
|
||
Duration := DefaultImageDuration;
|
||
|
||
{ Ставим туда, куда попросили. Если там занято — в конец дорожки: молча
|
||
накладывать клипы друг на друга нельзя, порядок перекрытия должен быть
|
||
осознанным. }
|
||
PlaceAt := Max(0, ATime);
|
||
if (Track.ClipAt(PlaceAt) <> nil) or
|
||
(Track.ClipAt(PlaceAt + Duration - 0.001) <> nil) then
|
||
begin
|
||
PlaceAt := Track.EndTime;
|
||
Log('На дорожке ' + Track.Name + ' в этом месте занято — поставил в конец.');
|
||
end;
|
||
|
||
FProject.BeginChange;
|
||
{ Парой: клип картинки и его звук на соответствующей звуковой дорожке.
|
||
Связка держит их вместе, пока её не развяжут по Ctrl+G. }
|
||
FProject.AddClipPair(Track, Item, 0, Duration, PlaceAt);
|
||
FTimeline.Invalidate;
|
||
SchedulePreview;
|
||
UpdateCaption;
|
||
UpdateTimeLabel;
|
||
SetStatus('Добавлен клип на дорожку ' + Track.Name);
|
||
Result := True;
|
||
end;
|
||
|
||
procedure TMainForm.TimelineActiveTrackChange(Sender: TObject);
|
||
begin
|
||
if (FTimeline.ActiveTrack >= 0) and
|
||
(FTimeline.ActiveTrack < FProject.TrackCount) then
|
||
SetStatus('Выбрана дорожка ' +
|
||
FProject.Tracks[FTimeline.ActiveTrack].Name);
|
||
end;
|
||
|
||
{ Файл притащили мышью прямо на дорожку. }
|
||
procedure TMainForm.TimelineMediaDrop(Sender: TObject; ASource: TObject;
|
||
ATrackIndex: Integer; const ATime: Double);
|
||
begin
|
||
if ASource <> lstPool then
|
||
Exit;
|
||
AddClipFromPool(SelectedPoolIndex(lstPool), ATrackIndex, ATime);
|
||
end;
|
||
|
||
{ Дорожку завёл сам компонент, когда клип утащили ниже последней. }
|
||
procedure TMainForm.TimelineTrackAdded(Sender: TObject);
|
||
begin
|
||
UpdateCaption;
|
||
end;
|
||
|
||
{ --- Предпросмотр --- }
|
||
|
||
{ Готовит заготовку чёрной вставки заранее, чтобы первая дыра на монтаже
|
||
появилась мгновенно. }
|
||
procedure TMainForm.PrewarmInserts;
|
||
var
|
||
Requests: TGenRequests;
|
||
begin
|
||
if FGenerateBusy or (not FProject.MasterSet) then
|
||
Exit;
|
||
Requests := PrewarmRequests(FProject.CacheDir);
|
||
if Length(Requests) = 0 then
|
||
Exit;
|
||
|
||
FGenerateBusy := True;
|
||
FGenerate := TGenerateThread.Create(Requests, FProject.Master);
|
||
FGenerate.OnProgress := @GenerateProgress;
|
||
FGenerate.OnLog := @GenerateLog;
|
||
FGenerate.OnTerminate := @GenerateDone;
|
||
FGenerate.Start;
|
||
end;
|
||
|
||
procedure TMainForm.SchedulePreview;
|
||
begin
|
||
FPreviewDirty := True;
|
||
FPreviewTimer.Enabled := False;
|
||
FPreviewTimer.Enabled := True;
|
||
end;
|
||
|
||
procedure TMainForm.PreviewTimerTick(Sender: TObject);
|
||
begin
|
||
FPreviewTimer.Enabled := False;
|
||
if FPreviewDirty then
|
||
begin
|
||
FPreviewDirty := False;
|
||
RebuildPreview;
|
||
end;
|
||
end;
|
||
|
||
function TMainForm.PreviewNeedsFitting: Boolean;
|
||
var
|
||
T, C: Integer;
|
||
Track: TTrack;
|
||
Item: TMediaItem;
|
||
begin
|
||
Result := False;
|
||
if not FProject.MasterSet then
|
||
Exit;
|
||
|
||
for T := 0 to FProject.TrackCount - 1 do
|
||
begin
|
||
Track := FProject.Tracks[T];
|
||
for C := 0 to Track.Count - 1 do
|
||
begin
|
||
Item := FProject.FindMedia(Track.Clips[C].MediaId);
|
||
if (Item = nil) or (not Item.Info.HasVideo) then
|
||
Continue;
|
||
if (Item.Info.Width <= 0) or (Item.Info.Height <= 0) then
|
||
Continue;
|
||
|
||
{ Сравниваем именно соотношение сторон, а не размеры: файл 3840x2160
|
||
в проекте 2688x1512 показывается верно и без всякого фильтра —
|
||
mpv сам впишет его в панель, и картинка совпадёт до пикселя.
|
||
Умножение вместо деления, чтобы не ловить погрешность дробей. }
|
||
if Item.Info.Width * FProject.Master.Height <>
|
||
Item.Info.Height * FProject.Master.Width then
|
||
Exit(True);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TMainForm.ApplyPreviewFrame;
|
||
begin
|
||
if (FPlayer = nil) or (not FPlayer.Initialized) then
|
||
Exit;
|
||
|
||
if PreviewNeedsFitting then
|
||
begin
|
||
{ Порядок важен: сначала переводим декодирование в обычную память,
|
||
иначе фильтру нечего будет обрабатывать и он откажется собираться. }
|
||
FPlayer.SetHwdec('auto-copy');
|
||
FPlayer.SetVideoFilter(
|
||
PreviewFitFilter(FProject.Master.Width, FProject.Master.Height));
|
||
end
|
||
else
|
||
begin
|
||
{ И обратно: сначала снимаем фильтр, потом возвращаем быстрый путь. }
|
||
FPlayer.SetVideoFilter('');
|
||
FPlayer.SetHwdec('auto-safe');
|
||
end;
|
||
end;
|
||
|
||
procedure TMainForm.RebuildPreview;
|
||
var
|
||
Segments, AudioSegs, TrackSegs: TFlatSegmentArray;
|
||
Overlays: TPreviewOverlays;
|
||
GenMaster: TMediaInfo;
|
||
Missing, TrackMissing: TGenRequests;
|
||
I, J: Integer;
|
||
TotalLen: Double;
|
||
begin
|
||
if (FPlayer = nil) or (not FPlayer.Initialized) then
|
||
Exit;
|
||
if FGenerateBusy then
|
||
begin
|
||
{ Пока идёт создание вставок, пересборку откладываем: иначе запустим
|
||
второй такой же поток.
|
||
|
||
Но сперва смотрим, нужна ли ещё та работа, что идёт. Дыру могли
|
||
закрыть, клип подвинуть — и тогда вставка делается впустую, а
|
||
чёрная минута в 2688x1512 считается не мгновенно. Ненужное
|
||
прекращаем: поток сам доложит о завершении, и пересборка пойдёт по
|
||
свежей расстановке. }
|
||
if Assigned(FGenerate) and (not GenerationStillNeeded) then
|
||
begin
|
||
Log('Расстановка изменилась — прекращаю делать ненужные вставки.');
|
||
SetStatus('Расстановка изменилась, лишние вставки отменены.');
|
||
FGenerate.RequestCancel;
|
||
end;
|
||
FPreviewDirty := True;
|
||
FPreviewTimer.Enabled := True;
|
||
Exit;
|
||
end;
|
||
|
||
{ Уплощение для предпросмотра: клипы, которые кладутся поверх, идут
|
||
отдельно. Плеер положит их сам, ничего не собирая. }
|
||
if not FlattenPreview(FProject, Segments, AudioSegs, Overlays, Missing,
|
||
FSettings.PreviewKey) then
|
||
begin
|
||
FPlayer.Stop;
|
||
FLastLoadedEdl := '';
|
||
FPreviewOverlayUrl := '';
|
||
FPreviewOverlayWindows := nil;
|
||
UpdateTimeLabel;
|
||
Exit;
|
||
end;
|
||
|
||
BuildOverlayPreview(Overlays, TotalDuration(Segments));
|
||
|
||
{ Текст поверх картинки рисует сам плеер: ему отдаётся файл разметки,
|
||
а не пересобранный кусок. Поэтому правка текста видна сразу. }
|
||
UpdateSubtitles;
|
||
|
||
{ Участки с прозрачностью и переходами плееру не по зубам: список
|
||
кусков накладывать не умеет. Подставляем вместо них заранее
|
||
посчитанные файлы, а чего ещё нет — заказываем. }
|
||
ResolveLayers(FProject, Segments, Missing);
|
||
|
||
{ Каждая звуковая дорожка идёт своим списком кусков: они смешиваются, а
|
||
не побеждают друг друга. Дыры в каждой дорожке свои, и вставки тишины
|
||
под них нужны свои — без этого список ссылается на несуществующий
|
||
файл, плеер его не открывает, и дорожка молчит целиком. }
|
||
FPreviewAudioUrls := nil;
|
||
FPreviewAudioTracks := nil;
|
||
TotalLen := Max(AudibleEnd(FProject, tkVideo), AudibleEnd(FProject, tkAudio));
|
||
for I := 0 to FProject.TrackCount - 1 do
|
||
begin
|
||
if FProject.Tracks[I].Kind <> tkAudio then
|
||
Continue;
|
||
if not FProject.TrackAudible(FProject.Tracks[I]) then
|
||
Continue;
|
||
if FProject.Tracks[I].Count = 0 then
|
||
Continue;
|
||
if not FlattenAudioTrack(FProject, FProject.Tracks[I], TotalLen,
|
||
TrackSegs, TrackMissing) then
|
||
Continue;
|
||
for J := 0 to High(TrackMissing) do
|
||
begin
|
||
SetLength(Missing, Length(Missing) + 1);
|
||
Missing[High(Missing)] := TrackMissing[J];
|
||
end;
|
||
SetLength(FPreviewAudioUrls, Length(FPreviewAudioUrls) + 1);
|
||
FPreviewAudioUrls[High(FPreviewAudioUrls)] := BuildEdlUri(TrackSegs);
|
||
{ Запоминаем сами дорожки: громкости потом берутся ровно по этому
|
||
списку. Пересчитывать его отдельным проходом нельзя — стоит одному
|
||
проходу пропустить дорожку, и громкости съедут на соседние. Тогда
|
||
дорожка с нулевой громкостью заглушила бы чужую. }
|
||
SetLength(FPreviewAudioTracks, Length(FPreviewAudioTracks) + 1);
|
||
FPreviewAudioTracks[High(FPreviewAudioTracks)] := FProject.Tracks[I].Id;
|
||
end;
|
||
|
||
if Length(Missing) > 0 then
|
||
begin
|
||
FGenerateBusy := True;
|
||
SetStatus('Готовлю вставки для предпросмотра...');
|
||
{ Вставки — картинки и связки — попадают в ролик наравне со съёмкой,
|
||
поэтому целятся в тот же битрейт. }
|
||
GenMaster := FProject.Master;
|
||
GenMaster.VideoBitrate := FProject.MaxVideoBitrate;
|
||
FGenerate := TGenerateThread.Create(Missing, GenMaster);
|
||
FGenerate.OnProgress := @GenerateProgress;
|
||
FGenerate.OnLog := @GenerateLog;
|
||
FGenerate.OnTerminate := @GenerateDone;
|
||
FGenerate.Start;
|
||
Exit;
|
||
end;
|
||
|
||
LoadPreviewEdl(Segments, AudioSegs);
|
||
end;
|
||
|
||
{ Список кусков оверлея и окна его показа.
|
||
|
||
Список должен покрывать монтаж от начала и без разрывов: плеер
|
||
выравнивает дорожки по времени, и дыра сдвинула бы всё, что после неё.
|
||
Промежутки заполняются тем же файлом — показывать его там всё равно
|
||
никто не будет, за это отвечают окна. }
|
||
procedure TMainForm.BuildOverlayPreview(const AOverlays: TPreviewOverlays;
|
||
const ATotal: Double);
|
||
var
|
||
Segs: TFlatSegmentArray;
|
||
Win: TOverlayWindow;
|
||
I, N: Integer;
|
||
At: Double;
|
||
|
||
procedure Push(const APath: string; const AStart, ADuration: Double);
|
||
begin
|
||
if ADuration <= 0.001 then
|
||
Exit;
|
||
SetLength(Segs, N + 1);
|
||
Segs[N] := Default(TFlatSegment);
|
||
Segs[N].FilePath := APath;
|
||
Segs[N].SrcStart := AStart;
|
||
Segs[N].Duration := ADuration;
|
||
Inc(N);
|
||
end;
|
||
|
||
begin
|
||
FPreviewOverlayUrl := '';
|
||
FPreviewOverlayWindows := nil;
|
||
if Length(AOverlays) = 0 then
|
||
Exit;
|
||
|
||
N := 0;
|
||
At := 0;
|
||
for I := 0 to High(AOverlays) do
|
||
begin
|
||
{ Промежуток до этого куска — заполнитель из того же файла. }
|
||
if AOverlays[I].TlStart > At + 0.001 then
|
||
Push(AOverlays[I].FilePath, 0, AOverlays[I].TlStart - At);
|
||
Push(AOverlays[I].FilePath, AOverlays[I].SrcStart,
|
||
AOverlays[I].TlEnd - AOverlays[I].TlStart);
|
||
At := AOverlays[I].TlEnd;
|
||
|
||
Win := Default(TOverlayWindow);
|
||
Win.TlStart := AOverlays[I].TlStart;
|
||
Win.TlEnd := AOverlays[I].TlEnd;
|
||
Win.Filter := AOverlays[I].Filter;
|
||
Win.X := AOverlays[I].X;
|
||
Win.Y := AOverlays[I].Y;
|
||
Win.Width := AOverlays[I].Width;
|
||
Win.Height := AOverlays[I].Height;
|
||
SetLength(FPreviewOverlayWindows, Length(FPreviewOverlayWindows) + 1);
|
||
FPreviewOverlayWindows[High(FPreviewOverlayWindows)] := Win;
|
||
end;
|
||
|
||
{ Хвост после последнего куска не нужен: наложение там выключено, а
|
||
плеер спокойно доигрывает основу без второй дорожки. }
|
||
if N = 0 then
|
||
begin
|
||
FPreviewOverlayWindows := nil;
|
||
Exit;
|
||
end;
|
||
FPreviewOverlayUrl := BuildEdlUri(Segs);
|
||
end;
|
||
|
||
{ Делает ли идущая генерация то, что монтажу ещё нужно.
|
||
|
||
Уплощение считается заново — оно дешёвое, ffmpeg не запускает. Если ни
|
||
одна из готовящихся вставок в новом списке не нужна, работу можно
|
||
прекращать. Ошибиться тут не страшно: отменённое, если оно всё же
|
||
понадобится, закажут заново на следующей пересборке. }
|
||
{ Нужна ли ещё та работа, что идёт сейчас.
|
||
|
||
Спрашивать по одному только списку недостающего нельзя, и это стоило
|
||
повисшей сборки. Недостающее — то, чего нет на диске; а у куска,
|
||
который делается прямо сейчас, файл уже есть: ffmpeg создаёт его в
|
||
первую же секунду и пишет до конца. Поэтому сведённый кусок в списке
|
||
недостающего не появлялся, проверка отвечала «не нужен», работа
|
||
отменялась в разгаре — и начиналась заново с нуля.
|
||
|
||
На коротком затухании это проходило незаметно: кусок успевал
|
||
посчитаться между правками. На затухании в семьдесят секунд, которое
|
||
считается полторы минуты, любая следующая правка сбрасывала работу, и
|
||
сборка не заканчивалась никогда.
|
||
|
||
Поэтому спрашиваем иначе: нужен ли расстановке сам этот путь — неважно,
|
||
лежит он уже на диске или ещё пишется. }
|
||
function TMainForm.GenerationStillNeeded: Boolean;
|
||
var
|
||
Segs, Auds, TrackSegs: TFlatSegmentArray;
|
||
Ovl: TPreviewOverlays;
|
||
Missing, TrackMissing: TGenRequests;
|
||
Wanted: TStringList;
|
||
TotalLen: Double;
|
||
I, J: Integer;
|
||
begin
|
||
Result := False;
|
||
if not Assigned(FGenerate) then
|
||
Exit;
|
||
if not FlattenPreview(FProject, Segs, Auds, Ovl, Missing,
|
||
FSettings.PreviewKey) then
|
||
Exit;
|
||
|
||
Wanted := TStringList.Create;
|
||
try
|
||
ResolveLayers(FProject, Segs, Missing, Wanted);
|
||
|
||
{ Звуковые дорожки считаются тем же путём, что и при пересборке:
|
||
вставки тишины под дыры у каждой дорожки свои, и они тоже могут
|
||
делаться прямо сейчас. }
|
||
TotalLen := Max(AudibleEnd(FProject, tkVideo), AudibleEnd(FProject, tkAudio));
|
||
for I := 0 to FProject.TrackCount - 1 do
|
||
begin
|
||
if FProject.Tracks[I].Kind <> tkAudio then
|
||
Continue;
|
||
if not FProject.TrackAudible(FProject.Tracks[I]) then
|
||
Continue;
|
||
if FProject.Tracks[I].Count = 0 then
|
||
Continue;
|
||
FlattenAudioTrack(FProject, FProject.Tracks[I], TotalLen,
|
||
TrackSegs, TrackMissing, Wanted);
|
||
end;
|
||
|
||
for J := 0 to FGenerate.TargetCount - 1 do
|
||
if Wanted.IndexOf(FGenerate.TargetPath(J)) >= 0 then
|
||
Exit(True);
|
||
finally
|
||
Wanted.Free;
|
||
end;
|
||
|
||
for I := 0 to High(Missing) do
|
||
for J := 0 to FGenerate.TargetCount - 1 do
|
||
if Missing[I].TargetPath = FGenerate.TargetPath(J) then
|
||
Exit(True);
|
||
end;
|
||
|
||
procedure TMainForm.LoadPreviewEdl(const ASegments, AAudio: TFlatSegmentArray);
|
||
var
|
||
Edl, AudioEdl: string;
|
||
Pos, Total: Double;
|
||
WasPaused: Boolean;
|
||
I: Integer;
|
||
begin
|
||
{ Кадр проекта задаётся до загрузки: mpv должен показывать то, что
|
||
получится в готовом ролике, а не размер очередного исходника. Файл
|
||
другого соотношения сторон иначе выглядел бы в предпросмотре во весь
|
||
экран, а в ролике — с полями по краям. }
|
||
ApplyPreviewFrame;
|
||
|
||
Edl := BuildEdlUri(ASegments);
|
||
{ Списки кусков звуковых дорожек уже построены при пересборке: там же
|
||
проверено, что все вставки тишины существуют. }
|
||
AudioEdl := '';
|
||
for I := 0 to High(FPreviewAudioUrls) do
|
||
AudioEdl := AudioEdl + FPreviewAudioUrls[I] + '|';
|
||
{ Наложение входит в сравнение наравне со звуком: сдвинули оверлей —
|
||
список кусков основы мог не измениться, а показывать надо иначе. }
|
||
AudioEdl := AudioEdl + '#' + FPreviewOverlayUrl;
|
||
for I := 0 to High(FPreviewOverlayWindows) do
|
||
AudioEdl := AudioEdl + Format('|%s@%d:%d:%s-%s',
|
||
[FPreviewOverlayWindows[I].Filter,
|
||
FPreviewOverlayWindows[I].X, FPreviewOverlayWindows[I].Y,
|
||
SecondsToStr(FPreviewOverlayWindows[I].TlStart),
|
||
SecondsToStr(FPreviewOverlayWindows[I].TlEnd)]);
|
||
|
||
{ Список кусков запоминаем всегда, даже если строка не изменилась:
|
||
громкость в неё не входит, а брать её потом неоткуда. }
|
||
FPreviewSegments := AAudio;
|
||
FLastVolumeSent := -1;
|
||
if (Edl = FLastLoadedEdl) and (AudioEdl = FLastLoadedAudioEdl) then
|
||
Exit;
|
||
|
||
Pos := FTimeline.Playhead;
|
||
{ Курсор мог оказаться за концом монтажа, если правка его укоротила.
|
||
Просить у плеера несуществующее время бессмысленно. }
|
||
Total := TotalDuration(ASegments);
|
||
if Pos > Total then
|
||
Pos := Max(0, Total - 0.05);
|
||
WasPaused := FPlayer.Paused;
|
||
|
||
{ Позиция и состояние паузы задаются прямо при загрузке, а не отдельной
|
||
перемоткой следом. Иначе mpv успевает начать с нуля, и на каждой
|
||
правке монтажа слышен и виден кусок не оттуда. }
|
||
{ Внешний звук назначается до загрузки: он часть того, что открывается. }
|
||
FPlayer.SetAudioSources(FPreviewAudioUrls);
|
||
FPlayer.SetVideoOverlay(FPreviewOverlayUrl, FPreviewOverlayWindows);
|
||
FPlayer.LoadUrl(Edl, Format('start=%s,pause=%s',
|
||
[SecondsToStr(Pos), BoolToStr(WasPaused, 'yes', 'no')]));
|
||
FLastLoadedEdl := Edl;
|
||
FLastLoadedAudioEdl := AudioEdl;
|
||
|
||
{ Пока плеер не доедет, его сообщения о позиции игнорируются — иначе
|
||
курсор на монтаже прыгнул бы в начало при каждой правке. }
|
||
FSeekTarget := Pos;
|
||
FSeekPending := True;
|
||
FSeekWaitTicks := 0;
|
||
|
||
{ Кадрирование выставляется заново после каждой загрузки.
|
||
|
||
Обрезка на выводе — свойство плеера, а не списка кусков: она
|
||
переживает загрузку и осталась бы от прошлого монтажа. А при открытии
|
||
проекта курсор не двигается вовсе, и без этого вызова первый клип
|
||
показывался бы без своего кадрирования до первого щелчка по монтажу. }
|
||
FLastCropKey := '';
|
||
ApplyCropAt(Pos);
|
||
|
||
SetStatus(Format('Предпросмотр: %d %s, %s с',
|
||
[Length(ASegments), Plural(Length(ASegments), 'кусок', 'куска', 'кусков'),
|
||
SecondsToStr(TotalDuration(ASegments))]));
|
||
UpdateTimeLabel;
|
||
end;
|
||
|
||
{ Ставит плееру громкость того куска, который звучит сейчас.
|
||
|
||
Композитинга нет, поэтому в каждый момент звучит ровно один кусок, и
|
||
громкость всего вывода можно просто приравнять его громкости. Ставим
|
||
только при изменении: команда на каждый кадр была бы напрасной. }
|
||
{ --- Недавние проекты --- }
|
||
|
||
procedure TMainForm.RefreshRecentMenu;
|
||
var
|
||
I: Integer;
|
||
Item: TMenuItem;
|
||
begin
|
||
if FRecentMenu = nil then
|
||
Exit;
|
||
FRecentMenu.Clear;
|
||
|
||
for I := 0 to FSettings.RecentProjects.Count - 1 do
|
||
begin
|
||
Item := TMenuItem.Create(FRecentMenu);
|
||
{ Номер в начале даёт быстрый выбор глазами, а полный путь в подсказке
|
||
различает одноимённые проекты из разных папок. }
|
||
Item.Caption := Format('%d. %s',
|
||
[I + 1, ExtractFileName(FSettings.RecentProjects[I])]);
|
||
Item.Hint := FSettings.RecentProjects[I];
|
||
Item.Tag := I;
|
||
Item.OnClick := @OpenRecentProject;
|
||
FRecentMenu.Add(Item);
|
||
end;
|
||
|
||
FRecentMenu.Enabled := FSettings.RecentProjects.Count > 0;
|
||
|
||
{ Пункты добавлены только что, своих цветов у них ещё нет. }
|
||
ApplyDarkMenu(FRecentMenu.GetParentMenu);
|
||
end;
|
||
|
||
procedure TMainForm.OpenRecentProject(Sender: TObject);
|
||
var
|
||
Idx: Integer;
|
||
Path: string;
|
||
begin
|
||
Idx := TMenuItem(Sender).Tag;
|
||
if (Idx < 0) or (Idx >= FSettings.RecentProjects.Count) then
|
||
Exit;
|
||
Path := FSettings.RecentProjects[Idx];
|
||
|
||
if not FileExists(Path) then
|
||
begin
|
||
ThemedMessageDlg('nlve', 'Файл больше не существует:' + LineEnding + Path,
|
||
mtWarning, [mbOK], 0);
|
||
FSettings.RecentProjects.Delete(Idx);
|
||
RefreshRecentMenu;
|
||
Exit;
|
||
end;
|
||
|
||
if not ConfirmDiscard then
|
||
Exit;
|
||
OpenProjectFile(Path);
|
||
end;
|
||
|
||
{ Открытие проекта из файла. Общая точка для меню, списка недавних и
|
||
командной строки: иначе часть из них забывала бы что-нибудь обновить. }
|
||
function TMainForm.OpenProjectFile(const APath: string): Boolean;
|
||
var
|
||
Err: string;
|
||
begin
|
||
Result := FProject.LoadFromFile(APath, Err);
|
||
if not Result then
|
||
begin
|
||
ThemedMessageDlg('nlve', Err, mtError, [mbOK], 0);
|
||
Exit;
|
||
end;
|
||
|
||
FTimeline.Playhead := 0;
|
||
FTimeline.ZoomToFit;
|
||
FLastLoadedEdl := '';
|
||
RefreshPool;
|
||
UpdateRippleButton;
|
||
UpdateCaption;
|
||
SchedulePreview;
|
||
|
||
FSettings.NoteRecentProject(FProject.FileName);
|
||
RefreshRecentMenu;
|
||
Log('Открыт проект: ' + FProject.FileName);
|
||
{ Если рядом лежит копия новее проекта — значит прошлая работа не дошла
|
||
до файла, и об этом надо сказать сразу при открытии. }
|
||
OfferAutoSave;
|
||
CheckMisplacedClips;
|
||
end;
|
||
|
||
{ --- Схлопывание --- }
|
||
|
||
{ Кнопка показывает и состояние, и режим: утоплена — автосхлопывание
|
||
включено, надпись говорит, на какие дорожки оно действует. }
|
||
{ Клипы на дорожках чужого вида: находим и предлагаем перенести.
|
||
|
||
Такой клип нарисован на монтаже, но в ролик не попадает: уплощение
|
||
обходит дорожки по видам и клип с чужой дорожки не видит. Пропажа тихая
|
||
— сборка проходит без единой жалобы, а в готовом файле фотографии или
|
||
надписи нет. Проверено на живом проекте, где фотография оказалась на
|
||
текстовой дорожке, а надпись — на дорожке картинки.
|
||
|
||
Молча переносить нельзя: человек мог положить клип туда осознанно, и
|
||
внезапно переехавший клип — сюрприз хуже пропажи. Поэтому спрашиваем. }
|
||
procedure TMainForm.CheckMisplacedClips;
|
||
var
|
||
N: Integer;
|
||
begin
|
||
N := FProject.MisplacedClipCount;
|
||
if N = 0 then
|
||
Exit;
|
||
|
||
Log(Format('ВНИМАНИЕ: %d %s на дорожках чужого вида — в сборку они не попадут.',
|
||
[N, Plural(N, 'клип', 'клипа', 'клипов')]));
|
||
|
||
if ThemedMessageDlg('nlve',
|
||
Format('В проекте %d %s лежит на дорожках не своего вида: ' +
|
||
'картинка на звуковой или текстовой, надпись на дорожке картинки.' +
|
||
LineEnding + LineEnding +
|
||
'Такой клип виден на монтаже, но в готовый ролик не попадает — ' +
|
||
'ни в сборку, ни в предпросмотр.' + LineEnding + LineEnding +
|
||
'Перенести их на подходящие дорожки? Время клипов не изменится.',
|
||
[N, Plural(N, 'клип', 'клипа', 'клипов')]),
|
||
mtWarning, [mbYes, mbNo], 0) <> mrYes then
|
||
begin
|
||
SetStatus(Format('%d %s не попадёт в сборку: они на дорожках чужого вида.',
|
||
[N, Plural(N, 'клип', 'клипа', 'клипов')]));
|
||
Exit;
|
||
end;
|
||
|
||
FProject.BeginChange;
|
||
N := FProject.FixMisplacedClips;
|
||
FTimeline.Invalidate;
|
||
FLastLoadedEdl := '';
|
||
SchedulePreview;
|
||
UpdateCaption;
|
||
Log(Format('Перенесено на подходящие дорожки: %d.', [N]));
|
||
SetStatus(Format('Перенесено клипов: %d.', [N]), True);
|
||
end;
|
||
|
||
procedure TMainForm.UpdateRippleButton;
|
||
var
|
||
ModeText: string;
|
||
begin
|
||
if FProject.RippleMode = rmAllTracks then
|
||
ModeText := 'все дорожки'
|
||
else
|
||
ModeText := 'текущая дорожка';
|
||
btnRipple.Down := FProject.RippleEnabled;
|
||
if FProject.RippleEnabled then
|
||
btnRipple.Hint := 'Автосхлопывание включено, режим: ' + ModeText + '.'
|
||
else
|
||
btnRipple.Hint := 'Автосхлопывание выключено, режим: ' + ModeText + '.';
|
||
{ Коротко: подсказка идёт одной строкой в нижней панели, и длинный
|
||
хвост там просто обрезается. }
|
||
btnRipple.Hint := btnRipple.Hint + LineEnding +
|
||
'Ctrl+K — включить или выключить. Режим действует и на Ctrl+Shift+R.';
|
||
btnRippleMenu.Hint := 'Выбрать режим схлопывания';
|
||
RefreshBarHint;
|
||
end;
|
||
|
||
{ Прилипание краёв клипов друг к другу.
|
||
|
||
Shift работает как переключатель наоборот: при включённом прилипании
|
||
временно отключает его, при выключенном — временно включает. Так одна
|
||
клавиша полезна в обоих режимах, и не нужно помнить, какой сейчас. }
|
||
{ Кнопка со значком не может сказать словами, что она делает и в каком
|
||
она состоянии. Слова переезжают в подсказку — целиком, вместе с
|
||
состоянием: иначе о состоянии пришлось бы догадываться по цвету. }
|
||
procedure TMainForm.UpdateSnapButton;
|
||
var
|
||
State: string;
|
||
begin
|
||
btnSnap.Down := FTimeline.SnapEnabled;
|
||
if FTimeline.SnapEnabled then
|
||
State := 'включено'
|
||
else
|
||
State := 'выключено';
|
||
btnSnap.Hint := 'Прилипание: ' + State + '.' + LineEnding +
|
||
'Shift во время перетаскивания меняет решение на противоположное.';
|
||
RefreshBarHint;
|
||
end;
|
||
|
||
procedure TMainForm.btnSnapClick(Sender: TObject);
|
||
begin
|
||
FTimeline.SnapEnabled := not FTimeline.SnapEnabled;
|
||
UpdateSnapButton;
|
||
end;
|
||
|
||
{ Прилипание курсора — отдельный переключатель, а не общий с клипами.
|
||
|
||
Это разные привычки: клипы прилипают при перетаскивании, курсор — при
|
||
щелчке. Одному нужно одно, другому другое, и объединять их в один
|
||
выключатель значило бы навязывать связь, которой нет. }
|
||
procedure TMainForm.UpdateGlueButton;
|
||
var
|
||
State: string;
|
||
begin
|
||
btnGlue.Down := FTimeline.PlayheadSnap;
|
||
if FTimeline.PlayheadSnap then
|
||
State := 'включено'
|
||
else
|
||
State := 'выключено';
|
||
btnGlue.Hint := 'Прилипание курсора к границам клипов: ' + State + '.' +
|
||
LineEnding + 'Shift при щелчке меняет решение на противоположное.';
|
||
RefreshBarHint;
|
||
end;
|
||
|
||
procedure TMainForm.btnGlueClick(Sender: TObject);
|
||
begin
|
||
FTimeline.PlayheadSnap := not FTimeline.PlayheadSnap;
|
||
UpdateGlueButton;
|
||
end;
|
||
|
||
{ Подсказка к кнопке нижней панели показывается в строке состояния.
|
||
|
||
Всплывающее окно здесь мешало: оно появлялось прямо поверх кнопки, о
|
||
которой рассказывает, перехватывало щелчок, и нажать кнопку было нельзя.
|
||
Строка состояния стоит в той же панели, ничего не закрывает и читается
|
||
без наведения мыши. }
|
||
procedure TMainForm.BarButtonEnter(Sender: TObject);
|
||
begin
|
||
if not (Sender is TControl) then
|
||
Exit;
|
||
if TControl(Sender).Hint = '' then
|
||
Exit;
|
||
if FHintControl = nil then
|
||
FStatusBeforeHint := lblStatus.Caption;
|
||
FHintControl := TControl(Sender);
|
||
RefreshBarHint;
|
||
end;
|
||
|
||
procedure TMainForm.BarButtonLeave(Sender: TObject);
|
||
begin
|
||
{ Ушли не с той кнопки, чья подсказка сейчас показана — значит указатель
|
||
уже на соседней, и трогать строку нельзя. }
|
||
if (FHintControl = nil) or (Sender <> FHintControl) then
|
||
Exit;
|
||
FHintControl := nil;
|
||
lblStatus.Caption := FStatusBeforeHint;
|
||
end;
|
||
|
||
{ Подсказка переключателя меняется от щелчка по нему: «спрятан» —
|
||
«виден», «включено» — «выключено». Указатель при этом остаётся на
|
||
кнопке, второго наведения не будет, и без этого вызова в строке
|
||
состояния висел бы прежний текст — прямо противоположный тому, что
|
||
кнопка теперь делает. }
|
||
procedure TMainForm.RefreshBarHint;
|
||
var
|
||
Line: string;
|
||
begin
|
||
if FHintControl = nil then
|
||
Exit;
|
||
Line := FHintControl.Hint;
|
||
if Line = '' then
|
||
Line := FStatusBeforeHint
|
||
else
|
||
{ Подсказки писались в несколько строк для всплывающего окна; в
|
||
строке состояния они идут одной. }
|
||
Line := StringReplace(Line, LineEnding, ' ', [rfReplaceAll]);
|
||
lblStatus.Caption := Line;
|
||
end;
|
||
|
||
{ Строка состояния занимает всё, что свободно справа.
|
||
|
||
Показатель работы появляется только пока что-то собирается или
|
||
разбирается. Всё остальное время его место пустует, а подсказки к
|
||
кнопкам — длинные, и в отведённые под них шестьсот точек не влезали:
|
||
человек видел «Переключит…» вместо целой фразы. Поэтому ширина
|
||
пересчитывается каждый раз, когда показатель появляется или прячется. }
|
||
procedure TMainForm.UpdateStatusWidth;
|
||
var
|
||
Right: Integer;
|
||
begin
|
||
if (FJobLabel = nil) or (lblStatus = nil) then
|
||
Exit;
|
||
if FJobLabel.Visible then
|
||
Right := FJobLabel.Left - 12
|
||
else
|
||
Right := pnlBottom.ClientWidth - 12;
|
||
lblStatus.Width := Max(120, Right - lblStatus.Left);
|
||
end;
|
||
|
||
{ Переводит кнопки на подсказки в строке состояния. }
|
||
procedure TMainForm.UseStatusHints(const AButtons: array of TThemedButton);
|
||
var
|
||
I: Integer;
|
||
begin
|
||
for I := 0 to High(AButtons) do
|
||
begin
|
||
if AButtons[I] = nil then
|
||
Continue;
|
||
AButtons[I].ShowHint := False;
|
||
AButtons[I].OnMouseEnter := @BarButtonEnter;
|
||
AButtons[I].OnMouseLeave := @BarButtonLeave;
|
||
end;
|
||
end;
|
||
|
||
{ Кнопка режима выделения.
|
||
|
||
Режима два, и кнопка показывает не «включено-выключено», а какой сейчас:
|
||
значок рамки — выделение клипов, значок промежутка — выделение по
|
||
времени. Поэтому она не утапливается, а меняет картинку. }
|
||
procedure TMainForm.UpdateSelectModeButton;
|
||
begin
|
||
if FSelectModeItem <> nil then
|
||
if FTimeline.SelectionMode = smRange then
|
||
FSelectModeItem.Caption := 'Режим выделения: по времени (сейчас)'
|
||
else
|
||
FSelectModeItem.Caption := 'Режим выделения: рамкой по клипам (сейчас)';
|
||
|
||
if FTimeline.SelectionMode = smRange then
|
||
begin
|
||
btnSelectMode.Icon := tiSelectRange;
|
||
btnSelectMode.Hint := 'Выделение по времени: протяжка метит ' +
|
||
'промежуток на всех дорожках, S режет по его краям.' + LineEnding +
|
||
'Переключить (D) на выделение клипов.';
|
||
end
|
||
else
|
||
begin
|
||
btnSelectMode.Icon := tiSelectClips;
|
||
btnSelectMode.Hint := 'Выделение клипов: рамка выделяет всё, что ' +
|
||
'задела, S режет по курсору.' + LineEnding +
|
||
'Переключить (D) на выделение промежутка.';
|
||
end;
|
||
RefreshBarHint;
|
||
end;
|
||
|
||
procedure TMainForm.btnSelectModeClick(Sender: TObject);
|
||
begin
|
||
FTimeline.ToggleSelectionMode;
|
||
end;
|
||
|
||
procedure TMainForm.MenuSelectMode(Sender: TObject);
|
||
begin
|
||
FTimeline.ToggleSelectionMode;
|
||
end;
|
||
|
||
{ Режим сменили — сказать об этом словами: по одному значку не угадать,
|
||
что теперь делает протяжка мышью. }
|
||
procedure TMainForm.TimelineSelectModeChange(Sender: TObject);
|
||
begin
|
||
UpdateSelectModeButton;
|
||
if FTimeline.SelectionMode = smRange then
|
||
SetStatus('Выделение по времени: протяжка отмечает промежуток, ' +
|
||
'S режет по его краям.', True)
|
||
else
|
||
SetStatus('Выделение клипов: рамка выделяет всё, что задела, ' +
|
||
'S режет по курсору.', True);
|
||
end;
|
||
|
||
{ Держать ли курсор посередине при воспроизведении.
|
||
|
||
Включено — монтаж едет под курсором, и всегда видно, что будет дальше.
|
||
Выключено — картинка стоит на месте, пока курсор не уйдёт за край; так
|
||
спокойнее, когда разглядываешь конкретное место, а ролик при этом
|
||
играет. }
|
||
procedure TMainForm.UpdateCenterButton;
|
||
var
|
||
State: string;
|
||
begin
|
||
btnCenter.Down := FSettings.CenterPlayhead;
|
||
if FSettings.CenterPlayhead then
|
||
State := 'включено'
|
||
else
|
||
State := 'выключено';
|
||
btnCenter.Hint := 'Курсор посередине при воспроизведении: ' + State + '.' +
|
||
LineEnding + 'Клавиша \ переключает.';
|
||
RefreshBarHint;
|
||
end;
|
||
|
||
procedure TMainForm.ToggleCenterPlayhead;
|
||
begin
|
||
FSettings.CenterPlayhead := not FSettings.CenterPlayhead;
|
||
UpdateCenterButton;
|
||
if FSettings.CenterPlayhead then
|
||
begin
|
||
FTimeline.ScrollToPlayhead(True);
|
||
SetStatus('Курсор держится посередине монтажа.', True);
|
||
end
|
||
else
|
||
SetStatus('Монтаж стоит на месте, курсор идёт по нему.', True);
|
||
end;
|
||
|
||
procedure TMainForm.btnCenterClick(Sender: TObject);
|
||
begin
|
||
ToggleCenterPlayhead;
|
||
end;
|
||
|
||
procedure TMainForm.ToggleRipple;
|
||
begin
|
||
FProject.RippleEnabled := not FProject.RippleEnabled;
|
||
UpdateRippleButton;
|
||
if FProject.RippleEnabled then
|
||
SetStatus('Автосхлопывание включено: клипы правее едут вместе с перетаскиваемым.', True)
|
||
else
|
||
SetStatus('Автосхлопывание выключено: клипы правее остаются на месте.', True);
|
||
end;
|
||
|
||
procedure TMainForm.btnRippleClick(Sender: TObject);
|
||
begin
|
||
ToggleRipple;
|
||
end;
|
||
|
||
procedure TMainForm.RippleModeChosen(Sender: TObject);
|
||
begin
|
||
if TMenuItem(Sender).Tag = 1 then
|
||
FProject.RippleMode := rmAllTracks
|
||
else
|
||
FProject.RippleMode := rmCurrentTrack;
|
||
{ Выбор режима из списка заодно включает автосхлопывание: иначе выбор
|
||
выглядел бы так, будто ничего не произошло. }
|
||
FProject.RippleEnabled := True;
|
||
UpdateRippleButton;
|
||
end;
|
||
|
||
procedure TMainForm.btnRippleMenuClick(Sender: TObject);
|
||
var
|
||
P: TPoint;
|
||
I: Integer;
|
||
begin
|
||
for I := 0 to FRippleMenu.Items.Count - 1 do
|
||
FRippleMenu.Items[I].Checked :=
|
||
(FRippleMenu.Items[I].Tag = 1) = (FProject.RippleMode = rmAllTracks);
|
||
P := btnRippleMenu.ClientToScreen(Point(0, btnRippleMenu.Height));
|
||
FRippleMenu.PopUp(P.X, P.Y);
|
||
end;
|
||
|
||
{ --- Меню дорожки --- }
|
||
|
||
{ Меню по правому щелчку в заголовке дорожки.
|
||
|
||
Раньше дорожку можно было только добавить и убрать последнюю, а убрать
|
||
чаще нужно не последнюю. Порядок дорожек тоже правится здесь — тем, кому
|
||
перетаскивание заголовка неудобно. }
|
||
{ Участок подвинули мышью: показываем, что вышло, и помечаем проект
|
||
изменённым — отметки в нём и хранятся. }
|
||
procedure TMainForm.TimelineRegionChange(Sender: TObject);
|
||
begin
|
||
FProject.Modified := True;
|
||
UpdateCaption;
|
||
if FProject.HasRegion then
|
||
SetStatus(Format('Участок: %s — %s',
|
||
[SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)]), True)
|
||
else
|
||
SetStatus('Отметки участка сняты: собирается весь монтаж.', True);
|
||
end;
|
||
|
||
procedure TMainForm.BuildTrackMenu;
|
||
var
|
||
Item: TMenuItem;
|
||
begin
|
||
FTrackMenu := TPopupMenu.Create(Self);
|
||
|
||
Item := TMenuItem.Create(FTrackMenu);
|
||
Item.Caption := 'Поднять дорожку';
|
||
Item.OnClick := @TrackMenuUp;
|
||
FTrackMenu.Items.Add(Item);
|
||
|
||
Item := TMenuItem.Create(FTrackMenu);
|
||
Item.Caption := 'Опустить дорожку';
|
||
Item.OnClick := @TrackMenuDown;
|
||
FTrackMenu.Items.Add(Item);
|
||
|
||
Item := TMenuItem.Create(FTrackMenu);
|
||
Item.Caption := 'Переименовать...';
|
||
Item.OnClick := @TrackMenuRename;
|
||
FTrackMenu.Items.Add(Item);
|
||
|
||
Item := TMenuItem.Create(FTrackMenu);
|
||
Item.Caption := '-';
|
||
FTrackMenu.Items.Add(Item);
|
||
|
||
Item := TMenuItem.Create(FTrackMenu);
|
||
Item.Caption := 'Удалить дорожку';
|
||
Item.OnClick := @TrackMenuDelete;
|
||
FTrackMenu.Items.Add(Item);
|
||
end;
|
||
|
||
procedure TMainForm.TimelineTrackMenu(Sender: TObject; ATrackIndex: Integer;
|
||
const AScreenPos: TPoint);
|
||
begin
|
||
if (ATrackIndex < 0) or (ATrackIndex >= FProject.TrackCount) then
|
||
Exit;
|
||
FTrackMenuIndex := ATrackIndex;
|
||
FTrackMenu.Items[0].Enabled := ATrackIndex > 0;
|
||
FTrackMenu.Items[1].Enabled := ATrackIndex < FProject.TrackCount - 1;
|
||
FTrackMenu.PopUp(AScreenPos.X, AScreenPos.Y);
|
||
end;
|
||
|
||
procedure TMainForm.TrackMenuUp(Sender: TObject);
|
||
begin
|
||
if FTrackMenuIndex <= 0 then
|
||
Exit;
|
||
FProject.BeginChange;
|
||
FProject.MoveTrack(FTrackMenuIndex, FTrackMenuIndex - 1);
|
||
TimelineStructureChange(nil);
|
||
SetStatus('Дорожка поднята.', True);
|
||
end;
|
||
|
||
procedure TMainForm.TrackMenuDown(Sender: TObject);
|
||
begin
|
||
if (FTrackMenuIndex < 0) or (FTrackMenuIndex >= FProject.TrackCount - 1) then
|
||
Exit;
|
||
FProject.BeginChange;
|
||
FProject.MoveTrack(FTrackMenuIndex, FTrackMenuIndex + 1);
|
||
TimelineStructureChange(nil);
|
||
SetStatus('Дорожка опущена.', True);
|
||
end;
|
||
|
||
{ Удаление дорожки. С клипами — только с подтверждением: вместе с
|
||
дорожкой уходит всё, что на ней лежит, а отменить можно только одним
|
||
шагом назад. }
|
||
{ Переименование дорожки.
|
||
|
||
Имя — только подпись, но на монтаже из десятка дорожек «карта», «звук
|
||
мотора» и «титры» читаются несравнимо лучше, чем V1, A2 и Т1. }
|
||
procedure TMainForm.TimelineTrackRename(Sender: TObject; ATrackIndex: Integer);
|
||
var
|
||
NewName: string;
|
||
begin
|
||
if (ATrackIndex < 0) or (ATrackIndex >= FProject.TrackCount) then
|
||
Exit;
|
||
NewName := FProject.Tracks[ATrackIndex].Name;
|
||
if not ThemedInputDlg('Имя дорожки', 'Как назвать дорожку:', NewName) then
|
||
Exit;
|
||
|
||
FProject.BeginChange;
|
||
FProject.Tracks[ATrackIndex].Name := NewName;
|
||
FProject.EnsureUniqueTrackNames;
|
||
FTimeline.Invalidate;
|
||
UpdateCaption;
|
||
SetStatus('Дорожка названа: ' + FProject.Tracks[ATrackIndex].Name, True);
|
||
end;
|
||
|
||
procedure TMainForm.TrackMenuRename(Sender: TObject);
|
||
begin
|
||
TimelineTrackRename(nil, FTrackMenuIndex);
|
||
end;
|
||
|
||
procedure TMainForm.TrackMenuDelete(Sender: TObject);
|
||
var
|
||
Track: TTrack;
|
||
{ Не Name: так называется свойство самой формы, и локальная переменная
|
||
его перекроет — компилятор ловит, но сообщение неочевидное. }
|
||
TrackName: string;
|
||
begin
|
||
if (FTrackMenuIndex < 0) or (FTrackMenuIndex >= FProject.TrackCount) then
|
||
Exit;
|
||
Track := FProject.Tracks[FTrackMenuIndex];
|
||
TrackName := Track.Name;
|
||
|
||
if (Track.Count > 0) and (ThemedMessageDlg('nlve',
|
||
Format('На дорожке %s %d %s. Удалить её вместе с ними?',
|
||
[TrackName, Track.Count,
|
||
Plural(Track.Count, 'клип', 'клипа', 'клипов')]),
|
||
mtConfirmation, [mbYes, mbNo], 0) <> mrYes) then
|
||
Exit;
|
||
|
||
FProject.BeginChange;
|
||
FProject.RemoveTrack(FTrackMenuIndex);
|
||
TimelineStructureChange(nil);
|
||
SetStatus('Дорожка ' + TrackName + ' удалена.', True);
|
||
end;
|
||
|
||
{ --- Меню библиотеки --- }
|
||
|
||
procedure TMainForm.BuildPoolMenu;
|
||
var
|
||
Item: TMenuItem;
|
||
begin
|
||
FPoolMenu := TPopupMenu.Create(Self);
|
||
FPoolMenu.OnPopup := @PoolMenuPopup;
|
||
|
||
FPoolAddMenu := TMenuItem.Create(FPoolMenu);
|
||
FPoolAddMenu.Caption := 'Добавить на дорожку';
|
||
FPoolMenu.Items.Add(FPoolAddMenu);
|
||
|
||
Item := TMenuItem.Create(FPoolMenu);
|
||
Item.Caption := '-';
|
||
FPoolMenu.Items.Add(Item);
|
||
|
||
Item := TMenuItem.Create(FPoolMenu);
|
||
Item.Caption := 'Кадрирование и поворот...';
|
||
Item.OnClick := @PoolEditTransform;
|
||
FPoolMenu.Items.Add(Item);
|
||
|
||
Item := TMenuItem.Create(FPoolMenu);
|
||
Item.Caption := '-';
|
||
FPoolMenu.Items.Add(Item);
|
||
|
||
Item := TMenuItem.Create(FPoolMenu);
|
||
Item.Caption := 'Убрать со всех дорожек';
|
||
Item.OnClick := @PoolRemoveFromTracks;
|
||
FPoolMenu.Items.Add(Item);
|
||
|
||
Item := TMenuItem.Create(FPoolMenu);
|
||
Item.Caption := 'Удалить из проекта';
|
||
Item.OnClick := @PoolRemoveFromProject;
|
||
FPoolMenu.Items.Add(Item);
|
||
|
||
lstPool.PopupMenu := FPoolMenu;
|
||
|
||
{ Меню режимов схлопывания. }
|
||
FRippleMenu := TPopupMenu.Create(Self);
|
||
|
||
Item := TMenuItem.Create(FRippleMenu);
|
||
Item.Caption := 'Только текущая дорожка';
|
||
Item.RadioItem := True;
|
||
Item.Tag := 0;
|
||
Item.OnClick := @RippleModeChosen;
|
||
FRippleMenu.Items.Add(Item);
|
||
|
||
Item := TMenuItem.Create(FRippleMenu);
|
||
Item.Caption := 'Все дорожки';
|
||
Item.RadioItem := True;
|
||
Item.Tag := 1;
|
||
Item.OnClick := @RippleModeChosen;
|
||
FRippleMenu.Items.Add(Item);
|
||
end;
|
||
|
||
{ Список дорожек в подменю строится при каждом открытии: дорожки
|
||
добавляются и удаляются, а держать меню в согласии с ними постоянно
|
||
дороже, чем собрать его заново. }
|
||
{ Правый щелчок выделяет файл под курсором.
|
||
|
||
Сам по себе список этого не делает: правая кнопка выделение не меняет.
|
||
А меню без выделенного файла отключается целиком и выглядит так, будто
|
||
оно не работает вовсе. }
|
||
procedure TMainForm.lstPoolMouseDown(Sender: TObject; Button: TMouseButton;
|
||
Shift: TShiftState; X, Y: Integer);
|
||
var
|
||
Idx: Integer;
|
||
begin
|
||
if Button <> mbRight then
|
||
Exit;
|
||
Idx := lstPool.ItemAtPos(Point(X, Y), True);
|
||
if Idx >= 0 then
|
||
lstPool.ItemIndex := Idx;
|
||
end;
|
||
|
||
procedure TMainForm.PoolMenuPopup(Sender: TObject);
|
||
var
|
||
I: Integer;
|
||
Item: TMenuItem;
|
||
{ Не Enabled: это имя занято свойством формы. }
|
||
HasSelection: Boolean;
|
||
begin
|
||
FPoolAddMenu.Clear;
|
||
for I := 0 to FProject.TrackCount - 1 do
|
||
begin
|
||
Item := TMenuItem.Create(FPoolAddMenu);
|
||
Item.Caption := FProject.Tracks[I].Name;
|
||
Item.Tag := I;
|
||
Item.OnClick := @PoolAddToTrack;
|
||
FPoolAddMenu.Add(Item);
|
||
end;
|
||
|
||
HasSelection := SelectedPoolIndex(lstPool) >= 0;
|
||
for I := 0 to FPoolMenu.Items.Count - 1 do
|
||
FPoolMenu.Items[I].Enabled := HasSelection;
|
||
end;
|
||
|
||
procedure TMainForm.PoolAddToTrack(Sender: TObject);
|
||
begin
|
||
AddClipFromPool(SelectedPoolIndex(lstPool), TMenuItem(Sender).Tag,
|
||
FTimeline.Playhead);
|
||
end;
|
||
|
||
{ Убирает клипы файла со всех дорожек, оставляя сам файл в проекте.
|
||
Дыры намеренно не схлопываются: убрать клип и переставить всё остальное —
|
||
два разных намерения. }
|
||
procedure TMainForm.PoolRemoveFromTracks(Sender: TObject);
|
||
var
|
||
Idx, T, C, Removed: Integer;
|
||
Item: TMediaItem;
|
||
Track: TTrack;
|
||
begin
|
||
Idx := SelectedPoolIndex(lstPool);
|
||
if (Idx < 0) or (Idx >= FProject.PoolCount) then
|
||
Exit;
|
||
Item := FProject.Pool[Idx];
|
||
|
||
FProject.BeginChange;
|
||
Removed := 0;
|
||
for T := 0 to FProject.TrackCount - 1 do
|
||
begin
|
||
Track := FProject.Tracks[T];
|
||
for C := Track.Count - 1 downto 0 do
|
||
if Track[C].MediaId = Item.Id then
|
||
begin
|
||
Track.Remove(Track[C]);
|
||
Inc(Removed);
|
||
end;
|
||
end;
|
||
|
||
if Removed = 0 then
|
||
begin
|
||
FProject.CancelChange;
|
||
SetStatus('Клипов этого файла на монтаже нет.');
|
||
Exit;
|
||
end;
|
||
|
||
FTimeline.Invalidate;
|
||
SchedulePreview;
|
||
UpdateCaption;
|
||
SetStatus(Format('Убрано %d %s',
|
||
[Removed, Plural(Removed, 'клип', 'клипа', 'клипов')]), True);
|
||
end;
|
||
|
||
{ Кадрирование отдельного клипа. Вызывается кнопкой в углу клипа.
|
||
|
||
Настройка принадлежит клипу: два куска одного файла бывает нужно
|
||
кадрировать по-разному. У файла хранится такая же, но она лишь
|
||
заготовка для новых клипов. }
|
||
procedure TMainForm.TimelineClipTransform(Sender: TObject; AClip: TClip);
|
||
var
|
||
Item: TMediaItem;
|
||
T: TMediaTransform;
|
||
Key: TColorKey;
|
||
Applied: Boolean;
|
||
At: Double;
|
||
begin
|
||
if AClip = nil then
|
||
Exit;
|
||
|
||
{ У надписи кнопка на клипе открывает не кадрирование, а правку текста:
|
||
кадрировать там нечего. }
|
||
if AClip.Kind = ckText then
|
||
begin
|
||
FProject.BeginChange;
|
||
if EditTextOf(AClip) then
|
||
TimelineStructureChange(nil)
|
||
else
|
||
FProject.CancelChange;
|
||
Exit;
|
||
end;
|
||
|
||
Item := FProject.FindMedia(AClip.MediaId);
|
||
if Item = nil then
|
||
Exit;
|
||
|
||
if not FProject.MasterSet then
|
||
begin
|
||
ThemedMessageDlg('nlve',
|
||
'Параметры проекта ещё не заданы: добавьте сначала видеофайл.',
|
||
mtInformation, [mbOK], 0);
|
||
Exit;
|
||
end;
|
||
|
||
T := AClip.Transform;
|
||
{ Кадр окну — из самого клипа, а не из середины исходного файла.
|
||
|
||
Клип обычно вырезан из середины долгой съёмки, и кадр «десятая часть
|
||
от начала файла» показывал совсем другую сцену: прицелиться
|
||
кадрированием было нечем. Берём то место, где стоит курсор, если он
|
||
внутри клипа, иначе середину клипа — то, на что человек и смотрит. }
|
||
At := FTimeline.Playhead;
|
||
if (At < AClip.TlStart) or (At > AClip.TlEnd) then
|
||
At := AClip.TlStart + AClip.Duration / 2;
|
||
At := AClip.SrcIn + (At - AClip.TlStart);
|
||
|
||
{ Ключ отдаётся окну по ссылке: правку он подтверждает сам, и «Отмена»
|
||
кадрирования её не отменяет. }
|
||
Key := AClip.ColorKey;
|
||
Applied := EditTransform(Self, Item.EffectivePath, Item.Info,
|
||
FProject.Master.Width, FProject.Master.Height, T,
|
||
FProject.CacheDir + 'pancrop.png', @Key, At);
|
||
if (not Applied) and SameColorKey(Key, AClip.ColorKey) then
|
||
Exit;
|
||
|
||
FProject.BeginChange;
|
||
if Applied then
|
||
AClip.Transform := T;
|
||
AClip.ColorKey := Key;
|
||
FTimeline.Invalidate;
|
||
FLastLoadedEdl := '';
|
||
SchedulePreview;
|
||
UpdateCaption;
|
||
end;
|
||
|
||
{ Заготовка кадрирования для файла: её берёт новый клип при добавлении. }
|
||
procedure TMainForm.PoolEditTransform(Sender: TObject);
|
||
var
|
||
Idx: Integer;
|
||
Item: TMediaItem;
|
||
T: TMediaTransform;
|
||
begin
|
||
Idx := SelectedPoolIndex(lstPool);
|
||
if (Idx < 0) or (Idx >= FProject.PoolCount) then
|
||
Exit;
|
||
Item := FProject.Pool[Idx];
|
||
|
||
if not FProject.MasterSet then
|
||
begin
|
||
ThemedMessageDlg('nlve',
|
||
'Параметры проекта ещё не заданы: добавьте сначала видеофайл.',
|
||
mtInformation, [mbOK], 0);
|
||
Exit;
|
||
end;
|
||
|
||
T := Item.Transform;
|
||
if not EditTransform(Self, Item.Path, Item.Info,
|
||
FProject.Master.Width, FProject.Master.Height, T,
|
||
FProject.CacheDir + 'pancrop.png') then
|
||
Exit;
|
||
|
||
FProject.BeginChange;
|
||
Item.Transform := T;
|
||
{ Приведённая копия сделана со старыми настройками и больше не годится. }
|
||
if Item.NormalizedPath <> '' then
|
||
begin
|
||
Item.NormalizedPath := '';
|
||
Item.IndexLoaded := False;
|
||
Log('Настройки кадра изменились — приведённую копию надо сделать заново.');
|
||
end;
|
||
UpdateCaption;
|
||
SchedulePreview;
|
||
SetStatus('Кадрирование обновлено: ' + FitModeCaption(T.Fit), True);
|
||
end;
|
||
|
||
procedure TMainForm.MenuProjectInfo(Sender: TObject);
|
||
begin
|
||
ShowProjectInfo(Self, FProject);
|
||
end;
|
||
|
||
{ Проверка и починка проекта.
|
||
|
||
Зачем. В проекте копятся вещи, которые сами по себе не видны, а в
|
||
готовом ролике оборачиваются сюрпризом: клип на дорожке чужого вида
|
||
(нарисован, но в сборку не попадает), одинаковые имена дорожек, времена
|
||
мимо кадровой сетки. Последнее — наследство: доли кадра в монтаже
|
||
означают, что предпросмотр и сборка округлят их каждый по-своему.
|
||
|
||
Молча ничего не правится: сначала показываем, что нашли, и спрашиваем.
|
||
Отмена работает как у любой правки — Ctrl+Z. }
|
||
procedure TMainForm.MenuRepairProject(Sender: TObject);
|
||
var
|
||
OffGrid, Misplaced, Renamed, MovedClips, SnappedClips: Integer;
|
||
Report: string;
|
||
Names: TStringList;
|
||
T: Integer;
|
||
begin
|
||
OffGrid := FProject.OffGridClipCount;
|
||
Misplaced := FProject.MisplacedClipCount;
|
||
|
||
{ Одинаковые имена дорожек: считаем до правки, иначе не о чем говорить. }
|
||
Renamed := 0;
|
||
Names := TStringList.Create;
|
||
try
|
||
Names.Sorted := True;
|
||
Names.Duplicates := dupAccept;
|
||
for T := 0 to FProject.TrackCount - 1 do
|
||
begin
|
||
if Names.IndexOf(FProject.Tracks[T].Name) >= 0 then
|
||
Inc(Renamed);
|
||
Names.Add(FProject.Tracks[T].Name);
|
||
end;
|
||
finally
|
||
Names.Free;
|
||
end;
|
||
|
||
if (OffGrid = 0) and (Misplaced = 0) and (Renamed = 0) then
|
||
begin
|
||
ThemedMessageDlg('nlve',
|
||
'Проект в порядке: клипы стоят на кадрах, все они на дорожках ' +
|
||
'своего вида, имена дорожек не повторяются.',
|
||
mtInformation, [mbOK], 0);
|
||
SetStatus('Проект проверен: чинить нечего.', True);
|
||
Exit;
|
||
end;
|
||
|
||
Report := 'Найдено:' + LineEnding + LineEnding;
|
||
if OffGrid > 0 then
|
||
Report := Report + Format('— клипов мимо кадровой сетки: %d.' + LineEnding +
|
||
'Между кадрами времени нет, и доля кадра означает, что предпросмотр ' +
|
||
'и сборка округлят её каждый по-своему. Сдвиг при починке не больше ' +
|
||
'полкадра.' + LineEnding + LineEnding, [OffGrid]);
|
||
if Misplaced > 0 then
|
||
Report := Report + Format('— клипов на дорожках чужого вида: %d.' +
|
||
LineEnding + 'Такой клип нарисован на монтаже, но в готовый ролик не ' +
|
||
'попадает.' + LineEnding + LineEnding, [Misplaced]);
|
||
if Renamed > 0 then
|
||
Report := Report + Format('— дорожек с повторяющимся именем: %d.' +
|
||
LineEnding + LineEnding, [Renamed]);
|
||
Report := Report + 'Починить? Отменить можно будет через Ctrl+Z.';
|
||
|
||
if ThemedMessageDlg('nlve', Report, mtConfirmation, [mbYes, mbNo], 0) <> mrYes then
|
||
Exit;
|
||
|
||
FProject.BeginChange;
|
||
SnappedClips := FProject.SnapClipsToFrameGrid;
|
||
MovedClips := FProject.FixMisplacedClips;
|
||
FProject.EnsureUniqueTrackNames;
|
||
|
||
if (SnappedClips = 0) and (MovedClips = 0) and (Renamed = 0) then
|
||
begin
|
||
FProject.CancelChange;
|
||
SetStatus('Чинить не пришлось.', True);
|
||
Exit;
|
||
end;
|
||
|
||
FProject.Modified := True;
|
||
FTimeline.Invalidate;
|
||
RefreshPool;
|
||
UpdateCaption;
|
||
FLastLoadedEdl := '';
|
||
SchedulePreview;
|
||
|
||
Report := '';
|
||
if SnappedClips > 0 then
|
||
Report := Report + Format('на кадры поставлено %d %s', [SnappedClips,
|
||
Plural(SnappedClips, 'клип', 'клипа', 'клипов')]);
|
||
if MovedClips > 0 then
|
||
begin
|
||
if Report <> '' then
|
||
Report := Report + ', ';
|
||
Report := Report + Format('перенесено %d %s', [MovedClips,
|
||
Plural(MovedClips, 'клип', 'клипа', 'клипов')]);
|
||
end;
|
||
if Renamed > 0 then
|
||
begin
|
||
if Report <> '' then
|
||
Report := Report + ', ';
|
||
Report := Report + Format('переименовано %d %s', [Renamed,
|
||
Plural(Renamed, 'дорожка', 'дорожки', 'дорожек')]);
|
||
end;
|
||
|
||
Log('Починка проекта: ' + Report + '.');
|
||
SetStatus('Проект починен: ' + Report + '. Отменить — Ctrl+Z.', True);
|
||
end;
|
||
|
||
procedure TMainForm.PoolRemoveFromProject(Sender: TObject);
|
||
var
|
||
Idx: Integer;
|
||
Item: TMediaItem;
|
||
begin
|
||
Idx := SelectedPoolIndex(lstPool);
|
||
if (Idx < 0) or (Idx >= FProject.PoolCount) then
|
||
Exit;
|
||
Item := FProject.Pool[Idx];
|
||
|
||
if ThemedMessageDlg('nlve', 'Удалить ' + ExtractFileName(Item.Path) +
|
||
' из проекта? Его клипы пропадут со всех дорожек.',
|
||
mtConfirmation, [mbYes, mbNo], 0) <> mrYes then
|
||
Exit;
|
||
|
||
FProject.BeginChange;
|
||
FProject.RemoveMedia(Item);
|
||
RefreshPool;
|
||
FTimeline.Invalidate;
|
||
SchedulePreview;
|
||
UpdateCaption;
|
||
end;
|
||
|
||
{ Файлы бросили на окно программы.
|
||
|
||
Место броска решает, что с ними делать: над монтажом — сразу и в проект,
|
||
и на дорожку под указателем; в любом другом месте — только в проект.
|
||
Своих координат обработчик не получает, поэтому берём положение
|
||
указателя. }
|
||
procedure TMainForm.FormFilesDropped(Sender: TObject;
|
||
const FileNames: array of string);
|
||
var
|
||
I, TrackIdx: Integer;
|
||
Pt: TPoint;
|
||
OverTimeline: Boolean;
|
||
DropTime: Double;
|
||
Added: Boolean;
|
||
begin
|
||
Pt := FTimeline.ScreenToClient(Mouse.CursorPos);
|
||
OverTimeline := (Pt.X >= 0) and (Pt.Y >= 0) and
|
||
(Pt.X < FTimeline.Width) and (Pt.Y < FTimeline.Height);
|
||
|
||
Added := False;
|
||
for I := 0 to High(FileNames) do
|
||
if FileExists(FileNames[I]) then
|
||
begin
|
||
AddMediaFile(ExpandFileName(FileNames[I]));
|
||
Added := True;
|
||
end;
|
||
if not Added then
|
||
Exit;
|
||
|
||
RefreshPool;
|
||
UpdateCaption;
|
||
|
||
if not OverTimeline then
|
||
begin
|
||
SetStatus('Файлы добавлены в проект.');
|
||
Exit;
|
||
end;
|
||
|
||
{ Бросили над монтажом — кладём последний добавленный на дорожку под
|
||
указателем. }
|
||
lstPool.ItemIndex := FProject.PoolCount - 1;
|
||
TrackIdx := FTimeline.TrackIndexAtPoint(Pt.Y);
|
||
DropTime := FTimeline.TimeAtPoint(Pt.X);
|
||
AddClipFromPool(FProject.PoolCount - 1, TrackIdx, DropTime);
|
||
end;
|
||
|
||
{ Громкость клипов в предпросмотре.
|
||
|
||
Дорожки смешиваются, поэтому одной общей громкостью не обойтись: у
|
||
каждой дорожки под курсором свой клип со своей громкостью. Значения
|
||
собираются по дорожкам и отдаются плееру; он подставляет их в свою
|
||
цепочку смешивания.
|
||
|
||
Пересобирать цепочку на каждый кадр нельзя — она создаётся заново и
|
||
звук щёлкает. Поэтому только при изменении. }
|
||
{ Разметка текста для предпросмотра.
|
||
|
||
Сравнивается сама разметка, а не имя файла: имя у неё одно на весь
|
||
проект, и правка текста его не меняет. Плеер же, увидев прежнее имя,
|
||
файл не перечитывал — и новая надпись в окне не появлялась вовсе, пока
|
||
не перезагрузится весь список кусков. }
|
||
procedure TMainForm.UpdateSubtitles;
|
||
var
|
||
{ Не Text: так называется свойство формы. }
|
||
Path, Markup: string;
|
||
begin
|
||
if (FProject = nil) or (FPlayer = nil) then
|
||
Exit;
|
||
if FProject.CacheDir = '' then
|
||
Exit;
|
||
|
||
Markup := BuildAss(FProject);
|
||
if Markup = FLastAss then
|
||
Exit;
|
||
FLastAss := Markup;
|
||
|
||
Path := IncludeTrailingPathDelimiter(FProject.CacheDir) + 'subs.ass';
|
||
if (Markup <> '') and WriteAssFile(FProject, Path) then
|
||
FPlayer.SetSubtitleFile(Path, True)
|
||
else
|
||
FPlayer.SetSubtitleFile('');
|
||
end;
|
||
|
||
{ Кадрирование клипа в предпросмотре.
|
||
|
||
Цепочка фильтров у mpv одна на весь список кусков, а кадрирование у
|
||
каждого клипа своё, и включать его по времени в цепочке нечем: из
|
||
фильтров ffmpeg по времени переключается только наложение. Зато у
|
||
вывода есть своя обрезка, и делает её видеокарта даром.
|
||
|
||
Раз она действует на весь вывод, переключать её обязаны мы: курсор
|
||
зашёл в клип со своим кадрированием — выставили, вышел — сняли.
|
||
|
||
Участки с наложением сюда не попадают: там кадр уже сведён цепочкой, и
|
||
обрезка на выводе резала бы сведённое целиком, вместе с нижним слоем.
|
||
|
||
Отражения обрезкой не выразить, растяжение — тоже: такие клипы
|
||
по-прежнему показываются как есть, точную картинку для них даёт окно
|
||
«Кадрирование и поворот». }
|
||
procedure TMainForm.ApplyCropAt(const ATime: Double);
|
||
var
|
||
I: Integer;
|
||
Clip: TClip;
|
||
Item: TMediaItem;
|
||
Sel: TRect;
|
||
Rotation: Integer;
|
||
Key: string;
|
||
begin
|
||
if (FPlayer = nil) or (not FPlayer.Initialized) or (FProject = nil) then
|
||
Exit;
|
||
|
||
Sel := Rect(0, 0, 0, 0);
|
||
Rotation := 0;
|
||
|
||
for I := 0 to High(FPreviewOverlayWindows) do
|
||
if (ATime >= FPreviewOverlayWindows[I].TlStart - 0.0005) and
|
||
(ATime <= FPreviewOverlayWindows[I].TlEnd + 0.0005) then
|
||
begin
|
||
FPlayer.SetOutputCrop(Sel, 0);
|
||
Exit;
|
||
end;
|
||
|
||
Clip := VisibleClipAtTime(FProject, tkVideo, ATime);
|
||
if (Clip <> nil) and (Clip.Kind = ckVideo) and
|
||
TransformFitsOutputCrop(Clip.Transform) then
|
||
begin
|
||
Item := FProject.FindMedia(Clip.MediaId);
|
||
if (Item <> nil) and Item.Info.Valid and
|
||
(Item.Info.Width > 0) and (Item.Info.Height > 0) then
|
||
begin
|
||
Rotation := Clip.Transform.Rotation;
|
||
if not TransformSourceRect(Clip.Transform,
|
||
Item.Info.Width, Item.Info.Height,
|
||
FProject.Master.Width, FProject.Master.Height, Sel) then
|
||
Sel := Rect(0, 0, 0, 0)
|
||
{ Рамка во весь кадр — это отсутствие обрезки. Ставить её значило бы
|
||
зря перестраивать вывод на каждом клипе. }
|
||
else if (Sel.Left <= 0) and (Sel.Top <= 0) and
|
||
(Sel.Right >= Item.Info.Width) and
|
||
(Sel.Bottom >= Item.Info.Height) then
|
||
Sel := Rect(0, 0, 0, 0);
|
||
end;
|
||
end;
|
||
|
||
Key := Format('%d,%d,%d,%d,%d',
|
||
[Sel.Left, Sel.Top, Sel.Right, Sel.Bottom, Rotation]);
|
||
if Key = FLastCropKey then
|
||
Exit;
|
||
FLastCropKey := Key;
|
||
FPlayer.SetOutputCrop(Sel, Rotation);
|
||
end;
|
||
|
||
procedure TMainForm.ApplyVolumeAt(const ATime: Double);
|
||
var
|
||
I: Integer;
|
||
Clip: TClip;
|
||
Track: TTrack;
|
||
Vols: array of Double;
|
||
Key: string;
|
||
begin
|
||
if (FPlayer = nil) or (not FPlayer.Initialized) then
|
||
Exit;
|
||
if FProject = nil then
|
||
Exit;
|
||
|
||
Vols := nil;
|
||
Key := '';
|
||
for I := 0 to High(FPreviewAudioTracks) do
|
||
begin
|
||
Track := FProject.FindTrack(FPreviewAudioTracks[I]);
|
||
SetLength(Vols, Length(Vols) + 1);
|
||
Vols[High(Vols)] := 1;
|
||
if Track <> nil then
|
||
begin
|
||
Clip := Track.ClipAt(ATime);
|
||
if Clip <> nil then
|
||
Vols[High(Vols)] := Clip.Volume;
|
||
end;
|
||
Key := Key + SecondsToStr(Vols[High(Vols)]) + ',';
|
||
end;
|
||
|
||
if Key = FLastVolumeKey then
|
||
Exit;
|
||
FLastVolumeKey := Key;
|
||
|
||
{ Кто какую громкость получил — в журнал. Иначе разбираться, почему в
|
||
одном месте звук есть, а в соседнем нет, приходится по снимкам
|
||
экрана. }
|
||
Key := '';
|
||
for I := 0 to High(FPreviewAudioTracks) do
|
||
begin
|
||
if Key <> '' then
|
||
Key := Key + ', ';
|
||
Track := FProject.FindTrack(FPreviewAudioTracks[I]);
|
||
if Track <> nil then
|
||
Key := Key + Track.Name + '='
|
||
else
|
||
Key := Key + '?=';
|
||
Key := Key + SecondsToStr(Vols[I]);
|
||
end;
|
||
Log(Format('Громкости на %s: %s', [SecondsToStr(ATime), Key]));
|
||
|
||
FPlayer.SetTrackVolumes(Vols);
|
||
if FPlayer.AudioGraph <> '' then
|
||
Log('Цепочка звука: ' + FPlayer.AudioGraph);
|
||
end;
|
||
|
||
procedure TMainForm.GenerateProgress(Sender: TObject);
|
||
begin
|
||
SetStatus(FGenerate.StageText);
|
||
end;
|
||
|
||
procedure TMainForm.GenerateLog(Sender: TObject);
|
||
begin
|
||
Log(FGenerate.PendingLog);
|
||
end;
|
||
|
||
procedure TMainForm.GenerateDone(Sender: TObject);
|
||
var
|
||
Ok, WasCancelled: Boolean;
|
||
Msg: string;
|
||
begin
|
||
Ok := FGenerate.Succeeded;
|
||
WasCancelled := FGenerate.Cancelled;
|
||
Msg := FGenerate.Message;
|
||
FGenerate := nil;
|
||
FGenerateBusy := False;
|
||
|
||
{ Отмену просили мы сами, когда правка сделала работу ненужной. Это не
|
||
беда, и говорить «не удалось» тут нельзя: в журнале появлялась строка
|
||
об ошибке там, где всё шло по плану. Пересобираем предпросмотр по
|
||
свежей расстановке. }
|
||
if WasCancelled then
|
||
begin
|
||
Log('Подготовка вставок прекращена: расстановка изменилась.');
|
||
SchedulePreview;
|
||
Exit;
|
||
end;
|
||
|
||
if not Ok then
|
||
begin
|
||
Log('Не удалось подготовить вставки: ' + Msg);
|
||
SetStatus('Вставки подготовить не удалось.');
|
||
Exit;
|
||
end;
|
||
|
||
{ Файлы появились — теперь список кусков соберётся целиком. }
|
||
SchedulePreview;
|
||
end;
|
||
|
||
{ --- Обработчики компонентов --- }
|
||
|
||
{ Перемотка с отметкой «ждём прибытия».
|
||
|
||
Плеер после перемотки, а тем более после перезагрузки списка кусков,
|
||
какое-то время сообщает старую позицию или ноль. Если верить этим
|
||
сообщениям, курсор на монтаже прыгнет в начало — именно это и
|
||
происходило при перетаскивании клипа. Поэтому до тех пор, пока плеер
|
||
не окажется рядом с запрошенным местом, его сообщения о позиции
|
||
игнорируются. }
|
||
procedure TMainForm.SeekPlayerTo(const ATime: Double);
|
||
begin
|
||
if (FPlayer = nil) or (not FPlayer.Initialized) then
|
||
Exit;
|
||
FSeekTarget := ATime;
|
||
FSeekPending := True;
|
||
FSeekWaitTicks := 0;
|
||
FPlayer.SeekAbsolute(ATime);
|
||
end;
|
||
|
||
procedure TMainForm.TimelinePlayheadChange(Sender: TObject);
|
||
begin
|
||
UpdateTimeLabel;
|
||
{ Кадрирование показывается и на паузе: курсор переставили мышью —
|
||
картинка обязана смениться сразу, а не с началом воспроизведения. }
|
||
ApplyCropAt(FTimeline.Playhead);
|
||
{ Если курсор двинул сам плеер, перематывать его обратно нельзя —
|
||
получится бесконечная переброска. }
|
||
if FUpdatingFromPlayer then
|
||
Exit;
|
||
SeekPlayerTo(FTimeline.Playhead);
|
||
end;
|
||
|
||
procedure TMainForm.TimelineStructureChange(Sender: TObject);
|
||
begin
|
||
SchedulePreview;
|
||
UpdateCaption;
|
||
UpdateTimeLabel;
|
||
end;
|
||
|
||
procedure TMainForm.TimelineSelectionChange(Sender: TObject);
|
||
begin
|
||
SetStatus(Format('Выделено %d %s', [FProject.SelectedCount,
|
||
Plural(FProject.SelectedCount, 'клип', 'клипа', 'клипов')]), True);
|
||
end;
|
||
|
||
procedure TMainForm.PlayerLog(Sender: TObject; const APrefix, ALevel, AText: string);
|
||
begin
|
||
Log('[' + ALevel + '] ' + APrefix + ': ' + TrimRight(AText));
|
||
end;
|
||
|
||
procedure TMainForm.PlayerTimePos(Sender: TObject);
|
||
begin
|
||
if FSeekPending then
|
||
begin
|
||
Inc(FSeekWaitTicks);
|
||
{ Ещё не доехали до запрошенного места — не трогаем курсор.
|
||
Но ждём не бесконечно: запрошенное время может оказаться за концом
|
||
монтажа, и тогда плеер до него не доедет никогда. }
|
||
if (Abs(FPlayer.TimePos - FSeekTarget) > 0.35) and
|
||
(FSeekWaitTicks < MaxSeekWaitTicks) then
|
||
Exit;
|
||
FSeekPending := False;
|
||
{ Ждать перестали, а плеер так и не доехал. На паузе это значит, что
|
||
курсор надо оставить там, куда его поставил человек: при перезагрузке
|
||
списка кусков mpv сбрасывает отсчёт времени («Reset playback due to
|
||
audio timestamp reset») и сообщает что угодно, вплоть до конца
|
||
монтажа. Раньше курсор туда и улетал после каждой правки — например
|
||
после схлопывания дыры, и следующее схлопывание приходилось начинать
|
||
с прицеливания мышью заново. }
|
||
if FPlayer.Paused and (Abs(FPlayer.TimePos - FSeekTarget) > 0.35) then
|
||
Exit;
|
||
end;
|
||
|
||
{ Обновляем курсор только при заметном сдвиге: mpv сообщает позицию на
|
||
каждый кадр, и перерисовывать монтаж 60 раз в секунду незачем. }
|
||
if Abs(FPlayer.TimePos - FTimeline.Playhead) < 0.01 then
|
||
Exit;
|
||
|
||
ApplyVolumeAt(FPlayer.TimePos);
|
||
ApplyCropAt(FPlayer.TimePos);
|
||
|
||
FUpdatingFromPlayer := True;
|
||
try
|
||
FTimeline.Playhead := FPlayer.TimePos;
|
||
{ Держать курсор посередине или дать монтажу стоять — решает человек.
|
||
|
||
Выключено — не двигаем окно вовсе, даже когда курсор ушёл за край.
|
||
Раньше в этом случае монтаж всё равно подтягивался к курсору, стоило
|
||
тому выйти из видимой части: прокрутил колесом с Shift — первый
|
||
поворот сдвинул, второй вернул обратно. Человек отматывал
|
||
осознанно, и возвращать его силой нельзя. }
|
||
if (not FPlayer.Paused) and FSettings.CenterPlayhead then
|
||
FTimeline.ScrollToPlayhead(True);
|
||
finally
|
||
FUpdatingFromPlayer := False;
|
||
end;
|
||
end;
|
||
|
||
procedure TMainForm.PlayerDuration(Sender: TObject);
|
||
var
|
||
Hw: string;
|
||
begin
|
||
UpdateTimeLabel;
|
||
|
||
{ Момент, когда файл уже открыт и про декодирование известно всё.
|
||
Сообщаем один раз на загрузку и только при смене: если декодирует
|
||
процессор, тяжёлый материал поедет рывками, и знать об этом надо
|
||
заранее, а не гадать, почему предпросмотр дёргается. }
|
||
Hw := FPlayer.HwdecCurrent;
|
||
if Hw = FLastHwdec then
|
||
Exit;
|
||
FLastHwdec := Hw;
|
||
|
||
if (Hw = '') or (Hw = 'no') then
|
||
begin
|
||
Log('Внимание: видео декодирует процессор. ' +
|
||
'Тяжёлый материал может идти рывками.');
|
||
{ Больше не пробуем. Иначе на каждой правке монтажа mpv заново
|
||
перебирает способы аппаратного декодирования, каждый раз впустую и
|
||
каждый раз с десятком строк ошибок в журнале. Так ведёт себя Wine,
|
||
где ни DXVA2, ни CUDA не работают. }
|
||
FPlayer.SetHwdec('no');
|
||
end
|
||
else
|
||
Log('Декодирование видео: ' + Hw);
|
||
|
||
{ Откуда взялся звук. Строка меняется редко, поэтому пишется только при
|
||
изменении — иначе журнал забился бы повторами. }
|
||
if FPlayer.AudioTrackNote <> FLastAudioNote then
|
||
begin
|
||
FLastAudioNote := FPlayer.AudioTrackNote;
|
||
if FLastAudioNote <> '' then
|
||
Log(FLastAudioNote);
|
||
end;
|
||
end;
|
||
|
||
procedure TMainForm.PlayerPauseChange(Sender: TObject);
|
||
begin
|
||
{ Отдельной кнопки пуска нет — пробел делает то же самое, а состояние
|
||
видно по тому, едет ли курсор. Здесь остаётся только отметка в
|
||
строке состояния. }
|
||
if FPlayer.Paused then
|
||
SetStatus('Пауза')
|
||
else
|
||
SetStatus('Воспроизведение');
|
||
end;
|
||
|
||
{ Пуск и пауза. При запуске подтягиваем окно просмотра к курсору: если
|
||
он уехал за край, воспроизведение шло бы вслепую. Масштаб при этом не
|
||
трогаем — он выставлен осознанно. }
|
||
procedure TMainForm.TogglePlayback;
|
||
begin
|
||
if (FPlayer = nil) or (not FPlayer.Initialized) then
|
||
Exit;
|
||
if FPlayer.Paused then
|
||
FTimeline.ScrollToPlayhead(False);
|
||
FPlayer.TogglePause;
|
||
end;
|
||
|
||
|
||
|
||
procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
|
||
Shift: TShiftState);
|
||
begin
|
||
{ Пробел обрабатываем здесь, а не пунктом меню: пункт меню с пробелом
|
||
в качестве сочетания мешает вводу текста в других полях. }
|
||
if (Key = VK_SPACE) and (Shift = []) then
|
||
begin
|
||
Key := 0;
|
||
TogglePlayback;
|
||
Exit;
|
||
end;
|
||
|
||
{ Обратная косая — «покажи, где курсор»: окно едет к нему и ставит его
|
||
посередине. Жмут её чаще всего после реза или выделения, когда курсор
|
||
стоит на границе и надо к ней вернуться.
|
||
|
||
Раньше она переключала режим «курсор посередине». Переключатель
|
||
остался кнопкой с целью внизу: включают его раз и надолго, а
|
||
подтягивать окно к курсору нужно постоянно.
|
||
|
||
Пункта меню для неё нет намеренно — сочетание из одной такой клавиши
|
||
в меню выглядит как опечатка, а работать должно. }
|
||
if (Key = VK_OEM_5) and (Shift = []) then
|
||
begin
|
||
Key := 0;
|
||
FTimeline.ScrollToPlayhead(True);
|
||
SetStatus('Окно у курсора: ' + FormatTimecode(FTimeline.Playhead), True);
|
||
end;
|
||
end;
|
||
|
||
{ --- Пункты меню --- }
|
||
|
||
procedure TMainForm.MenuNewProject(Sender: TObject);
|
||
begin
|
||
if not ConfirmDiscard then
|
||
Exit;
|
||
FProject.NewProject;
|
||
FTimeline.Playhead := 0;
|
||
FTimeline.ZoomToFit;
|
||
FLastLoadedEdl := '';
|
||
RefreshPool;
|
||
UpdateCaption;
|
||
SchedulePreview;
|
||
Log('Новый проект.');
|
||
end;
|
||
|
||
procedure TMainForm.MenuOpenProject(Sender: TObject);
|
||
var
|
||
Err: string;
|
||
begin
|
||
if not ConfirmDiscard then
|
||
Exit;
|
||
if not OpenProjectDialog.Execute then
|
||
Exit;
|
||
FSettings.LastProjectDir := ExtractFilePath(OpenProjectDialog.FileName);
|
||
OpenProjectFile(OpenProjectDialog.FileName);
|
||
end;
|
||
|
||
function TMainForm.SaveProjectAs: Boolean;
|
||
var
|
||
Err: string;
|
||
begin
|
||
Result := False;
|
||
if not SaveProjectDialog.Execute then
|
||
Exit;
|
||
FSettings.LastProjectDir := ExtractFilePath(SaveProjectDialog.FileName);
|
||
if not FProject.SaveToFile(SaveProjectDialog.FileName, Err) then
|
||
begin
|
||
ThemedMessageDlg('nlve', Err, mtError, [mbOK], 0);
|
||
Exit;
|
||
end;
|
||
UpdateCaption;
|
||
FSettings.NoteRecentProject(FProject.FileName);
|
||
RefreshRecentMenu;
|
||
Log('Проект сохранён: ' + FProject.FileName);
|
||
Result := True;
|
||
end;
|
||
|
||
function TMainForm.DoSaveProject: Boolean;
|
||
var
|
||
Err: string;
|
||
begin
|
||
if FProject.FileName = '' then
|
||
Exit(SaveProjectAs);
|
||
Result := FProject.SaveToFile(FProject.FileName, Err);
|
||
if not Result then
|
||
ThemedMessageDlg('nlve', Err, mtError, [mbOK], 0)
|
||
else
|
||
begin
|
||
UpdateCaption;
|
||
{ Сохранение должно быть видно. Раньше о нём говорила только строчка
|
||
в журнале, а журнал по умолчанию закрыт: человек нажимал Ctrl+S,
|
||
ничего не происходило, и понять, дошло сохранение до файла или нет,
|
||
было не по чему. }
|
||
SetStatus('Проект сохранён: ' + ExtractFileName(FProject.FileName) +
|
||
', ' + FormatDateTime('hh:nn:ss', Now), True);
|
||
Log('Проект сохранён: ' + FProject.FileName);
|
||
{ Копия для восстановления больше не нужна: в файле то же самое. }
|
||
DropAutoSave;
|
||
end;
|
||
end;
|
||
|
||
{ Где лежит автосохранённая копия проекта. Рядом с самим проектом, чтобы
|
||
она нашлась там же, где его ищут. У безымянного проекта её нет: некуда
|
||
положить, и восстанавливать потом нечего. }
|
||
function TMainForm.AutoSavePath: string;
|
||
begin
|
||
if FProject.FileName = '' then
|
||
Result := ''
|
||
else
|
||
Result := FProject.FileName + AutoSaveSuffix;
|
||
end;
|
||
|
||
procedure TMainForm.DropAutoSave;
|
||
var
|
||
Path: string;
|
||
begin
|
||
Path := AutoSavePath;
|
||
if (Path <> '') and FileExists(Path) then
|
||
DeleteFile(Path);
|
||
end;
|
||
|
||
{ Копия проекта пишется, пока в нём есть несохранённое.
|
||
|
||
Это не замена сохранению: файл проекта не трогается, имя не меняется,
|
||
признак «изменён» остаётся. Копия нужна на случай, когда работа всё же
|
||
пропала — программу закрыли, она упала, сохранение не дошло до файла. }
|
||
procedure TMainForm.AutoSaveTick(Sender: TObject);
|
||
var
|
||
Path, Err: string;
|
||
begin
|
||
if FProject = nil then
|
||
Exit;
|
||
Path := AutoSavePath;
|
||
if Path = '' then
|
||
Exit;
|
||
{ Несохранённого нет — писать нечего. Копию при этом не трогаем: она
|
||
может быть единственным следом прошлой работы, а спросить о ней ещё
|
||
не успели. Убирается она там, где точно больше не нужна: после
|
||
сохранения проекта и после ответа на вопрос при открытии. }
|
||
if not FProject.Modified then
|
||
Exit;
|
||
if not FProject.SaveCopyTo(Path, Err) then
|
||
begin
|
||
{ Жалуемся один раз и больше не мешаем: автосохранение — подстраховка,
|
||
а не работа, ради которой человек сюда пришёл. }
|
||
if not FAutoSaveBroken then
|
||
begin
|
||
FAutoSaveBroken := True;
|
||
Log('Автосохранение не работает: ' + Err);
|
||
end;
|
||
end
|
||
else
|
||
FAutoSaveBroken := False;
|
||
end;
|
||
|
||
{ Проверка при открытии: не осталась ли копия новее самого проекта.
|
||
|
||
Так бывает ровно в одном случае — работа не дошла до файла проекта.
|
||
Молча подменять файл нельзя, поэтому спрашиваем и показываем время. }
|
||
procedure TMainForm.OfferAutoSave;
|
||
var
|
||
Path, Err: string;
|
||
CopyStamp, ProjStamp: LongInt;
|
||
CopyTime, ProjTime: TDateTime;
|
||
begin
|
||
Path := AutoSavePath;
|
||
if (Path = '') or (not FileExists(Path)) then
|
||
Exit;
|
||
CopyStamp := FileAge(Path);
|
||
ProjStamp := FileAge(FProject.FileName);
|
||
if (CopyStamp < 0) or (ProjStamp < 0) then
|
||
Exit;
|
||
CopyTime := FileDateToDateTime(CopyStamp);
|
||
ProjTime := FileDateToDateTime(ProjStamp);
|
||
{ Копия старше проекта — значит проект сохранён позже неё, и она уже
|
||
ни о чём не говорит. }
|
||
if CopyTime <= ProjTime + 1 / (24 * 60 * 60) then
|
||
begin
|
||
DeleteFile(Path);
|
||
Exit;
|
||
end;
|
||
|
||
Log(Format('Найдена автосохранённая копия от %s, проект сохранён %s.',
|
||
[FormatDateTime('dd.mm hh:nn:ss', CopyTime),
|
||
FormatDateTime('dd.mm hh:nn:ss', ProjTime)]));
|
||
|
||
if ThemedMessageDlg('nlve',
|
||
Format('Рядом с проектом лежит автосохранённая копия от %s, ' +
|
||
'а сам проект сохранён %s.' + LineEnding + LineEnding +
|
||
'Похоже, последние правки не дошли до файла проекта. ' +
|
||
'Открыть копию?' + LineEnding + LineEnding +
|
||
'Проект при этом не перезаписывается: копия просто откроется, и ' +
|
||
'сохранить её поверх проекта можно будет самому. Откажетесь — ' +
|
||
'копия останется лежать рядом, пока проект не сохранят заново.',
|
||
[FormatDateTime('dd.mm.yyyy hh:nn:ss', CopyTime),
|
||
FormatDateTime('dd.mm.yyyy hh:nn:ss', ProjTime)]),
|
||
mtConfirmation, [mbYes, mbNo], 0) <> mrYes then
|
||
Exit;
|
||
|
||
if not FProject.LoadFromFile(Path, Err) then
|
||
begin
|
||
ThemedMessageDlg('nlve', Err, mtError, [mbOK], 0);
|
||
Exit;
|
||
end;
|
||
|
||
{ Имя возвращаем проектное: копия открыта, но работать человек
|
||
продолжает с проектом, и Ctrl+S должен писать в него. }
|
||
FProject.FileName := Copy(Path, 1, Length(Path) - Length(AutoSaveSuffix));
|
||
FProject.Modified := True;
|
||
RefreshPool;
|
||
UpdateCaption;
|
||
FLastLoadedEdl := '';
|
||
SchedulePreview;
|
||
SetStatus('Открыта автосохранённая копия. Проверьте и сохраните: Ctrl+S.',
|
||
True);
|
||
end;
|
||
|
||
procedure TMainForm.MenuSaveProject(Sender: TObject);
|
||
begin
|
||
DoSaveProject;
|
||
end;
|
||
|
||
procedure TMainForm.MenuSaveProjectAs(Sender: TObject);
|
||
begin
|
||
SaveProjectAs;
|
||
end;
|
||
|
||
function TMainForm.ConfirmDiscard: Boolean;
|
||
begin
|
||
Result := True;
|
||
if not FProject.Modified then
|
||
Exit;
|
||
case ThemedMessageDlg('nlve', 'Проект изменён. Сохранить?',
|
||
mtConfirmation, [mbYes, mbNo, mbCancel], 0) of
|
||
mrYes: Result := DoSaveProject;
|
||
mrNo: Result := True;
|
||
else
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
||
begin
|
||
CanClose := ConfirmDiscard;
|
||
end;
|
||
|
||
procedure TMainForm.MenuQuit(Sender: TObject);
|
||
begin
|
||
Close;
|
||
end;
|
||
|
||
procedure TMainForm.MenuDeps(Sender: TObject);
|
||
begin
|
||
ShowDeps(Self);
|
||
|
||
{ Библиотека могла появиться только что. Перезапуск ради этого требовать
|
||
незачем: загрузка идёт по имени, и вторая попытка ничем не хуже
|
||
первой. }
|
||
if (FPlayer <> nil) and (not FPlayer.Initialized) then
|
||
begin
|
||
Log('Проверяю, появилась ли libmpv...');
|
||
StartPlayer;
|
||
if FPlayer.Initialized then
|
||
begin
|
||
FLastLoadedEdl := '';
|
||
SchedulePreview;
|
||
SetStatus('Предпросмотр заработал.');
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TMainForm.MenuRemux(Sender: TObject);
|
||
var
|
||
Form: TRemuxForm;
|
||
begin
|
||
Form := TRemuxForm.Create(Self);
|
||
try
|
||
Form.ShowModal;
|
||
finally
|
||
Form.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TMainForm.MenuUndo(Sender: TObject);
|
||
begin
|
||
if not FProject.CanUndo then
|
||
begin
|
||
SetStatus('Отменять нечего.');
|
||
Exit;
|
||
end;
|
||
FProject.Undo;
|
||
RefreshPool;
|
||
FTimeline.Invalidate;
|
||
SchedulePreview;
|
||
UpdateCaption;
|
||
SetStatus('Отменено.', True);
|
||
end;
|
||
|
||
procedure TMainForm.MenuRedo(Sender: TObject);
|
||
begin
|
||
if not FProject.CanRedo then
|
||
begin
|
||
SetStatus('Повторять нечего.');
|
||
Exit;
|
||
end;
|
||
FProject.Redo;
|
||
RefreshPool;
|
||
FTimeline.Invalidate;
|
||
SchedulePreview;
|
||
UpdateCaption;
|
||
SetStatus('Повторено.', True);
|
||
end;
|
||
|
||
{ Рез отчитывается числом. Молчание после нажатия клавиши читается как
|
||
«она не работает»: именно так выглядел рез, когда курсор стоял на стыке
|
||
или на пустом месте. }
|
||
function SplitReport(ACount: Integer): string;
|
||
begin
|
||
if ACount = 0 then
|
||
Result := 'Резать нечего: под курсором нет клипов или он ровно на стыке.'
|
||
else
|
||
Result := Format('Разрезано %d %s.', [ACount,
|
||
Plural(ACount, 'клип', 'клипа', 'клипов')]);
|
||
end;
|
||
|
||
procedure TMainForm.MenuSplit(Sender: TObject);
|
||
begin
|
||
SetStatus(SplitReport(FTimeline.SplitAtPlayhead(False)), True);
|
||
end;
|
||
|
||
procedure TMainForm.MenuDelete(Sender: TObject);
|
||
begin
|
||
FTimeline.DeleteSelected;
|
||
end;
|
||
|
||
{ Цветовой ключ выделенного клипа.
|
||
|
||
Ключ принадлежит клипу, а не файлу: один и тот же кусок может лежать в
|
||
монтаже дважды, и выбивать цвет нужно не всегда.
|
||
|
||
Клип с ключом перестаёт быть сплошным, и участок под ним собирается
|
||
слоями — тем же способом, что и полупрозрачный. Значит, эти секунды
|
||
придётся пересчитать; об этом окно предупреждает. }
|
||
procedure TMainForm.MenuColorKey(Sender: TObject);
|
||
var
|
||
T, C: Integer;
|
||
Track: TTrack;
|
||
Found: TClip;
|
||
Item: TMediaItem;
|
||
Key: TColorKey;
|
||
begin
|
||
Found := nil;
|
||
for T := 0 to FProject.TrackCount - 1 do
|
||
begin
|
||
Track := FProject.Tracks[T];
|
||
for C := 0 to Track.Count - 1 do
|
||
if Track[C].Selected and (Track[C].Kind in [ckVideo, ckImage]) then
|
||
begin
|
||
Found := Track[C];
|
||
Break;
|
||
end;
|
||
if Found <> nil then
|
||
Break;
|
||
end;
|
||
|
||
if Found = nil then
|
||
begin
|
||
SetStatus('Выделите клип с картинкой: ключ выбивает цвет из неё.');
|
||
Exit;
|
||
end;
|
||
|
||
Item := FProject.FindMedia(Found.MediaId);
|
||
if Item = nil then
|
||
Exit;
|
||
|
||
Key := Found.ColorKey;
|
||
if not EditColorKey(Key, Item.EffectivePath,
|
||
Found.SrcIn + Found.Duration / 2, FProject.CacheDir + 'colorkey.png') then
|
||
Exit;
|
||
|
||
FProject.BeginChange;
|
||
Found.ColorKey := Key;
|
||
FTimeline.Invalidate;
|
||
FLastLoadedEdl := '';
|
||
SchedulePreview;
|
||
UpdateCaption;
|
||
if Key.Enabled then
|
||
SetStatus('Цветовой ключ включён: участок будет пересобран.', True)
|
||
else
|
||
SetStatus('Цветовой ключ выключен.', True);
|
||
end;
|
||
|
||
{ Отметки участка.
|
||
|
||
Участок нужен, чтобы собрать кусок монтажа, а не весь ролик: на длинном
|
||
материале проверить правку иначе почти невозможно — сборка занимает
|
||
столько же, сколько сам ролик, а то и больше.
|
||
|
||
Отметки ставятся по курсору, как в монтажных программах. Перепутанные
|
||
местами меняются сами: требовать от человека помнить порядок — лишняя
|
||
строгость там, где всё однозначно. }
|
||
{ Копирование клипов.
|
||
|
||
Отбивку или текстовый блок проще размножить копией, чем заводить заново
|
||
через меню и настраивать заново оформление. Связанные клипы копируются
|
||
вместе с парой: у картинки со звуком иначе уехала бы половина.
|
||
|
||
Взаимное расположение сохраняется: несколько клипов вставляются тем же
|
||
узором, сдвинутым к курсору. }
|
||
procedure TMainForm.MenuCopyClips(Sender: TObject);
|
||
var
|
||
T, C, I: Integer;
|
||
Clip, Copy: TClip;
|
||
Track: TTrack;
|
||
Base: Double;
|
||
Taken: TFPList;
|
||
|
||
{ Берём и связанные: они двигаются, режутся и удаляются вместе, значит
|
||
и копироваться должны вместе. }
|
||
procedure TakeWithGroup(ASource: TClip);
|
||
var
|
||
Ti, Ci: Integer;
|
||
Other: TClip;
|
||
begin
|
||
if Taken.IndexOf(ASource) >= 0 then
|
||
Exit;
|
||
Taken.Add(ASource);
|
||
if ASource.GroupId = '' then
|
||
Exit;
|
||
for Ti := 0 to FProject.TrackCount - 1 do
|
||
for Ci := 0 to FProject.Tracks[Ti].Count - 1 do
|
||
begin
|
||
Other := FProject.Tracks[Ti][Ci];
|
||
if (Other.GroupId = ASource.GroupId) and (Taken.IndexOf(Other) < 0) then
|
||
Taken.Add(Other);
|
||
end;
|
||
end;
|
||
|
||
begin
|
||
Taken := TFPList.Create;
|
||
try
|
||
for T := 0 to FProject.TrackCount - 1 do
|
||
for C := 0 to FProject.Tracks[T].Count - 1 do
|
||
if FProject.Tracks[T][C].Selected then
|
||
TakeWithGroup(FProject.Tracks[T][C]);
|
||
|
||
if Taken.Count = 0 then
|
||
begin
|
||
SetStatus('Сначала выделите клипы, которые копировать.');
|
||
Exit;
|
||
end;
|
||
|
||
FClipboard.Clear;
|
||
FClipTrackNames := nil;
|
||
FClipOffsets := nil;
|
||
FClipGroups := nil;
|
||
|
||
{ Смещения считаем от самого раннего клипа: вставка кладёт его под
|
||
курсор, остальные — как лежали относительно него. }
|
||
Base := TClip(Taken[0]).TlStart;
|
||
for I := 1 to Taken.Count - 1 do
|
||
Base := Min(Base, TClip(Taken[I]).TlStart);
|
||
|
||
SetLength(FClipTrackNames, Taken.Count);
|
||
SetLength(FClipOffsets, Taken.Count);
|
||
SetLength(FClipGroups, Taken.Count);
|
||
for I := 0 to Taken.Count - 1 do
|
||
begin
|
||
Clip := TClip(Taken[I]);
|
||
Track := FProject.FindClipTrack(Clip);
|
||
Copy := TClip.Create;
|
||
Copy.CopyAllFrom(Clip);
|
||
FClipboard.Add(Copy);
|
||
if Track <> nil then
|
||
FClipTrackNames[I] := Track.Name
|
||
else
|
||
FClipTrackNames[I] := '';
|
||
FClipOffsets[I] := Clip.TlStart - Base;
|
||
FClipGroups[I] := Clip.GroupId;
|
||
end;
|
||
|
||
SetStatus(Format('Скопировано %d %s. Вставить: Ctrl+V.',
|
||
[Taken.Count, Plural(Taken.Count, 'клип', 'клипа', 'клипов')]), True);
|
||
finally
|
||
Taken.Free;
|
||
end;
|
||
end;
|
||
|
||
{ Дорожка для вставки: сначала та, откуда копировали, если она есть и
|
||
время свободно; потом любая подходящая по виду; в крайнем случае новая.
|
||
Класть клип поверх соседа нельзя: на одной дорожке это означает переход,
|
||
а его никто не заказывал. }
|
||
function TMainForm.TrackForPaste(AClip: TClip; const AName: string): TTrack;
|
||
var
|
||
I: Integer;
|
||
Need: TTrackKind;
|
||
|
||
function Fits(ATrack: TTrack): Boolean;
|
||
var
|
||
C: Integer;
|
||
begin
|
||
Result := True;
|
||
for C := 0 to ATrack.Count - 1 do
|
||
if (AClip.TlStart < ATrack[C].TlEnd - 0.001) and
|
||
(AClip.TlEnd > ATrack[C].TlStart + 0.001) then
|
||
Exit(False);
|
||
end;
|
||
|
||
begin
|
||
Need := TProject.TrackKindFor(AClip.Kind);
|
||
|
||
for I := 0 to FProject.TrackCount - 1 do
|
||
if (FProject.Tracks[I].Name = AName) and (FProject.Tracks[I].Kind = Need) and
|
||
Fits(FProject.Tracks[I]) then
|
||
Exit(FProject.Tracks[I]);
|
||
|
||
for I := 0 to FProject.TrackCount - 1 do
|
||
if (FProject.Tracks[I].Kind = Need) and Fits(FProject.Tracks[I]) then
|
||
Exit(FProject.Tracks[I]);
|
||
|
||
case Need of
|
||
tkAudio: Result := FProject.AddTrackOfKind(FProject.UniqueTrackName('A'),
|
||
tkAudio);
|
||
tkText: Result := FProject.AddTrackOfKind(FProject.UniqueTrackName('Т'),
|
||
tkText);
|
||
else
|
||
Result := FProject.AddTrack(FProject.UniqueTrackName('V'));
|
||
end;
|
||
end;
|
||
|
||
procedure TMainForm.MenuPasteClips(Sender: TObject);
|
||
var
|
||
I, J: Integer;
|
||
Clip: TClip;
|
||
Track: TTrack;
|
||
NewGroups: TStringList;
|
||
begin
|
||
if FClipboard.Count = 0 then
|
||
begin
|
||
SetStatus('Сначала скопируйте клипы: Ctrl+C.');
|
||
Exit;
|
||
end;
|
||
|
||
FProject.BeginChange;
|
||
FProject.ClearSelection;
|
||
|
||
{ Связки у вставленных свои: иначе копия и подлинник ездили бы и
|
||
удалялись вместе. Прежние связки при этом сохраняются как связки
|
||
внутри вставленного набора. }
|
||
NewGroups := TStringList.Create;
|
||
try
|
||
NewGroups.NameValueSeparator := '=';
|
||
for I := 0 to FClipboard.Count - 1 do
|
||
begin
|
||
Clip := TClip.Create;
|
||
Clip.CopyAllFrom(TClip(FClipboard[I]));
|
||
Clip.Id := FProject.NewId('c');
|
||
Clip.TlStart := Max(0, FTimeline.Playhead + FClipOffsets[I]);
|
||
Clip.Selected := True;
|
||
|
||
{ Старая связка отображается в новую: клипы, связанные между собой,
|
||
останутся связанными и после вставки, но с подлинником общего у
|
||
них больше не будет. }
|
||
if FClipGroups[I] <> '' then
|
||
begin
|
||
J := NewGroups.IndexOfName(FClipGroups[I]);
|
||
if J < 0 then
|
||
J := NewGroups.Add(FClipGroups[I] + '=' + FProject.NewId('g'));
|
||
Clip.GroupId := NewGroups.ValueFromIndex[J];
|
||
end;
|
||
|
||
Track := TrackForPaste(Clip, FClipTrackNames[I]);
|
||
Track.Add(Clip);
|
||
Track.Sort;
|
||
end;
|
||
finally
|
||
NewGroups.Free;
|
||
end;
|
||
|
||
FTimeline.Invalidate;
|
||
FLastLoadedEdl := '';
|
||
SchedulePreview;
|
||
UpdateCaption;
|
||
SetStatus(Format('Вставлено %d %s.',
|
||
[FClipboard.Count,
|
||
Plural(FClipboard.Count, 'клип', 'клипа', 'клипов')]), True);
|
||
end;
|
||
|
||
{ Первый выделенный клип: с него берут свойства. }
|
||
function TMainForm.FirstSelectedClip: TClip;
|
||
var
|
||
T, C: Integer;
|
||
begin
|
||
Result := nil;
|
||
for T := 0 to FProject.TrackCount - 1 do
|
||
for C := 0 to FProject.Tracks[T].Count - 1 do
|
||
if FProject.Tracks[T][C].Selected then
|
||
Exit(FProject.Tracks[T][C]);
|
||
end;
|
||
|
||
{ Копирование оформления с клипа на клип.
|
||
|
||
Настроить кадрирование, ключ и прозрачность — работа на минуты, а
|
||
клипов с одинаковой настройкой в монтаже бывает десяток: та же
|
||
миникарта, разрезанная на куски, или несколько снимков в одной рамке. }
|
||
procedure TMainForm.MenuCopyLook(Sender: TObject);
|
||
var
|
||
Src: TClip;
|
||
begin
|
||
Src := FirstSelectedClip;
|
||
if Src = nil then
|
||
begin
|
||
SetStatus('Сначала выделите клип, с которого брать свойства.');
|
||
Exit;
|
||
end;
|
||
|
||
if FLookClip = nil then
|
||
FLookClip := TClip.Create;
|
||
FLookClip.Kind := Src.Kind;
|
||
FLookClip.CopyLookFrom(Src);
|
||
SetStatus('Свойства клипа скопированы. Применить: Ctrl+Shift+V.', True);
|
||
end;
|
||
|
||
procedure TMainForm.MenuPasteLook(Sender: TObject);
|
||
var
|
||
T, C, N: Integer;
|
||
begin
|
||
if FLookClip = nil then
|
||
begin
|
||
SetStatus('Сначала скопируйте свойства клипа: Ctrl+Shift+C.');
|
||
Exit;
|
||
end;
|
||
|
||
N := 0;
|
||
FProject.BeginChange;
|
||
for T := 0 to FProject.TrackCount - 1 do
|
||
for C := 0 to FProject.Tracks[T].Count - 1 do
|
||
if FProject.Tracks[T][C].Selected then
|
||
begin
|
||
FProject.Tracks[T][C].CopyLookFrom(FLookClip);
|
||
Inc(N);
|
||
end;
|
||
|
||
if N = 0 then
|
||
begin
|
||
FProject.CancelChange;
|
||
SetStatus('Выделите клипы, к которым применить свойства.');
|
||
Exit;
|
||
end;
|
||
|
||
FTimeline.Invalidate;
|
||
FLastLoadedEdl := '';
|
||
SchedulePreview;
|
||
UpdateCaption;
|
||
SetStatus(Format('Свойства применены к %d %s.',
|
||
[N, Plural(N, 'клипу', 'клипам', 'клипам')]), True);
|
||
end;
|
||
|
||
procedure TMainForm.MenuRegionIn(Sender: TObject);
|
||
begin
|
||
FProject.RegionStart := FTimeline.Playhead;
|
||
if FProject.RegionEnd <= FProject.RegionStart then
|
||
FProject.RegionEnd := FProject.EndTime;
|
||
FTimeline.Invalidate;
|
||
UpdateCaption;
|
||
SetStatus(Format('Участок: %s — %s',
|
||
[SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)]), True);
|
||
end;
|
||
|
||
procedure TMainForm.MenuRegionOut(Sender: TObject);
|
||
var
|
||
Tmp: Double;
|
||
begin
|
||
FProject.RegionEnd := FTimeline.Playhead;
|
||
if FProject.RegionEnd < FProject.RegionStart then
|
||
begin
|
||
Tmp := FProject.RegionStart;
|
||
FProject.RegionStart := FProject.RegionEnd;
|
||
FProject.RegionEnd := Tmp;
|
||
end;
|
||
FTimeline.Invalidate;
|
||
UpdateCaption;
|
||
SetStatus(Format('Участок: %s — %s',
|
||
[SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)]), True);
|
||
end;
|
||
|
||
procedure TMainForm.MenuRegionClear(Sender: TObject);
|
||
begin
|
||
FProject.RegionStart := 0;
|
||
FProject.RegionEnd := 0;
|
||
FTimeline.Invalidate;
|
||
UpdateCaption;
|
||
SetStatus('Отметки участка сняты: собирается весь монтаж.', True);
|
||
end;
|
||
|
||
{ Границы того, что собираем. Без отметок — весь монтаж. }
|
||
procedure TMainForm.DescribeRegion(out AFrom, ATo: Double);
|
||
begin
|
||
if FProject.HasRegion then
|
||
begin
|
||
AFrom := Max(0, FProject.RegionStart);
|
||
ATo := FProject.RegionEnd;
|
||
end
|
||
else
|
||
begin
|
||
AFrom := 0;
|
||
ATo := FProject.EndTime;
|
||
end;
|
||
end;
|
||
|
||
procedure TMainForm.MenuSelectAll(Sender: TObject);
|
||
begin
|
||
FTimeline.SelectAll;
|
||
end;
|
||
|
||
procedure TMainForm.MenuRipple(Sender: TObject);
|
||
begin
|
||
{ Команда должна отвечать всегда: молчание читается как «не работает».
|
||
Дорожку называем: дыра могла найтись не на той, где стоял указатель,
|
||
и сдвиг чужой дорожки должен быть виден. }
|
||
if FTimeline.RippleCloseGap then
|
||
SetStatus('Дыра на дорожке ' + FTimeline.LastGapTrack + ' схлопнута.', True)
|
||
else
|
||
SetStatus('Под курсором дыры нет: схлопывать нечего.', True);
|
||
end;
|
||
|
||
{ К началу самого раннего клипа по всем дорожкам. Если монтаж начинается
|
||
с пятой секунды, ноль — не то место, куда хотят попасть. }
|
||
{ Показывать ли в предпросмотре то, что даст сборка.
|
||
|
||
Выключено — оверлей виден целиком, со своим фоном: так понятно, куда он
|
||
встал и где его края. Включено — выбитый цвет и прозрачность считаются
|
||
на лету, и окно совпадает с готовым роликом.
|
||
|
||
Считается это не бесплатно, хотя и недорого: фильтр работает по площади
|
||
оверлея, а не всего кадра. Замерено на 2688x1512: наложение стоит 0.36 с
|
||
на десять секунд материала, ключ добавляет ещё 0.23 с. }
|
||
procedure TMainForm.MenuTogglePreviewKey(Sender: TObject);
|
||
begin
|
||
FSettings.PreviewKey := not FSettings.PreviewKey;
|
||
FKeyPreviewItem.Checked := FSettings.PreviewKey;
|
||
{ Список кусков не изменился, а показывать надо иначе — заставляем
|
||
пересобрать цепочку. }
|
||
FLastLoadedEdl := '';
|
||
SchedulePreview;
|
||
if FSettings.PreviewKey then
|
||
SetStatus('Предпросмотр показывает ключ и прозрачность.')
|
||
else
|
||
SetStatus('Предпросмотр показывает оверлей как есть.');
|
||
end;
|
||
|
||
procedure TMainForm.MenuToggleRipple(Sender: TObject);
|
||
begin
|
||
ToggleRipple;
|
||
end;
|
||
|
||
procedure TMainForm.MenuGoStart(Sender: TObject);
|
||
begin
|
||
FTimeline.Playhead := FTimeline.FirstClipTime;
|
||
FTimeline.ScrollToPlayhead(False);
|
||
end;
|
||
|
||
{ К концу самого позднего клипа по всем дорожкам. }
|
||
procedure TMainForm.MenuGoEnd(Sender: TObject);
|
||
begin
|
||
FTimeline.Playhead := FTimeline.LastClipTime;
|
||
FTimeline.ScrollToPlayhead(False);
|
||
end;
|
||
|
||
procedure TMainForm.MenuZoomFit(Sender: TObject);
|
||
begin
|
||
FTimeline.ZoomToFit;
|
||
end;
|
||
|
||
procedure TMainForm.MenuZoomIn(Sender: TObject);
|
||
begin
|
||
FTimeline.ZoomAt(1.5, FTimeline.ClientWidth div 2);
|
||
end;
|
||
|
||
procedure TMainForm.MenuZoomOut(Sender: TObject);
|
||
begin
|
||
FTimeline.ZoomAt(1 / 1.5, FTimeline.ClientWidth div 2);
|
||
end;
|
||
|
||
procedure TMainForm.MenuAddTrack(Sender: TObject);
|
||
begin
|
||
FProject.BeginChange;
|
||
FProject.AddTrack(FProject.UniqueTrackName('V'));
|
||
FTimeline.Invalidate;
|
||
UpdateCaption;
|
||
end;
|
||
|
||
procedure TMainForm.MenuRemoveTrack(Sender: TObject);
|
||
begin
|
||
if FProject.TrackCount <= 1 then
|
||
begin
|
||
SetStatus('Последнюю дорожку удалить нельзя.');
|
||
Exit;
|
||
end;
|
||
FProject.BeginChange;
|
||
FProject.RemoveTrack(FProject.TrackCount - 1);
|
||
if FTimeline.ActiveTrack >= FProject.TrackCount then
|
||
FTimeline.ActiveTrack := FProject.TrackCount - 1;
|
||
FTimeline.Invalidate;
|
||
SchedulePreview;
|
||
UpdateCaption;
|
||
end;
|
||
|
||
{ --- Приведение файла к параметрам проекта --- }
|
||
|
||
procedure TMainForm.NormalizeProgress(Sender: TObject);
|
||
begin
|
||
if Assigned(FNormalizeUi) then
|
||
begin
|
||
FNormalizeUi.SetStage(FNormalize.Title);
|
||
FNormalizeUi.SetFraction(FNormalize.Fraction);
|
||
end;
|
||
end;
|
||
|
||
procedure TMainForm.NormalizeLog(Sender: TObject);
|
||
begin
|
||
if Assigned(FNormalizeUi) then
|
||
FNormalizeUi.AddLog(FNormalize.PendingLog);
|
||
end;
|
||
|
||
procedure TMainForm.NormalizeDone(Sender: TObject);
|
||
begin
|
||
if Assigned(FNormalizeUi) then
|
||
FNormalizeUi.Finish(FNormalize.Succeeded, FNormalize.Message);
|
||
end;
|
||
|
||
procedure TMainForm.NormalizeCancel(Sender: TObject);
|
||
begin
|
||
if Assigned(FNormalize) then
|
||
FNormalize.RequestCancel;
|
||
end;
|
||
|
||
{ --- Сборка ролика --- }
|
||
|
||
{ Обычная сборка: копирование потоков, ради чего редактор и делался. }
|
||
procedure TMainForm.MenuExport(Sender: TObject);
|
||
begin
|
||
DoExport(Default(TEncodeProfile));
|
||
end;
|
||
|
||
{ Сборка с перекодированием: отдельный пункт, потому что это осознанный
|
||
выбор — ролик пересобирается целиком, и быстрым это уже не будет. }
|
||
procedure TMainForm.MenuExportEncode(Sender: TObject);
|
||
var
|
||
Profile: TEncodeProfile;
|
||
begin
|
||
if not AskEncodeProfile(Profile, FProject.Master.VideoCodec) then
|
||
Exit;
|
||
DoExport(Profile);
|
||
end;
|
||
|
||
procedure TMainForm.DoExport(const AProfile: TEncodeProfile);
|
||
var
|
||
Segments, AudioSegs: TFlatSegmentArray;
|
||
Missing: TGenRequests;
|
||
HasPrecise: Boolean;
|
||
T, C: Integer;
|
||
Rebuilt, RegionFrom, RegionTo: Double;
|
||
SubsPath, RegionCaption, Extra: string;
|
||
Master: TMediaInfo;
|
||
begin
|
||
if not FlattenProject(FProject, Segments, AudioSegs, Missing) then
|
||
begin
|
||
ThemedMessageDlg('nlve', 'На монтаже нечего собирать.', mtInformation, [mbOK], 0);
|
||
Exit;
|
||
end;
|
||
|
||
if Length(Missing) > 0 then
|
||
begin
|
||
ThemedMessageDlg('nlve',
|
||
'Ещё не готовы вставки для картинок или пустых мест. ' +
|
||
'Подождите, пока они создадутся, и повторите.',
|
||
mtInformation, [mbOK], 0);
|
||
SchedulePreview;
|
||
Exit;
|
||
end;
|
||
|
||
DescribeRegion(RegionFrom, RegionTo);
|
||
RegionCaption := '';
|
||
if FProject.HasRegion then
|
||
RegionCaption := SecondsToStr(RegionFrom) + ' — ' + SecondsToStr(RegionTo);
|
||
|
||
{ Сколько материала придётся пересобрать. Наложение, переход,
|
||
полупрозрачность и чужие параметры файла — всё это перекодирование, и
|
||
человек должен знать цену заранее, а не обнаружить её по времени
|
||
сборки. }
|
||
Rebuilt := 0;
|
||
|
||
{ Если есть хоть один точный рез, предупреждаем про контейнер: в MP4
|
||
перекодированный кусок и скопированный уживаются не всегда, а MKV
|
||
к смене параметров потока терпимее.
|
||
|
||
Признак — клип, начинающийся не с начала файла: попасть началом ровно
|
||
на опорный кадр можно только случайно, а во всех прочих случаях
|
||
огрызок до ближайшего опорного кадра перекодируется. Отметка edPrecise
|
||
сюда больше не годится: резы теперь точные всегда, независимо от неё. }
|
||
HasPrecise := False;
|
||
for T := 0 to FProject.TrackCount - 1 do
|
||
for C := 0 to FProject.Tracks[T].Count - 1 do
|
||
if (FProject.Tracks[T][C].Kind = ckVideo) and
|
||
(FProject.Tracks[T][C].SrcIn > 0.0001) then
|
||
HasPrecise := True;
|
||
|
||
{ Куда собирать, в каком контейнере и что делать с текстом — один
|
||
вопрос: ответ на любую его часть меняет допустимое в остальных. }
|
||
if not AskExport(FExportChoice, HasText(FProject), HasPrecise,
|
||
FSettings.LastExportDir, RegionCaption) then
|
||
Exit;
|
||
FSettings.LastExportDir := ExtractFilePath(FExportChoice.Path);
|
||
|
||
{ Участок режется после вопроса: человек мог снять галку и собрать всё.
|
||
Картинка и звук подрезаются по одному времени, иначе они разъедутся. }
|
||
if not (FProject.HasRegion and FExportChoice.RegionOnly) then
|
||
begin
|
||
RegionFrom := 0;
|
||
RegionTo := TotalDuration(Segments);
|
||
end
|
||
else
|
||
begin
|
||
{ Края участка — тоже на кадровую сетку. Иначе подрезка вернёт в
|
||
крайние куски доли кадра, которые уплощение только что убрало, и
|
||
картинка с звуком на краях участка разойдутся на полкадра. }
|
||
RegionFrom := FrameAlign(RegionFrom, FProject.Master);
|
||
RegionTo := FrameAlign(RegionTo, FProject.Master);
|
||
ClipSegmentsToRange(Segments, RegionFrom, RegionTo);
|
||
ClipSegmentsToRange(AudioSegs, RegionFrom, RegionTo);
|
||
if Length(Segments) = 0 then
|
||
begin
|
||
ThemedMessageDlg('nlve',
|
||
'В отмеченном участке нечего собирать.', mtInformation, [mbOK], 0);
|
||
Exit;
|
||
end;
|
||
end;
|
||
|
||
if not AskContainer(HasPrecise) then
|
||
Exit;
|
||
|
||
{ Сколько материала придётся пересобрать — считаем уже по тому списку,
|
||
который пойдёт в сборку: с участком он короче, и обещать человеку
|
||
работу на весь ролик было бы неправдой. }
|
||
for T := 0 to High(Segments) do
|
||
if Segments[T].Transcode or (Length(Segments[T].Layers) > 0) then
|
||
Rebuilt := Rebuilt + Segments[T].Duration;
|
||
|
||
{ Вжигание меняет расклад: куски с текстом перестают копироваться.
|
||
Готовим их до подсчёта того, сколько придётся пересобрать. }
|
||
SubsPath := '';
|
||
if HasText(FProject) then
|
||
begin
|
||
if FExportChoice.BurnText then
|
||
{ Начало списка — не обязательно начало монтажа: при отмеченном
|
||
участке текст надо брать с его начала. }
|
||
Rebuilt := Rebuilt +
|
||
BurnTextIntoSegments(FProject, Segments, FProject.CacheDir, RegionFrom)
|
||
else
|
||
begin
|
||
SubsPath := IncludeTrailingPathDelimiter(FProject.CacheDir) +
|
||
'export.ass';
|
||
{ Разметка тоже по участку: иначе субтитры в готовом файле
|
||
появлялись бы со сдвигом на его начало. }
|
||
if not WriteAssForRange(FProject, RegionFrom, RegionTo, SubsPath) then
|
||
SubsPath := '';
|
||
end;
|
||
end;
|
||
|
||
if Rebuilt > 0.5 then
|
||
if ThemedMessageDlg('nlve',
|
||
Format('Часть ролика придётся пересобрать: %s с из %s.' + LineEnding +
|
||
LineEnding +
|
||
'Пересобираются участки с наложением, переходами, прозрачностью, ' +
|
||
'вжигаемым текстом и куски файлов, не совпадающих с параметрами ' +
|
||
'проекта. Остальное копируется без потерь и почти мгновенно.' +
|
||
LineEnding + LineEnding +
|
||
'Продолжить?',
|
||
[SecondsToStr(Rebuilt), SecondsToStr(TotalDuration(Segments))]),
|
||
mtConfirmation, [mbYes, mbNo], 0) <> mrYes then
|
||
Exit;
|
||
|
||
{ Пересобираемые куски целятся в битрейт самого щедрого исходника, а не
|
||
в то, что кодировщик выберет сам: его выбор скромнее в разы, и
|
||
пересобранный кусок оказывается заметно хуже соседних скопированных. }
|
||
Master := FProject.Master;
|
||
Master.VideoBitrate := FProject.MaxVideoBitrate;
|
||
|
||
{ Журнал этой сборки: рядом с готовым файлом, под тем же именем.
|
||
Прежний одноимённый убираем — иначе две сборки слиплись бы в один
|
||
файл, и разобрать, где чья, было бы нельзя. }
|
||
FExportLogPath := ChangeFileExt(FExportChoice.Path, '.log');
|
||
if FileExists(FExportLogPath) then
|
||
SysUtils.DeleteFile(FExportLogPath);
|
||
|
||
LogExport(Format('nlve, сборка от %s',
|
||
[FormatDateTime('yyyy-mm-dd hh:nn:ss', Now)]));
|
||
LogExport('Проект: ' + FProject.FileName);
|
||
LogExport('Готовый файл: ' + FExportChoice.Path);
|
||
if FProject.HasRegion and FExportChoice.RegionOnly then
|
||
LogExport(Format('Собирается отмеченный участок: %s — %s',
|
||
[SecondsToStr(RegionFrom), SecondsToStr(RegionTo)]))
|
||
else
|
||
LogExport('Собирается весь монтаж.');
|
||
LogExport(Format('Кадр проекта: %dx%d, %d/%d к/с, %s, %s',
|
||
[Master.Width, Master.Height, Master.FpsNum, Master.FpsDen,
|
||
Master.VideoCodec, Master.PixFmt]));
|
||
LogExport(Format('Целевой битрейт: %d кбит/с (наибольший среди файлов проекта)',
|
||
[Master.VideoBitrate div 1000]));
|
||
if FExportChoice.BurnText then
|
||
LogExport('Текст вжигается в картинку.')
|
||
else if SubsPath <> '' then
|
||
LogExport('Текст идёт отдельной дорожкой субтитров.')
|
||
else if HasText(FProject) then
|
||
LogExport('ВНИМАНИЕ: текст в проекте есть, но в сборку не попадает.');
|
||
LogExport(Format('%d %s, длительность %s с',
|
||
[Length(Segments), Plural(Length(Segments), 'кусок', 'куска', 'кусков'),
|
||
SecondsToStr(TotalDuration(Segments))]));
|
||
|
||
{ Что именно собирается — по кускам. Без этого списка по журналу нельзя
|
||
понять, попал ли в сборку тот клип, которого потом не нашли в ролике. }
|
||
for T := 0 to High(Segments) do
|
||
begin
|
||
Extra := '';
|
||
if Length(Segments[T].Layers) > 0 then
|
||
Extra := Extra + ', слоёв ' + IntToStr(Length(Segments[T].Layers));
|
||
if Segments[T].SubFile <> '' then
|
||
Extra := Extra + ', с текстом';
|
||
if Segments[T].Transcode then
|
||
Extra := Extra + ', пересобирается';
|
||
LogExport(Format(' кусок %d: %s, из %s, длина %s%s',
|
||
[T + 1, ExtractFileName(Segments[T].FilePath),
|
||
SecondsToStr(Segments[T].SrcStart), SecondsToStr(Segments[T].Duration),
|
||
Extra]));
|
||
end;
|
||
|
||
{ Временные куски после удачной сборки убираются: они весят столько же,
|
||
сколько готовый ролик, а нужны только чтобы продолжить прерванную
|
||
сборку. После неудачи их никто не трогает. }
|
||
FExport := TExportThread.Create(Segments, AudioSegs,
|
||
FExportChoice.Path, FSettings.KeepParts, Master, AProfile);
|
||
FExport.SubtitlePath := SubsPath;
|
||
FExport.LogPath := FExportLogPath;
|
||
FExport.Resume := AskResume(FExportChoice.Path);
|
||
FExport.OnProgress := @ExportProgress;
|
||
FExport.OnLog := @ExportLog;
|
||
FExport.OnTerminate := @ExportDone;
|
||
|
||
FExportUi := TProgressForm.Create(Self);
|
||
try
|
||
{ Не «Сборка ролика»: так называется окно настроек, и два окна с
|
||
одинаковым заголовком путают. }
|
||
FExportUi.Caption := 'Ход сборки';
|
||
FExportUi.OnCancelRequest := @ExportCancel;
|
||
FExport.Start;
|
||
FExportUi.ShowModal;
|
||
finally
|
||
FreeAndNil(FExportUi);
|
||
end;
|
||
|
||
if Assigned(FExport) then
|
||
begin
|
||
FExport.WaitFor;
|
||
if FExport.ReusedParts > 0 then
|
||
LogExport(Format('Взято готовыми из прошлой сборки: %d %s.',
|
||
[FExport.ReusedParts,
|
||
Plural(FExport.ReusedParts, 'кусок', 'куска', 'кусков')]));
|
||
ShowExportReport(FExport.Report);
|
||
FreeAndNil(FExport);
|
||
end;
|
||
end;
|
||
|
||
procedure TMainForm.ExportProgress(Sender: TObject);
|
||
begin
|
||
if Assigned(FExportUi) then
|
||
begin
|
||
FExportUi.SetStage(FExport.StageText);
|
||
FExportUi.SetFraction(FExport.Fraction);
|
||
end;
|
||
end;
|
||
|
||
procedure TMainForm.ExportLog(Sender: TObject);
|
||
begin
|
||
if Assigned(FExportUi) then
|
||
FExportUi.AddLog(FExport.PendingLog);
|
||
end;
|
||
|
||
procedure TMainForm.ExportCancel(Sender: TObject);
|
||
begin
|
||
if Assigned(FExport) then
|
||
FExport.RequestCancel;
|
||
end;
|
||
|
||
procedure TMainForm.ExportDone(Sender: TObject);
|
||
var
|
||
Rep: TExportReport;
|
||
begin
|
||
if not Assigned(FExportUi) then
|
||
Exit;
|
||
Rep := FExport.Report;
|
||
FExportUi.Finish(Rep.Succeeded, Rep.Message);
|
||
if Rep.Succeeded then
|
||
FExportUi.AddLog('Файл: ' + Rep.OutputPath);
|
||
end;
|
||
|
||
{ Журнал сборки лежит рядом с готовым файлом и называется так же.
|
||
|
||
Зачем отдельно от общего журнала программы: тот перезаписывается при
|
||
следующем запуске, а разбираться, почему в ролике не то, приходится
|
||
потом — иногда через неделю. Рядом с файлом журнал никуда не денется и
|
||
не перепутается с чужим. }
|
||
procedure TMainForm.LogExport(const AText: string);
|
||
var
|
||
F: TextFile;
|
||
begin
|
||
Log(AText);
|
||
if FExportLogPath = '' then
|
||
Exit;
|
||
try
|
||
AssignFile(F, FExportLogPath);
|
||
if FileExists(FExportLogPath) then
|
||
Append(F)
|
||
else
|
||
Rewrite(F);
|
||
try
|
||
WriteLn(F, AText);
|
||
finally
|
||
CloseFile(F);
|
||
end;
|
||
except
|
||
on E: Exception do
|
||
FExportLogPath := '';
|
||
end;
|
||
end;
|
||
|
||
{ Прерванная сборка: куски от неё лежат в кэше рядом с готовым файлом.
|
||
|
||
Спрашиваем, а не продолжаем молча: человек мог править монтаж между
|
||
попытками, и тогда «готовые» куски — от другой расстановки. Сама сборка
|
||
это проверит по отпечатку плана и при несовпадении соберёт заново, но
|
||
знать об этом человек должен заранее. }
|
||
{ Выбранный контейнер и что он за собой тянет.
|
||
|
||
У MP4 два недостатка, о которых человек узнаёт обычно поздно. Первый:
|
||
оглавление пишется в конец файла, и оборванная сборка не открывается
|
||
вовсе — продолжить её нельзя, только собрать заново. На четырёхчасовом
|
||
фильме это стоит часов работы. Второй: перекодированный стык точного
|
||
реза в нём воспроизводится не везде правильно.
|
||
|
||
Поэтому предлагается MKV — он лишён обоих, — а переупаковать его в MP4
|
||
можно потом, копированием потоков, без перекодирования. }
|
||
function TMainForm.AskContainer(AHasPrecise: Boolean): Boolean;
|
||
var
|
||
Text_, Ext: string;
|
||
begin
|
||
Result := True;
|
||
Ext := LowerCase(ExtractFileExt(FExportChoice.Path));
|
||
if Ext = '.mkv' then
|
||
Exit;
|
||
|
||
Ext := Copy(Ext, 2, 10);
|
||
Text_ := 'Прерванную сборку в ' + Ext + ' продолжить не удастся: ' +
|
||
'оглавление пишется в конец файла, и оборванный файл не открывается ' +
|
||
'вовсе. На длинном фильме это значит собирать всё заново.' + LineEnding;
|
||
if AHasPrecise then
|
||
Text_ := Text_ + 'К тому же в монтаже есть точные резы, а ' +
|
||
'перекодированный стык в этом контейнере воспроизводится ' +
|
||
'правильно не везде.' + LineEnding;
|
||
Text_ := Text_ + 'MKV этого лишён, а переупаковать его потом в ' + Ext +
|
||
' можно без перекодирования — «Перепаковка файлов...» в меню «Файл».';
|
||
|
||
case ThemedChoiceDlg('nlve', Text_,
|
||
['Собрать в MKV', 'Всё равно ' + Ext, 'Не собирать']) of
|
||
0:
|
||
begin
|
||
FExportChoice.Path := ChangeFileExt(FExportChoice.Path, '.mkv');
|
||
Log('Собираю в MKV: ' + FExportChoice.Path);
|
||
end;
|
||
1: ;
|
||
else
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function TMainForm.AskResume(const AOutputPath: string): Boolean;
|
||
var
|
||
DonePath: string;
|
||
Done: TStringList;
|
||
N: Integer;
|
||
begin
|
||
Result := False;
|
||
|
||
{ Сборка потоком не оставляет кусков: продолжать там можно с самого
|
||
недописанного файла. Что он недописан, видно по отметке рядом — сам
|
||
по себе оборванный MKV открывается и играет. }
|
||
N := UnfinishedFrames(AOutputPath);
|
||
if (N > 0) and FileExists(AOutputPath) and
|
||
(LowerCase(ExtractFileExt(AOutputPath)) = '.mkv') then
|
||
begin
|
||
Result := ThemedMessageDlg('nlve',
|
||
Format('Прошлая сборка этого файла оборвалась, в нём %d %s.',
|
||
[N, Plural(N, 'кадр', 'кадра', 'кадров')]) +
|
||
LineEnding + LineEnding +
|
||
'Да — продолжить с того места, где оборвалось.' + LineEnding +
|
||
'Нет — собрать заново с начала, файл будет заменён.' + LineEnding +
|
||
LineEnding +
|
||
'Если монтаж с тех пор менялся, продолжать нечего: собранная часть ' +
|
||
'сделана по прежнему монтажу.',
|
||
mtConfirmation, [mbYes, mbNo], 0) = mrYes;
|
||
if Result then
|
||
Exit;
|
||
end;
|
||
|
||
DonePath := CacheDirFor(AOutputPath) + 'готово.txt';
|
||
if not FileExists(DonePath) then
|
||
Exit;
|
||
|
||
Done := TStringList.Create;
|
||
try
|
||
try
|
||
Done.LoadFromFile(DonePath);
|
||
except
|
||
Exit;
|
||
end;
|
||
{ Первая строка — отпечаток плана, куски идут дальше. }
|
||
N := Done.Count - 1;
|
||
if N <= 0 then
|
||
Exit;
|
||
|
||
Result := ThemedMessageDlg('nlve',
|
||
Format('От прошлой сборки осталось готовых кусков: %d.' + LineEnding +
|
||
LineEnding +
|
||
'Продолжить с них? Если монтаж с тех пор менялся, куски не ' +
|
||
'подойдут — программа это заметит и соберёт заново.',
|
||
[N]),
|
||
mtConfirmation, [mbYes, mbNo], 0) = mrYes;
|
||
finally
|
||
Done.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TMainForm.ShowExportReport(const AReport: TExportReport);
|
||
var
|
||
I, Encoded, Mismatched, WorstPart: Integer;
|
||
Shift, FrameSeconds: Double;
|
||
WantSum, Diff, WorstDiff: Int64;
|
||
begin
|
||
FrameSeconds := 0;
|
||
if (FProject.Master.FpsNum > 0) and (FProject.Master.FpsDen > 0) then
|
||
FrameSeconds := FProject.Master.FpsDen / FProject.Master.FpsNum;
|
||
|
||
if AReport.Cancelled then
|
||
begin
|
||
LogExport('Сборка отменена.');
|
||
Exit;
|
||
end;
|
||
|
||
if not AReport.Succeeded then
|
||
begin
|
||
LogExport('Сборка не удалась: ' + AReport.Message);
|
||
Exit;
|
||
end;
|
||
|
||
LogExport('--- Отчёт о сборке ---');
|
||
Encoded := 0;
|
||
for I := 0 to High(AReport.Segments) do
|
||
begin
|
||
Shift := AReport.Segments[I].ActualStart - AReport.Segments[I].RequestedStart;
|
||
if AReport.Segments[I].Encoded then
|
||
begin
|
||
Inc(Encoded);
|
||
LogExport(Format(' часть %d (кусок %d, ПЕРЕКОДИРОВАНА): старт %s, длина %s, пакетов %d',
|
||
[I + 1, AReport.Segments[I].Index + 1,
|
||
SecondsToStr(AReport.Segments[I].ActualStart),
|
||
SecondsToStr(AReport.Segments[I].Duration),
|
||
AReport.Segments[I].Packets]));
|
||
end
|
||
else
|
||
LogExport(Format(' часть %d (кусок %d): старт %s (просили %s, сдвиг %s), длина %s, пакетов %d',
|
||
[I + 1, AReport.Segments[I].Index + 1,
|
||
SecondsToStr(AReport.Segments[I].ActualStart),
|
||
SecondsToStr(AReport.Segments[I].RequestedStart),
|
||
SecondsToStr(Shift),
|
||
SecondsToStr(AReport.Segments[I].Duration),
|
||
AReport.Segments[I].Packets]));
|
||
end;
|
||
if Encoded > 0 then
|
||
LogExport(Format(' перекодировано частей: %d, остальное скопировано без потерь',
|
||
[Encoded]));
|
||
|
||
LogExport(Format(' сумма пакетов кусков: %d', [AReport.ExpectedPackets]));
|
||
LogExport(Format(' пакетов в готовом файле: %d', [AReport.ActualPackets]));
|
||
if AReport.ExpectedPackets = AReport.ActualPackets then
|
||
LogExport(' СВЕРКА ПРОЙДЕНА: склейка не потеряла и не продублировала ни одного кадра.')
|
||
else
|
||
LogExport(Format(' РАСХОЖДЕНИЕ на %d кадров.',
|
||
[AReport.ActualPackets - AReport.ExpectedPackets]));
|
||
|
||
{ Сверка с монтажом: одно дело — склейка ничего не потеряла, другое —
|
||
получилось ли столько кадров, сколько просил монтаж. Звук набирается
|
||
по монтажу с точностью до отсчёта, поэтому лишний или недостающий
|
||
кадр картинки — это и есть расхождение звука с картинкой, и о нём
|
||
надо говорить числом, а не ждать, пока заметит глаз. }
|
||
WantSum := 0;
|
||
Mismatched := 0;
|
||
WorstPart := -1;
|
||
WorstDiff := 0;
|
||
for I := 0 to High(AReport.Segments) do
|
||
begin
|
||
if AReport.Segments[I].WantFrames <= 0 then
|
||
Continue;
|
||
Inc(WantSum, AReport.Segments[I].WantFrames);
|
||
if AReport.Segments[I].Packets < 0 then
|
||
Continue;
|
||
Diff := AReport.Segments[I].Packets - AReport.Segments[I].WantFrames;
|
||
if Diff <> 0 then
|
||
begin
|
||
Inc(Mismatched);
|
||
if Abs(Diff) > Abs(WorstDiff) then
|
||
begin
|
||
WorstDiff := Diff;
|
||
WorstPart := I;
|
||
end;
|
||
LogExport(Format(' часть %d: кадров %d, а монтаж просил %d (разница %d)',
|
||
[I + 1, AReport.Segments[I].Packets,
|
||
AReport.Segments[I].WantFrames, Diff]));
|
||
end;
|
||
end;
|
||
|
||
if WantSum > 0 then
|
||
begin
|
||
LogExport(Format(' картинка: %d кадров, монтаж просил %d',
|
||
[AReport.ActualPackets, WantSum]));
|
||
Diff := AReport.ActualPackets - WantSum;
|
||
if Diff = 0 then
|
||
LogExport(' ЗВУК И КАРТИНКА СХОДЯТСЯ: кадров ровно столько, сколько в монтаже.')
|
||
else if WorstPart >= 0 then
|
||
LogExport(Format(' ЗВУК И КАРТИНКА РАСХОДЯТСЯ на %d %s (%s с), хуже всего часть %d.',
|
||
[Abs(Diff), Plural(Abs(Diff), 'кадр', 'кадра', 'кадров'),
|
||
SecondsToStr(Abs(Diff) * FrameSeconds), WorstPart + 1]))
|
||
else
|
||
LogExport(Format(' ЗВУК И КАРТИНКА РАСХОДЯТСЯ на %d %s (%s с).',
|
||
[Abs(Diff), Plural(Abs(Diff), 'кадр', 'кадра', 'кадров'),
|
||
SecondsToStr(Abs(Diff) * FrameSeconds)]));
|
||
if Mismatched > 0 then
|
||
LogExport(Format(' частей с неверной длиной: %d', [Mismatched]));
|
||
end;
|
||
|
||
LogExport(' файл: ' + AReport.OutputPath);
|
||
SetStatus('Готово: ' + AReport.OutputPath);
|
||
end;
|
||
|
||
end.
|