4aiman/nlve
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Выделение областью, рез всех дорожек, курсор не улетает

Browse source 
Рамка выделения: протяжка по пустому месту дорожек обтягивает клипы,
Delete убирает всё, что она задела. Щелчок без движения по-прежнему
ставит курсор.

Рез по курсору (S) режет все дорожки, а не ту, что под указателем мыши:
стоило указателю оказаться над пустой дорожкой, и клавиша молча не
делала ничего. Теперь рез отвечает числом разрезанных клипов.

Курсор после правки монтажа улетал в конец: при перезагрузке списка
кусков mpv сбрасывает отсчёт времени, программа ждала перемотки, не
дожидалась и подтягивала курсор к плееру. На паузе курсор теперь
остаётся там, куда его поставил человек. Это и делало Ctrl+Shift+R
неудобным: после каждого схлопывания приходилось целиться заново.

Схлопывание дыры ищет её с допуском и по всем дорожкам, а не только под
мышью, и называет дорожку в строке состояния.

Ответ на команду держится в строке состояния несколько секунд: раньше
его через долю секунды затирало сообщение о пересборке предпросмотра.

Проверки: рамка, рез всех дорожек, допуск при схлопывании (lfmcheck).
This commit is contained in:
4aiman 2026-09-14 15:27:43 +03:00
commit 86c28a3308
4 changed files with 537 additions and 98 deletions
Download patch file Download diff file Expand all files Collapse all files

3
README.md
View file

@ -76,10 +76,11 @@ xdg-mime query default application/x-nlve-project
|---|---|
| Пуск и пауза | Пробел |
| В начало / конец монтажа | Home / End |
| Разрезать по курсору | S |
| Разрезать по курсору (все дорожки) | S |
| Разрезать точно (перекодирует стык) | Shift+S |
| Удалить выделенное | Delete |
| Выделить всё | Ctrl+A |
| Выделить областью | протяжка по пустому месту дорожек |
| Схлопнуть дыру под курсором | Ctrl+Shift+R |
| Отменить, повторить | Ctrl+Z, Ctrl+Y |
| Масштаб таймлайна | Ctrl + колесо мыши |

118
src/uMainForm.pas
View file

@ -215,6 +215,8 @@ type
плеер туда никогда не доедет, и курсор переставал двигаться
совсем. }
FSeekWaitTicks: Integer;
{ До какого времени ответ на команду держится в строке состояния. }
FStatusHoldUntil: TDateTime;
procedure ApplyVolumeAt(const ATime: Double);
{ Переписывает файл субтитров и отдаёт его плееру. }
@ -290,7 +292,9 @@ type
procedure RemindAboutDeps;
procedure Log(const AText: string);
procedure LogToFile(const AText: string);
procedure SetStatus(const AText: string);
{ AAnswer — это ответ на команду человека, а не проходное сообщение:
такой ответ держится в строке несколько секунд. }
procedure SetStatus(const AText: string; AAnswer: Boolean = False);
procedure UpdateCaption;
procedure UpdateTimeLabel;
procedure RefreshPool;
@ -407,6 +411,10 @@ const
Сообщения приходят на каждый кадр, так что это доли секунды. }
MaxSeekWaitTicks = 90;
{ Сколько ответ на команду держится в строке состояния, не давая себя
затереть проходным сообщением. Четыре секунды — успеть прочесть. }
StatusHoldTime = 4 / (24 * 60 * 60);
function FormatTimecode(const Seconds: Double): string;
var
Total, H, M, S, Ms: Integer;
@ -1366,8 +1374,23 @@ begin
LogToFile(AText);
end;
procedure TMainForm.SetStatus(const AText: string);
{ Строка состояния — единственное место, где программа отвечает на
команду. Ответ команды нельзя затирать проходным сообщением: пересборка
предпросмотра случается после каждой правки и приходит через долю
секунды после нажатия, так что «Разрезано 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;
lblStatus.Caption := AText;
end;
@ -2390,7 +2413,7 @@ begin
SchedulePreview;
UpdateCaption;
Log(Format('Перенесено на подходящие дорожки: %d.', [N]));
SetStatus(Format('Перенесено клипов: %d.', [N]));
SetStatus(Format('Перенесено клипов: %d.', [N]), True);
end;
procedure TMainForm.UpdateRippleButton;
@ -2489,10 +2512,10 @@ begin
if FSettings.CenterPlayhead then
begin
FTimeline.ScrollToPlayhead(True);
SetStatus('Курсор держится посередине монтажа.');
SetStatus('Курсор держится посередине монтажа.', True);
end
else
SetStatus('Монтаж стоит на месте, курсор идёт по нему.');
SetStatus('Монтаж стоит на месте, курсор идёт по нему.', True);
end;
procedure TMainForm.btnCenterClick(Sender: TObject);
@ -2505,9 +2528,9 @@ begin
FProject.RippleEnabled := not FProject.RippleEnabled;
UpdateRippleButton;
if FProject.RippleEnabled then
SetStatus('Автосхлопывание включено: клипы правее едут вместе с перетаскиваемым.')
SetStatus('Автосхлопывание включено: клипы правее едут вместе с перетаскиваемым.', True)
else
SetStatus('Автосхлопывание выключено: клипы правее остаются на месте.');
SetStatus('Автосхлопывание выключено: клипы правее остаются на месте.', True);
end;
procedure TMainForm.btnRippleClick(Sender: TObject);
@ -2554,9 +2577,9 @@ begin
UpdateCaption;
if FProject.HasRegion then
SetStatus(Format('Участок: %s — %s',
[SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)]))
[SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)]), True)
else
SetStatus('Отметки участка сняты: собирается весь монтаж.');
SetStatus('Отметки участка сняты: собирается весь монтаж.', True);
end;
procedure TMainForm.BuildTrackMenu;
@ -2608,7 +2631,7 @@ begin
FProject.BeginChange;
FProject.MoveTrack(FTrackMenuIndex, FTrackMenuIndex - 1);
TimelineStructureChange(nil);
SetStatus('Дорожка поднята.');
SetStatus('Дорожка поднята.', True);
end;
procedure TMainForm.TrackMenuDown(Sender: TObject);
@ -2618,7 +2641,7 @@ begin
FProject.BeginChange;
FProject.MoveTrack(FTrackMenuIndex, FTrackMenuIndex + 1);
TimelineStructureChange(nil);
SetStatus('Дорожка опущена.');
SetStatus('Дорожка опущена.', True);
end;
{ Удаление дорожки. С клипами — только с подтверждением: вместе с
@ -2643,7 +2666,7 @@ begin
FProject.EnsureUniqueTrackNames;
FTimeline.Invalidate;
UpdateCaption;
SetStatus('Дорожка названа: ' + FProject.Tracks[ATrackIndex].Name);
SetStatus('Дорожка названа: ' + FProject.Tracks[ATrackIndex].Name, True);
end;
procedure TMainForm.TrackMenuRename(Sender: TObject);
@ -2673,7 +2696,7 @@ begin
FProject.BeginChange;
FProject.RemoveTrack(FTrackMenuIndex);
TimelineStructureChange(nil);
SetStatus('Дорожка ' + TrackName + ' удалена.');
SetStatus('Дорожка ' + TrackName + ' удалена.', True);
end;
{ --- Меню библиотеки --- }
@ -2818,7 +2841,7 @@ begin
SchedulePreview;
UpdateCaption;
SetStatus(Format('Убрано %d %s',
[Removed, Plural(Removed, 'клип', 'клипа', 'клипов')]));
[Removed, Plural(Removed, 'клип', 'клипа', 'клипов')]), True);
end;
{ Кадрирование отдельного клипа. Вызывается кнопкой в углу клипа.
@ -2917,7 +2940,7 @@ begin
end;
UpdateCaption;
SchedulePreview;
SetStatus('Кадрирование обновлено: ' + FitModeCaption(T.Fit));
SetStatus('Кадрирование обновлено: ' + FitModeCaption(T.Fit), True);
end;
procedure TMainForm.MenuProjectInfo(Sender: TObject);
@ -3169,7 +3192,7 @@ end;
procedure TMainForm.TimelineSelectionChange(Sender: TObject);
begin
SetStatus(Format('Выделено %d %s', [FProject.SelectedCount,
Plural(FProject.SelectedCount, 'клип', 'клипа', 'клипов')]));
Plural(FProject.SelectedCount, 'клип', 'клипа', 'клипов')]), True);
end;
procedure TMainForm.PlayerLog(Sender: TObject; const APrefix, ALevel, AText: string);
@ -3189,6 +3212,15 @@ begin
(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 сообщает позицию на
@ -3441,7 +3473,7 @@ begin
FTimeline.Invalidate;
SchedulePreview;
UpdateCaption;
SetStatus('Отменено.');
SetStatus('Отменено.', True);
end;
procedure TMainForm.MenuRedo(Sender: TObject);
@ -3456,18 +3488,36 @@ begin
FTimeline.Invalidate;
SchedulePreview;
UpdateCaption;
SetStatus('Повторено.');
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
FTimeline.SplitAtPlayhead(False, True);
SetStatus(SplitReport(FTimeline.SplitAtPlayhead(False)), True);
end;
procedure TMainForm.MenuSplitPrecise(Sender: TObject);
var
Count: Integer;
begin
FTimeline.SplitAtPlayhead(True, True);
SetStatus('Точный рез: стык будет перекодирован при сборке.');
Count := FTimeline.SplitAtPlayhead(True);
if Count > 0 then
SetStatus(SplitReport(Count) +
' Точный рез: стык будет перекодирован при сборке.', True)
else
SetStatus(SplitReport(Count), True);
end;
procedure TMainForm.MenuDelete(Sender: TObject);
@ -3527,9 +3577,9 @@ begin
SchedulePreview;
UpdateCaption;
if Key.Enabled then
SetStatus('Цветовой ключ включён: участок будет пересобран.')
SetStatus('Цветовой ключ включён: участок будет пересобран.', True)
else
SetStatus('Цветовой ключ выключен.');
SetStatus('Цветовой ключ выключен.', True);
end;
{ Отметки участка.
@ -3622,7 +3672,7 @@ begin
end;
SetStatus(Format('Скопировано %d %s. Вставить: Ctrl+V.',
[Taken.Count, Plural(Taken.Count, 'клип', 'клипа', 'клипов')]));
[Taken.Count, Plural(Taken.Count, 'клип', 'клипа', 'клипов')]), True);
finally
Taken.Free;
end;
@ -3725,7 +3775,7 @@ begin
UpdateCaption;
SetStatus(Format('Вставлено %d %s.',
[FClipboard.Count,
Plural(FClipboard.Count, 'клип', 'клипа', 'клипов')]));
Plural(FClipboard.Count, 'клип', 'клипа', 'клипов')]), True);
end;
{ Первый выделенный клип: с него берут свойства. }
@ -3760,7 +3810,7 @@ begin
FLookClip := TClip.Create;
FLookClip.Kind := Src.Kind;
FLookClip.CopyLookFrom(Src);
SetStatus('Свойства клипа скопированы. Применить: Ctrl+Shift+V.');
SetStatus('Свойства клипа скопированы. Применить: Ctrl+Shift+V.', True);
end;
procedure TMainForm.MenuPasteLook(Sender: TObject);
@ -3795,7 +3845,7 @@ begin
SchedulePreview;
UpdateCaption;
SetStatus(Format('Свойства применены к %d %s.',
[N, Plural(N, 'клипу', 'клипам', 'клипам')]));
[N, Plural(N, 'клипу', 'клипам', 'клипам')]), True);
end;
procedure TMainForm.MenuRegionIn(Sender: TObject);
@ -3806,7 +3856,7 @@ begin
FTimeline.Invalidate;
UpdateCaption;
SetStatus(Format('Участок: %s — %s',
[SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)]));
[SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)]), True);
end;
procedure TMainForm.MenuRegionOut(Sender: TObject);
@ -3823,7 +3873,7 @@ begin
FTimeline.Invalidate;
UpdateCaption;
SetStatus(Format('Участок: %s — %s',
[SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)]));
[SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)]), True);
end;
procedure TMainForm.MenuRegionClear(Sender: TObject);
@ -3832,7 +3882,7 @@ begin
FProject.RegionEnd := 0;
FTimeline.Invalidate;
UpdateCaption;
SetStatus('Отметки участка сняты: собирается весь монтаж.');
SetStatus('Отметки участка сняты: собирается весь монтаж.', True);
end;
{ Границы того, что собираем. Без отметок — весь монтаж. }
@ -3857,11 +3907,13 @@ end;
procedure TMainForm.MenuRipple(Sender: TObject);
begin
{ Команда должна отвечать всегда: молчание читается как «не работает». }
{ Команда должна отвечать всегда: молчание читается как «не работает».
Дорожку называем: дыра могла найтись не на той, где стоял указатель,
и сдвиг чужой дорожки должен быть виден. }
if FTimeline.RippleCloseGap then
SetStatus('Дыра схлопнута.')
SetStatus('Дыра на дорожке ' + FTimeline.LastGapTrack + ' схлопнута.', True)
else
SetStatus('Под курсором дыры нет: схлопывать нечего.');
SetStatus('Под курсором дыры нет: схлопывать нечего.', True);
end;
{ К началу самого раннего клипа по всем дорожкам. Если монтаж начинается

319
src/uTimelineCtrl.pas
View file

@ -41,7 +41,8 @@ type
taFadeOut, // тянем уход за верхний правый угол
taRegionIn, // тянем начало отмеченного участка
taRegionOut, // тянем конец отмеченного участка
taDragTrack // тянем дорожку за заголовок, меняя порядок
taDragTrack, // тянем дорожку за заголовок, меняя порядок
taRubberBand // обтягиваем рамкой клипы по пустому месту
);
{ Что находится под указателем в полосе заголовков дорожек. }
@ -126,6 +127,18 @@ type
клипы, которые уже сдвинулись. }
FRippleClips: array of TClip;
FRippleOrigStarts: array of Double;
{ Имя дорожки, где схлопнули дыру в последний раз. }
FLastGapTrack: string;
{ Рамка выделения: угол, где нажали, и угол, где мышь сейчас.
По горизонтали храним время, а не точку экрана: рамку можно тянуть
за край окна, монтаж при этом прокручивается, и запомненная точка
экрана означала бы уже другое место. По вертикали храним отступ от
начала дорожек, а не от верха окна, — по той же причине. }
FBandFromTime: Double;
FBandToTime: Double;
FBandFromY: Integer;
FBandToY: Integer;
FGroupClips: array of TClip;
FGroupOrigStarts: array of Double;
@ -185,6 +198,7 @@ type
procedure DrawOverlaps(ACanvas: TCanvas; ATrack: TTrack; ATop: Integer);
{ Полоса поверх участка, который прямо сейчас пересобирается. }
procedure DrawBusyRange(ACanvas: TCanvas);
procedure DrawRubberBand(ACanvas: TCanvas);
{ Сдвиг всего, что правее дыры, влево до первого касания. }
procedure RippleAfterDelete(const AHoleEnd: Double;
const ATracks: TStringList);
@ -224,6 +238,19 @@ type
const AFromTime: Double);
procedure ApplyRipple(const ADelta: Double);
function IsRippling(AClip: TClip): Boolean;
{ Ближайшая к ATime дыра на дорожке: конец предыдущего клипа и начало
следующего. Дыра считается найденной, если ATime отстоит от неё не
дальше чем на ATolerance; внутри дыры расстояние нулевое.
Допуск нужен потому, что курсор прилипает к краям клипов по всем
дорожкам сразу, а края картинки и её звука совпадают не всегда:
курсор, поставленный в дыру, может оказаться на десяток миллисекунд
левее её начала. Требовать точного попадания — значит заставлять
человека целиться. }
function NearestGapOnTrack(ATrackIndex: Integer;
const ATime, ATolerance: Double; out AFrom, ATo: Double): Boolean;
{ Допуск прилипания в секундах: те же экранные точки, что у краёв. }
function SnapTolerance: Double;
protected
procedure Paint; override;
procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
@ -262,13 +289,20 @@ type
function TrackIndexAtPoint(const AY: Integer): Integer;
function TimeAtPoint(const AX: Integer): Double;
{ Разрезать клипы под курсором воспроизведения.
{ Разрезать клипы под курсором воспроизведения — на всех дорожках
сразу. Возвращает, сколько клипов разрезано: ноль тоже ответ, и
окно должен о нём сказать, иначе клавиша выглядит сломанной.
Раньше резалась только дорожка под указателем мыши, и стоило
указателю оказаться над пустым местом, как рез молча не делал
ничего. Дорожка под мышью и дорожка, с которой работают, — разные
вещи, и связывать их не следует.
APrecise помечает новые края как требующие точного реза: при сборке
огрызок до опорного кадра будет перекодирован. Без этого рез
притянется к опорному кадру, и точка съедет на величину до
расстояния между опорными кадрами. }
procedure SplitAtPlayhead(APrecise: Boolean; AOnlyCurrentTrack: Boolean);
function SplitAtPlayhead(APrecise: Boolean): Integer;
procedure DeleteSelected;
{ Связать выделенные клипы или развязать, если они уже связаны.
@ -286,6 +320,17 @@ type
окно скажет об этом, чтобы команда не выглядела сломанной. }
function RippleCloseGap: Boolean;
procedure SelectAll;
{ Выделить клипы, попавшие в область: дорожки с ATrackFrom по ATrackTo,
время с AFrom по ATo.
Попавшим считается клип, который областью задет, а не целиком в ней
лежит: обтянуть длинный клип целиком на общем плане невозможно, а
убрать его хотят так же, как короткий.
AAdd — добавить к уже выделенному (Ctrl), иначе прежнее выделение
заменяется. Открыто наружу ещё и затем, чтобы проверять числами. }
procedure SelectInRange(const AFrom, ATo: Double;
ATrackFrom, ATrackTo: Integer; AAdd: Boolean);
{ Номер дорожки под указателем мыши, минус один если ни одной. }
property HoverTrack: Integer read FHoverTrack;
@ -296,6 +341,10 @@ type
{ Куда встанет курсор, если поставить его в это время. Открыто, чтобы
расчёт можно было проверить числами, не гоняя мышь по окну. }
function SnapPlayhead(const ATime: Double): Double;
{ Имя дорожки, на которой схлопнули дыру в последний раз. Нужно окну
для строки состояния: дыра могла найтись не на той дорожке, где
стоял указатель, и молча двигать чужую дорожку нельзя. }
property LastGapTrack: string read FLastGapTrack;
{ Округление к кадровой сетке проекта: между кадрами времени нет. }
function QuantizeTime(const ATime: Double): Double;
@ -411,6 +460,7 @@ const
ColorFadeFill = TColor($505050); // серый: срезанный угол клипа
ColorOverlap = TColor($30C0FF); // оранжевый: полоса перехода
ColorBusy = TColor($30C0FF); // оранжевый: участок в работе
ColorBand = TColor($E0E0E0); // белый: рамка выделения
ColorHeaderActive = TColor($3A3A3A); // подсветка выбранной дорожки
ColorButtonOff = TColor($3A3A3A);
ColorMuteOn = TColor($4040D0); // красный: дорожка выключена
@ -705,6 +755,9 @@ begin
{ Отметка занятого участка идёт после клипов и до линейки: она должна
лежать поверх клипов, но не наползать на подписи времени. }
DrawBusyRange(FBuffer.Canvas);
{ Рамка выделения — поверх клипов, но под линейкой и заголовками: она
про клипы, и наползать на подписи времени ей незачем. }
DrawRubberBand(FBuffer.Canvas);
DrawRuler(FBuffer.Canvas);
DrawHeaders(FBuffer.Canvas);
DrawPlayhead(FBuffer.Canvas);
@ -1323,6 +1376,34 @@ begin
Invalidate;
end;
{ Рамка выделения. Пунктиром и без заливки: клипы внутри и так
подсвечиваются выделением, а заливка поверх них мешала бы это увидеть. }
procedure TTimelineControl.DrawRubberBand(ACanvas: TCanvas);
var
L, R, T, B: Integer;
begin
if (FAction <> taRubberBand) or (not FMovedWhileDown) then
Exit;
L := Min(TimeToX(FBandFromTime), TimeToX(FBandToTime));
R := Max(TimeToX(FBandFromTime), TimeToX(FBandToTime));
T := Min(FBandFromY, FBandToY) - FScrollY;
B := Max(FBandFromY, FBandToY) - FScrollY;
L := Max(L, FHeaderWidth);
R := Min(R, ClientWidth);
T := Max(T, FRulerHeight);
B := Min(B, ClientHeight);
if (R <= L) or (B <= T) then
Exit;
ACanvas.Pen.Color := ColorBand;
ACanvas.Pen.Style := psDot;
ACanvas.Brush.Style := bsClear;
ACanvas.Rectangle(L, T, R, B);
ACanvas.Pen.Style := psSolid;
end;
{ Участок, который сейчас пересобирается.
Помечается косой штриховкой во всю высоту дорожек: сплошная заливка
@ -1820,6 +1901,54 @@ begin
Result := Best;
end;
function TTimelineControl.SnapTolerance: Double;
begin
if FPixelsPerSecond > 0 then
Result := SnapPixels / FPixelsPerSecond
else
Result := 0;
end;
function TTimelineControl.NearestGapOnTrack(ATrackIndex: Integer;
const ATime, ATolerance: Double; out AFrom, ATo: Double): Boolean;
var
Track: TTrack;
I: Integer;
PrevEnd, Dist, BestDist: Double;
begin
Result := False;
AFrom := 0;
ATo := 0;
if (FProject = nil) or (ATrackIndex < 0) or
(ATrackIndex >= FProject.TrackCount) then
Exit;
Track := FProject.Tracks[ATrackIndex];
BestDist := ATolerance;
PrevEnd := 0;
for I := 0 to Track.Count - 1 do
begin
if Track[I].TlStart > PrevEnd + 0.0005 then
begin
{ Расстояние до отрезка дыры: внутри неё — ноль. }
if ATime < PrevEnd then
Dist := PrevEnd - ATime
else if ATime > Track[I].TlStart then
Dist := ATime - Track[I].TlStart
else
Dist := 0;
if Dist <= BestDist then
begin
BestDist := Dist;
AFrom := PrevEnd;
ATo := Track[I].TlStart;
Result := True;
end;
end;
PrevEnd := Max(PrevEnd, Track[I].TlEnd);
end;
end;
{ --- Мышь --- }
procedure TTimelineControl.MouseDown(Button: TMouseButton; Shift: TShiftState;
@ -1956,16 +2085,21 @@ begin
if Clip = nil then
begin
{ По пустому месту дорожки — тоже ставим курсор: так удобнее, чем
тянуться к линейке. }
if not (ssCtrl in Shift) then
begin
FProject.ClearSelection;
if Assigned(FOnSelectionChange) then
FOnSelectionChange(Self);
end;
FAction := taScrub;
Playhead := Max(0, SnapPlayhead(XToTime(X)));
{ По пустому месту дорожек — рамка выделения. Что с ней делать,
решается при отпускании: не сдвинули мышь — это щелчок, и он, как и
раньше, ставит курсор (тянуться к линейке каждый раз неудобно).
Сдвинули — выделяем всё, что рамка задела.
Выделение пока не трогаем: снимать его на нажатии значило бы терять
его от случайного щелчка мимо клипа. }
FAction := taRubberBand;
FPressX := X;
FPressY := Y;
FMovedWhileDown := False;
FBandFromTime := XToTime(X);
FBandToTime := FBandFromTime;
FBandFromY := Y + FScrollY;
FBandToY := FBandFromY;
Exit;
end;
@ -2129,6 +2263,28 @@ begin
на стык, соскакивал бы с него от малейшего движения мыши. }
Playhead := Max(0, SnapPlayhead(XToTime(X)));
taRubberBand:
begin
if (Abs(X - FPressX) > ClickSlopPixels) or
(Abs(Y - FPressY) > ClickSlopPixels) then
FMovedWhileDown := True;
{ Тянут за край окна — прокручиваем следом: иначе рамкой нельзя
захватить больше, чем помещается на экране. Прокрутка идёт на
каждое движение мыши, само по себе время не течёт: пока мышь
стоит, ничего не происходит. }
if FPixelsPerSecond > 0 then
begin
if X < FHeaderWidth then
FScrollOffset := FScrollOffset - (FHeaderWidth - X) / FPixelsPerSecond
else if X > ClientWidth then
FScrollOffset := FScrollOffset + (X - ClientWidth) / FPixelsPerSecond;
ClampScroll;
end;
FBandToTime := XToTime(Max(FHeaderWidth, Min(ClientWidth, X)));
FBandToY := Max(FRulerHeight, Y) + FScrollY;
Invalidate;
end;
taDragTrack:
if (FProject <> nil) and (FDragTrackIndex >= 0) then
begin
@ -2456,6 +2612,31 @@ begin
Exit;
end;
{ Рамка выделения. Щелчок без движения — это не рамка, а щелчок по
пустому месту: снимаем выделение и ставим курсор, как было всегда. }
if FAction = taRubberBand then
begin
FAction := taNone;
if FMovedWhileDown then
SelectInRange(FBandFromTime, FBandToTime,
(FBandFromY - FRulerHeight) div FTrackHeight,
(FBandToY - FRulerHeight) div FTrackHeight,
ssCtrl in Shift)
else
begin
if (FProject <> nil) and not (ssCtrl in Shift) then
begin
FProject.ClearSelection;
if Assigned(FOnSelectionChange) then
FOnSelectionChange(Self);
end;
Playhead := Max(0, SnapPlayhead(XToTime(X)));
end;
FMovedWhileDown := False;
Invalidate;
Exit;
end;
WasEditing := FAction in [taDragClip, taTrimIn, taTrimOut, taVolume,
taFadeIn, taFadeOut];
WasTrimIn := FAction = taTrimIn;
@ -2539,39 +2720,28 @@ end;
{ --- Правки --- }
procedure TTimelineControl.SplitAtPlayhead(APrecise: Boolean;
AOnlyCurrentTrack: Boolean);
function TTimelineControl.SplitAtPlayhead(APrecise: Boolean): Integer;
var
T: Integer;
Track: TTrack;
Clip, Tail: TClip;
AnyChange: Boolean;
Offset: Double;
HoverGroup: string;
{ Старый номер связки — новый. Одна связка при резе становится двумя:
голова со своей парой и хвост со своей. }
NewGroups: TStringList;
Idx: Integer;
begin
Result := 0;
if FProject = nil then
Exit;
AnyChange := False;
FProject.BeginChange;
NewGroups := TStringList.Create;
try
{ Связка режется целиком. Резать только картинку, оставив звук цельным,
значит развалить пару: дальше они поедут порознь. }
HoverGroup := '';
if AOnlyCurrentTrack and (FHoverTrack >= 0) and
(FHoverTrack < FProject.TrackCount) then
begin
Clip := FProject.Tracks[FHoverTrack].ClipAt(FPlayhead);
if Clip <> nil then
HoverGroup := Clip.GroupId;
end;
{ Режем все дорожки, где под курсором есть клип. Связка при этом
остаётся целой сама собой: картинка и её звук лежат под одним и тем
же временем, значит режутся оба. }
for T := 0 to FProject.TrackCount - 1 do
begin
Track := FProject.Tracks[T];
@ -2579,10 +2749,6 @@ begin
if Clip = nil then
Continue;
if AOnlyCurrentTrack and (FHoverTrack >= 0) and (T <> FHoverTrack) then
if (HoverGroup = '') or (Clip.GroupId <> HoverGroup) then
Continue;
Offset := FPlayhead - Clip.TlStart;
{ Рез вплотную к краю ничего не даёт, только плодит клипы нулевой длины. }
if (Offset < 0.001) or (Offset > Clip.Duration - 0.001) then
@ -2639,14 +2805,14 @@ begin
Clip.Duration := Offset;
Track.Add(Tail);
AnyChange := True;
Inc(Result);
end;
finally
NewGroups.Free;
end;
if AnyChange then
if Result > 0 then
StructureChanged
else
{ Ничего не разрезали — снимок отмены не нужен, откатываем его. }
@ -2857,33 +3023,11 @@ function TTimelineControl.RippleCloseGap: Boolean;
var
T, C, Source: Integer;
Track: TTrack;
GapStart, GapEnd, Shift: Double;
GapStart, GapEnd, Shift, Tolerance: Double;
AnyChange: Boolean;
{ Находит дыру под курсором на дорожке: конец предыдущего клипа и
начало следующего. }
function FindGap(ATrack: TTrack; out AFrom, ATo: Double): Boolean;
var
I: Integer;
PrevEnd: Double;
begin
Result := False;
PrevEnd := 0;
for I := 0 to ATrack.Count - 1 do
begin
if ATrack[I].TlStart > PrevEnd + 0.0005 then
if (FPlayhead >= PrevEnd) and (FPlayhead <= ATrack[I].TlStart) then
begin
AFrom := PrevEnd;
ATo := ATrack[I].TlStart;
Exit(True);
end;
PrevEnd := Max(PrevEnd, ATrack[I].TlEnd);
end;
end;
begin
Result := False;
FLastGapTrack := '';
if FProject = nil then
Exit;
@ -2895,14 +3039,31 @@ begin
клавиатуре, — берём выбранную дорожку. Раньше в этом случае команда
молча не делала ничего, и выглядело это как «горячая клавиша не
работает». }
Tolerance := Max(SnapTolerance, 0.001);
Source := FHoverTrack;
if (Source < 0) or (Source >= FProject.TrackCount) then
Source := FActiveTrack;
if (Source < 0) or (Source >= FProject.TrackCount) then
Exit;
if not FindGap(FProject.Tracks[Source], GapStart, GapEnd) then
Exit;
if (Source < 0) or (Source >= FProject.TrackCount) or
(not NearestGapOnTrack(Source, FPlayhead, Tolerance, GapStart, GapEnd)) then
begin
{ На своей дорожке дыры нет — ищем на остальных сверху вниз. Указатель
мыши может стоять где угодно, а дыра под курсором обычно одна на весь
монтаж. Какую дорожку схлопнули, окно потом скажет: молча двигать не
ту дорожку, на которую смотрели, нельзя. }
Source := -1;
for T := 0 to FProject.TrackCount - 1 do
if NearestGapOnTrack(T, FPlayhead, Tolerance, GapStart, GapEnd) then
begin
Source := T;
Break;
end;
if Source < 0 then
Exit;
end;
FLastGapTrack := FProject.Tracks[Source].Name;
Shift := GapEnd - GapStart;
if Shift <= 0 then
@ -2955,6 +3116,38 @@ begin
FOnSelectionChange(Self);
end;
procedure TTimelineControl.SelectInRange(const AFrom, ATo: Double;
ATrackFrom, ATrackTo: Integer; AAdd: Boolean);
var
T, C, T1, T2: Integer;
From_, To_: Double;
Clip: TClip;
begin
if FProject = nil then
Exit;
{ Рамку тянут в любую сторону — приводим её к возрастающему виду. }
From_ := Min(AFrom, ATo);
To_ := Max(AFrom, ATo);
T1 := Max(0, Min(ATrackFrom, ATrackTo));
T2 := Min(FProject.TrackCount - 1, Max(ATrackFrom, ATrackTo));
if not AAdd then
FProject.ClearSelection;
for T := T1 to T2 do
for C := 0 to FProject.Tracks[T].Count - 1 do
begin
Clip := FProject.Tracks[T][C];
if (Clip.TlEnd > From_) and (Clip.TlStart < To_) then
Clip.Selected := True;
end;
Invalidate;
if Assigned(FOnSelectionChange) then
FOnSelectionChange(Self);
end;
procedure TTimelineControl.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited KeyDown(Key, Shift);

195
tests/lfmcheck/lfmcheck.lpr
View file

@ -209,7 +209,7 @@ begin
Timeline.Project := Proj;
Timeline.PixelsPerSecond := 100;
Timeline.Playhead := 4;
Timeline.SplitAtPlayhead(False, False);
Timeline.SplitAtPlayhead(False);
CheckTrue('клипов стало два', Proj.Tracks[0].Count = 2);
if Proj.Tracks[0].Count <> 2 then
@ -374,6 +374,196 @@ begin
end;
end;
{ Общая заготовка: проект с одним файлом и заданной сеткой кадров. }
function TestInfo: TMediaInfo;
begin
Result := Default(TMediaInfo);
Result.Valid := True;
Result.Kind := mkVideo;
Result.Duration := 600;
Result.HasVideo := True;
Result.VideoCodec := 'hevc';
Result.Width := 1920;
Result.Height := 1080;
Result.FpsNum := 30;
Result.FpsDen := 1;
Result.PixFmt := 'yuv420p';
end;
{ Выделение областью.
Проверяется расчётом, а не мышью: сама протяжка проверена на невидимом
экране, а вот что попадает в рамку — числами, иначе первая же правка
захвата пройдёт незамеченной. }
procedure CheckRubberBand;
var
Proj: TProject;
Info: TMediaInfo;
Media: TMediaItem;
Timeline: TTimelineControl;
begin
WriteLn;
WriteLn('Выделение областью');
WriteLn;
Info := TestInfo;
Proj := TProject.Create;
Timeline := TTimelineControl.Create(nil);
try
Proj.Clear;
Proj.AddTrack('V1');
Proj.AddTrack('V2');
Proj.AddTrack('V3');
Media := Proj.AddMedia('/несуществующий/видео.mp4', Info);
Proj.Master := Info;
{ V1: клип 0..5 и клип 20..25. V2: длинный клип 0..30.
V3: клип 0..5 — дорожка вне рамки. }
Proj.AddClip(Proj.Tracks[0], Media, 0, 5, 0);
Proj.AddClip(Proj.Tracks[0], Media, 100, 5, 20);
Proj.AddClip(Proj.Tracks[1], Media, 0, 30, 0);
Proj.AddClip(Proj.Tracks[2], Media, 0, 5, 0);
Timeline.Project := Proj;
Timeline.PixelsPerSecond := 100;
{ Рамка по дорожкам 0 и 1, время 2..10. }
Timeline.SelectInRange(2, 10, 0, 1, False);
CheckTrue('задетый клип выделен', Proj.Tracks[0][0].Selected);
CheckTrue('клип за рамкой не выделен', not Proj.Tracks[0][1].Selected);
CheckTrue('длинный клип задет и выделен', Proj.Tracks[1][0].Selected);
CheckTrue('чужая дорожка не тронута', not Proj.Tracks[2][0].Selected);
{ Рамку тянут и справа налево — это та же рамка. }
Timeline.SelectInRange(25, 18, 0, 0, False);
CheckTrue('обратная протяжка выделила второй клип',
Proj.Tracks[0][1].Selected);
CheckTrue('прежнее выделение снято', not Proj.Tracks[0][0].Selected);
{ С Ctrl прежнее выделение остаётся. }
Timeline.SelectInRange(2, 4, 0, 0, True);
CheckTrue('добавление сохранило прежнее', Proj.Tracks[0][1].Selected);
CheckTrue('добавление выделило новое', Proj.Tracks[0][0].Selected);
{ Рамка, не задевшая ничего, просто снимает выделение. }
Timeline.SelectInRange(6, 8, 0, 0, False);
CheckTrue('пустая рамка ничего не выделила',
Proj.SelectedCount = 0);
finally
Timeline.Free;
Proj.Free;
end;
end;
{ Рез по курсору режет все дорожки.
Раньше резалась только дорожка под указателем мыши, и стоило указателю
оказаться над пустым местом, как клавиша S молча не делала ничего. }
procedure CheckSplitAllTracks;
var
Proj: TProject;
Info: TMediaInfo;
Media: TMediaItem;
Timeline: TTimelineControl;
begin
WriteLn;
WriteLn('Рез по курсору на всех дорожках');
WriteLn;
Info := TestInfo;
Proj := TProject.Create;
Timeline := TTimelineControl.Create(nil);
try
Proj.Clear;
Proj.AddTrack('V1');
Proj.AddTrack('V2');
Proj.AddTrack('A1');
Media := Proj.AddMedia('/несуществующий/видео.mp4', Info);
Proj.Master := Info;
{ Клипы 0..10 на первой и третьей дорожках, на второй — 20..30:
под курсором её нет, и резать там нечего. }
Proj.AddClip(Proj.Tracks[0], Media, 0, 10, 0);
Proj.AddClip(Proj.Tracks[1], Media, 0, 10, 20);
Proj.AddClip(Proj.Tracks[2], Media, 0, 10, 0);
Timeline.Project := Proj;
Timeline.PixelsPerSecond := 100;
Timeline.ActiveTrack := 1;
Timeline.Playhead := 4;
CheckTrue('разрезаны обе задетые дорожки',
Timeline.SplitAtPlayhead(False) = 2);
CheckTrue('на первой дорожке два клипа', Proj.Tracks[0].Count = 2);
CheckTrue('на звуковой дорожке два клипа', Proj.Tracks[2].Count = 2);
CheckTrue('нетронутая дорожка осталась с одним клипом',
Proj.Tracks[1].Count = 1);
{ Курсор ровно на стыке — резать нечего, и клипов нулевой длины
появиться не должно. }
CheckTrue('на стыке рез отвечает нулём',
Timeline.SplitAtPlayhead(False) = 0);
CheckTrue('лишних клипов не появилось',
(Proj.Tracks[0].Count = 2) and (Proj.Tracks[2].Count = 2));
finally
Timeline.Free;
Proj.Free;
end;
end;
{ Схлопывание дыры не требует попадать в тайминг.
Курсор может стоять не точно на краю дыры: во время воспроизведения он
останавливается там, где успел, а после перезагрузки предпросмотра —
где оказался плеер. Раньше дыра при этом не находилась. }
procedure CheckGapTolerance;
var
Proj: TProject;
Info: TMediaInfo;
Media: TMediaItem;
Timeline: TTimelineControl;
begin
WriteLn;
WriteLn('Схлопывание дыры с допуском');
WriteLn;
Info := TestInfo;
Proj := TProject.Create;
Timeline := TTimelineControl.Create(nil);
try
Proj.Clear;
Proj.AddTrack('V1');
Proj.AddTrack('A1');
Media := Proj.AddMedia('/несуществующий/видео.mp4', Info);
Proj.Master := Info;
{ Дыра на картинке с 5 по 12. У звука дыры нет вовсе. }
Proj.AddClip(Proj.Tracks[0], Media, 0, 5, 0);
Proj.AddClip(Proj.Tracks[0], Media, 20, 5, 12);
Proj.AddClip(Proj.Tracks[1], Media, 0, 17, 0);
Timeline.Project := Proj;
Timeline.PixelsPerSecond := 100;
{ Указатель и выбранная дорожка — звуковая, дыры на ней нет. }
Timeline.ActiveTrack := 1;
{ Курсор не в дыре, а на четыре сотых раньше её начала. }
Timeline.Playhead := 4.96;
CheckTrue('дыра найдена, хотя курсор чуть раньше края',
Timeline.RippleCloseGap);
CheckTrue('названа дорожка, где схлопнули',
Timeline.LastGapTrack = 'V1');
CheckTrue('клип придвинут вплотную',
Abs(Proj.Tracks[0][1].TlStart - 5) < 0.001);
{ Курсор далеко от дыры — ничего не двигаем. }
Proj.Tracks[0][1].TlStart := 12;
Timeline.Playhead := 2;
CheckTrue('далеко от дыры — не схлопываем',
not Timeline.RippleCloseGap);
finally
Timeline.Free;
Proj.Free;
end;
end;
begin
WriteLn('Свойства из файлов форм');
WriteLn;
@ -404,6 +594,9 @@ begin
CheckSplitKeepsSettings;
CheckRippleWithoutMouse;
CheckClipCopy;
CheckRubberBand;
CheckSplitAllTracks;
CheckGapTolerance;
WriteLn;
if Failed = 0 then