diff --git a/README.md b/README.md
index 012a2af..3a66955 100644
--- a/README.md
+++ b/README.md
@@ -125,11 +125,21 @@ xdg-mime query default application/x-nlve-project
если кнопку нажали и потянули, курсор остаётся на месте, в том числе во
время воспроизведения.
-**Прилипание.** Края клипов притягиваются друг к другу и к курсору.
-Кнопка внизу включает и выключает его, а Shift во время перетаскивания
-меняет решение на противоположное: при включённом прилипании временно
-отключает, при выключенном — временно включает. Так одна клавиша полезна
-в обоих режимах, и не нужно помнить, какой сейчас.
+**Прилипание клипов** (кнопка с магнитом). Края клипов притягиваются
+друг к другу и к курсору. Shift во время перетаскивания меняет решение на
+противоположное: при включённом прилипании временно отключает, при
+выключенном — временно включает. Так одна клавиша полезна в обоих
+режимах, и не нужно помнить, какой сейчас.
+
+**Прилипание курсора** (кнопка с клеем). Курсор, поставленный щелчком,
+притягивается к границам клипов на любой дорожке. Без этого в стык не
+попасть: на общем плане одна точка экрана — это секунды материала, а
+ставят курсор чаще всего именно на стык. Shift при щелчке работает так
+же — меняет решение на противоположное.
+
+Переключателя два, а не один, потому что это разные привычки: клипы
+липнут при перетаскивании, курсор — при щелчке, и одно бывает нужно без
+другого.
**Схлопывание.** Кнопка внизу показывает и режим, и состояние: утоплена —
автосхлопывание включено, и тогда при перетаскивании клипа всё, что
diff --git a/icons_online/attribution.txt b/icons_online/attribution.txt
index 633e7a9..0f3b577 100644
--- a/icons_online/attribution.txt
+++ b/icons_online/attribution.txt
@@ -1,4 +1,5 @@
Log panel: Property icon by Icons8
Ripple gaps: Merge Vertical icon by Icons8
Magnet: Magnet icon by Icons8
+Playhead snapping: Клей icon by Icons8
App icon: Showing Video Frames icon by Icons8
\ No newline at end of file
diff --git a/icons_online/icons8-клей-30.png b/icons_online/icons8-клей-30.png
new file mode 100644
index 0000000..0c9e053
Binary files /dev/null and b/icons_online/icons8-клей-30.png differ
diff --git a/src/uAboutForm.pas b/src/uAboutForm.pas
index 520282c..f2714c9 100644
--- a/src/uAboutForm.pas
+++ b/src/uAboutForm.pas
@@ -75,6 +75,8 @@ begin
' https://icons8.com/icon/2EQegp8tbR6Q/merge-vertical' + LineEnding +
'Журнал — Property' + LineEnding +
' https://icons8.com/icon/79872/property' + LineEnding +
+ 'Прилипание курсора — Клей' + LineEnding +
+ ' https://icons8.com/icon/111296/glue' + LineEnding +
'Значок программы — Showing Video Frames' + LineEnding +
' https://icons8.com/icon/69093/showing-video-frames' + LineEnding +
'Сам Icons8' + LineEnding +
diff --git a/src/uIconData.pas b/src/uIconData.pas
index 881bffe..3d096f3 100644
--- a/src/uIconData.pas
+++ b/src/uIconData.pas
@@ -32,8 +32,8 @@ const
$60, $00, $00, $3A, $98, $00, $00, $17, $70, $9C, $BA, $51, $3C, $00, $00, $00,
$02, $62, $4B, $47, $44, $00, $00, $AA, $8D, $23, $32, $00, $00, $00, $09, $70,
$48, $59, $73, $00, $00, $0B, $13, $00, $00, $0B, $13, $01, $00, $9A, $9C, $18,
- $00, $00, $00, $07, $74, $49, $4D, $45, $07, $EA, $08, $16, $07, $2D, $16, $EF,
- $B8, $28, $FD, $00, $00, $01, $3E, $49, $44, $41, $54, $38, $CB, $BD, $92, $31,
+ $00, $00, $00, $07, $74, $49, $4D, $45, $07, $EA, $08, $1E, $15, $14, $31, $9E,
+ $20, $4F, $DD, $00, $00, $01, $3E, $49, $44, $41, $54, $38, $CB, $BD, $92, $31,
$4B, $C3, $40, $14, $C7, $7F, $97, $44, $29, $68, $03, $5A, $45, $EA, $D0, $A5,
$6B, $41, $44, $5C, $0A, $0E, $3A, $15, $DC, $1D, $DD, $FB, $51, $74, $71, $29,
$F8, $39, $EC, $62, $06, $17, $5D, $EA, $22, $D2, $88, $93, $E0, $22, $68, $A1,
@@ -66,8 +66,8 @@ const
$60, $00, $00, $3A, $98, $00, $00, $17, $70, $9C, $BA, $51, $3C, $00, $00, $00,
$02, $62, $4B, $47, $44, $00, $00, $AA, $8D, $23, $32, $00, $00, $00, $09, $70,
$48, $59, $73, $00, $00, $0B, $13, $00, $00, $0B, $13, $01, $00, $9A, $9C, $18,
- $00, $00, $00, $07, $74, $49, $4D, $45, $07, $EA, $08, $16, $07, $2D, $16, $EF,
- $B8, $28, $FD, $00, $00, $01, $2F, $49, $44, $41, $54, $38, $CB, $CD, $D2, $3D,
+ $00, $00, $00, $07, $74, $49, $4D, $45, $07, $EA, $08, $1E, $15, $14, $31, $9E,
+ $20, $4F, $DD, $00, $00, $01, $2F, $49, $44, $41, $54, $38, $CB, $CD, $D2, $3D,
$2F, $83, $51, $18, $C6, $F1, $DF, $C3, $63, $31, $34, $11, $B5, $35, $D1, $A9,
$C1, $E0, $25, $4C, $66, $49, $F9, $16, $24, $96, $C6, $37, $A8, $18, $7D, $02,
$31, $98, $18, $99, $25, $44, $F8, $02, $26, $B1, $30, $30, $78, $D9, $90, $18,
@@ -99,8 +99,8 @@ const
$60, $00, $00, $3A, $98, $00, $00, $17, $70, $9C, $BA, $51, $3C, $00, $00, $00,
$02, $62, $4B, $47, $44, $00, $00, $AA, $8D, $23, $32, $00, $00, $00, $09, $70,
$48, $59, $73, $00, $00, $0B, $13, $00, $00, $0B, $13, $01, $00, $9A, $9C, $18,
- $00, $00, $00, $07, $74, $49, $4D, $45, $07, $EA, $08, $16, $07, $2D, $16, $EF,
- $B8, $28, $FD, $00, $00, $01, $0F, $49, $44, $41, $54, $38, $CB, $B5, $D3, $BF,
+ $00, $00, $00, $07, $74, $49, $4D, $45, $07, $EA, $08, $1E, $15, $14, $31, $9E,
+ $20, $4F, $DD, $00, $00, $01, $0F, $49, $44, $41, $54, $38, $CB, $B5, $D3, $BF,
$2E, $83, $51, $18, $C7, $F1, $CF, $5B, $15, $0C, $74, $93, $88, $91, $0B, $E8,
$68, $60, $33, $34, $B1, $1A, $F4, $1E, $0C, $66, $8B, $C5, $05, $B8, $01, $89,
$2B, $30, $18, $24, $4C, $0D, $8B, $41, $13, $46, $62, $90, $18, $A4, $4B, $55,
@@ -121,6 +121,43 @@ const
$00, $00, $49, $45, $4E, $44, $AE, $42, $60, $82
);
+ { icons8-клей-30.png, 24 на 24 точек }
+ IconGlueData: array[0..513] of Byte = (
+ $89, $50, $4E, $47, $0D, $0A, $1A, $0A, $00, $00, $00, $0D, $49, $48, $44, $52,
+ $00, $00, $00, $18, $00, $00, $00, $18, $08, $04, $00, $00, $00, $4A, $7E, $F5,
+ $73, $00, $00, $00, $20, $63, $48, $52, $4D, $00, $00, $7A, $26, $00, $00, $80,
+ $84, $00, $00, $FA, $00, $00, $00, $80, $E8, $00, $00, $75, $30, $00, $00, $EA,
+ $60, $00, $00, $3A, $98, $00, $00, $17, $70, $9C, $BA, $51, $3C, $00, $00, $00,
+ $02, $62, $4B, $47, $44, $00, $00, $AA, $8D, $23, $32, $00, $00, $00, $09, $70,
+ $48, $59, $73, $00, $00, $0B, $13, $00, $00, $0B, $13, $01, $00, $9A, $9C, $18,
+ $00, $00, $00, $07, $74, $49, $4D, $45, $07, $EA, $08, $1E, $15, $14, $31, $9E,
+ $20, $4F, $DD, $00, $00, $01, $67, $49, $44, $41, $54, $38, $CB, $B5, $D3, $3D,
+ $4F, $93, $61, $14, $C6, $F1, $5F, $AB, $80, $9D, $A8, $A1, $71, $95, $08, $14,
+ $3F, $80, $71, $D2, $8D, $C5, $D8, $A4, $A6, $61, $31, $74, $32, $31, $1A, $99,
+ $89, $B3, $8B, $71, $B0, $7C, $0F, $37, $42, $4B, $07, $07, $D0, $98, $30, $E0,
+ $0E, $62, $59, $1C, $24, $18, $35, $61, $50, $04, $C2, $F3, $DC, $0E, $DE, $9A,
+ $96, $C2, $23, $0B, $67, $3D, $D7, $FF, $3A, $D7, $FD, $72, $38, $EF, $BA, $70,
+ $6A, $67, $D4, $23, $15, $87, $3E, $0B, $67, $31, $1A, $B7, $E8, $97, $D4, $86,
+ $AA, $8B, $FF, $97, $97, $2D, $49, $05, $41, $B0, $A5, $66, $20, $5B, $3E, $69,
+ $51, $12, $E5, $41, $F0, $31, $1B, $29, $47, $79, $DA, $85, $6C, $AA, $9D, $76,
+ $DA, $09, $6D, $89, $23, $0B, $66, $BC, $ED, $42, $3A, $AA, $27, $21, $A3, $9A,
+ $52, $41, $CB, $35, $DC, $F0, $A6, $6B, $CE, $86, $5B, $FD, $C0, $53, $FB, $82,
+ $A0, $A1, $00, $6E, $F6, $20, $CF, $21, $DF, $03, $14, $0D, $81, $FB, $1E, $18,
+ $C4, $7B, $73, $DE, $C5, $DE, $81, $DD, $FE, $09, $B7, $AD, $47, $B7, $1D, $4F,
+ $0C, $21, $A7, $2E, $15, $A4, $9A, $AE, $F6, $8A, $07, $8C, $B9, $A2, $A2, $13,
+ $91, $2F, $66, $15, $8C, $59, $10, $24, $DA, $26, $7A, $E5, $79, $53, $56, $CD,
+ $2B, $A9, $FA, $10, $91, $6D, $F3, $96, $1C, $49, $B4, $4C, $1E, $0F, $33, $6C,
+ $59, $F0, $43, $C3, $88, $7B, $36, $BB, $2E, $34, $D1, $72, $BD, $3F, $7D, $D1,
+ $9A, $20, $D8, $F3, $D2, $88, $EA, $BF, $60, $A9, $76, $BF, $FB, $9F, $48, $75,
+ $3F, $23, $D2, $50, $52, $B1, $2E, $B5, $A7, $79, $3C, $FB, $DF, $9F, $38, $A8,
+ $1C, $5F, $B2, $E0, $B1, $9C, $17, $1E, $BA, $6B, $D7, $2B, $9F, $4E, $F2, $CF,
+ $99, $F6, $4D, $B0, $1F, $A7, $AC, $1A, $97, $59, $25, $2B, $82, $AF, $9E, $A9,
+ $5B, $B3, $6C, $2A, $63, $B1, $C0, $8C, $8E, $15, $35, $97, $E4, $15, $0D, $67,
+ $C9, $73, $E0, $8E, $CB, $5E, $FB, $7E, $B6, $65, $3C, $EF, $FA, $0D, $91, $67,
+ $97, $14, $98, $55, $D3, $54, $00, $00, $00, $00, $49, $45, $4E, $44, $AE, $42,
+ $60, $82
+ );
+
{ icons8-показ-видеокадров-30.png, значок окна, 32 на 32 точек, формат ico }
IconAppData: array[0..4285] of Byte = (
$00, $00, $01, $00, $01, $00, $20, $20, $00, $00, $01, $00, $20, $00, $A8, $10,
diff --git a/src/uMainForm.lfm b/src/uMainForm.lfm
index 102cc70..c079a73 100644
--- a/src/uMainForm.lfm
+++ b/src/uMainForm.lfm
@@ -56,8 +56,19 @@ object MainForm: TMainForm
ShowHint = True
TabStop = False
end
+ object btnGlue: TThemedButton
+ Left = 320
+ Height = 28
+ Top = 6
+ Width = 28
+ Down = True
+ Icon = tiGlue
+ OnClick = btnGlueClick
+ ShowHint = True
+ TabStop = False
+ end
object btnRipple: TThemedButton
- Left = 326
+ Left = 356
Height = 28
Top = 6
Width = 28
@@ -67,7 +78,7 @@ object MainForm: TMainForm
TabStop = False
end
object btnRippleMenu: TThemedButton
- Left = 356
+ Left = 386
Height = 28
Top = 6
Width = 22
@@ -76,10 +87,10 @@ object MainForm: TMainForm
TabStop = False
end
object lblStatus: TLabel
- Left = 428
+ Left = 458
Height = 20
Top = 10
- Width = 840
+ Width = 810
Anchors = [akTop, akLeft, akRight]
AutoSize = False
Caption = 'Готов.'
diff --git a/src/uMainForm.pas b/src/uMainForm.pas
index a4c5be7..2a34a93 100644
--- a/src/uMainForm.pas
+++ b/src/uMainForm.pas
@@ -46,6 +46,7 @@ type
TMainForm = class(TForm)
btnSnap: TThemedButton;
+ btnGlue: TThemedButton;
btnRipple: TThemedButton;
btnRippleMenu: TThemedButton;
lblPoolInfo: TLabel;
@@ -65,6 +66,7 @@ type
SaveProjectDialog: TSaveDialog;
splitVideo: TSplitter;
procedure btnSnapClick(Sender: TObject);
+ procedure btnGlueClick(Sender: TObject);
procedure btnRippleClick(Sender: TObject);
procedure btnRippleMenuClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
@@ -192,6 +194,7 @@ type
procedure UpdateSubtitles;
procedure UpdateRippleButton;
procedure UpdateSnapButton;
+ procedure UpdateGlueButton;
procedure RippleModeChosen(Sender: TObject);
procedure ToggleRipple;
procedure BuildPoolMenu;
@@ -420,6 +423,7 @@ begin
RefreshPool;
UpdateRippleButton;
UpdateSnapButton;
+ UpdateGlueButton;
UpdateCaption;
SetStatus('Готов. Добавьте файлы в проект.');
@@ -502,6 +506,7 @@ begin
else
FProject.RippleMode := rmCurrentTrack;
FProject.RippleEnabled := FSettings.RippleEnabled;
+ FTimeline.PlayheadSnap := FSettings.PlayheadSnap;
{ Каталоги подставляем в диалоги, чтобы не искать одно и то же место
заново при каждом запуске. }
@@ -532,6 +537,7 @@ begin
FSettings.LogVisible := memoLog.Visible;
FSettings.RippleAllTracks := FProject.RippleMode = rmAllTracks;
FSettings.RippleEnabled := FProject.RippleEnabled;
+ FSettings.PlayheadSnap := FTimeline.PlayheadSnap;
FSettings.WaveGain := FTimeline.WaveGain;
end;
@@ -763,7 +769,7 @@ procedure TMainForm.BuildJobIndicator;
const
JobWidth = 330;
LogButtonWidth = 28;
- LogButtonLeft = 388;
+ LogButtonLeft = 418;
begin
FJobLabel := TLabel.Create(Self);
FJobLabel.Parent := pnlBottom;
@@ -2212,6 +2218,30 @@ begin
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 при щелчке меняет решение на противоположное.';
+end;
+
+procedure TMainForm.btnGlueClick(Sender: TObject);
+begin
+ FTimeline.PlayheadSnap := not FTimeline.PlayheadSnap;
+ UpdateGlueButton;
+end;
+
procedure TMainForm.ToggleRipple;
begin
FProject.RippleEnabled := not FProject.RippleEnabled;
diff --git a/src/uSettings.pas b/src/uSettings.pas
index 505ca92..7b3ca08 100644
--- a/src/uSettings.pas
+++ b/src/uSettings.pas
@@ -36,6 +36,7 @@ type
FWaveGain: Double;
FVideoPanelHeight: Integer;
FLogVisible: Boolean;
+ FPlayheadSnap: Boolean;
FDepsReminder: Boolean;
FRecentProjects: TStringList;
function FileName: string;
@@ -67,6 +68,8 @@ type
{ Видна ли нижняя полоса с журналом. По умолчанию видна: пока
программа молодая, её сообщения нужнее, чем лишние строки монтажа. }
property LogVisible: Boolean read FLogVisible write FLogVisible;
+ { Прилипание курсора воспроизведения к границам клипов. }
+ property PlayheadSnap: Boolean read FPlayheadSnap write FPlayheadSnap;
{ Напоминать ли о недостающих зависимостях при запуске. Гасится
кнопкой «Не напоминать» в самом напоминании. }
property DepsReminder: Boolean read FDepsReminder write FDepsReminder;
@@ -99,6 +102,7 @@ begin
FWaveGain := DefaultWaveGain;
FVideoPanelHeight := DefaultVideoHeight;
FLogVisible := True;
+ FPlayheadSnap := True;
FDepsReminder := True;
end;
@@ -179,6 +183,7 @@ begin
FWaveGain := Obj.Get('wave_gain', FWaveGain);
FVideoPanelHeight := Obj.Get('video_panel_height', FVideoPanelHeight);
FLogVisible := Obj.Get('log_visible', FLogVisible);
+ FPlayheadSnap := Obj.Get('playhead_snap', FPlayheadSnap);
FDepsReminder := Obj.Get('deps_reminder', FDepsReminder);
Arr := Obj.Find('recent_projects', jtArray) as TJSONArray;
@@ -230,6 +235,7 @@ begin
Root.Add('wave_gain', FWaveGain);
Root.Add('video_panel_height', FVideoPanelHeight);
Root.Add('log_visible', FLogVisible);
+ Root.Add('playhead_snap', FPlayheadSnap);
Root.Add('deps_reminder', FDepsReminder);
Arr := TJSONArray.Create;
diff --git a/src/uTheme.pas b/src/uTheme.pas
index 2fd52ae..f95f569 100644
--- a/src/uTheme.pas
+++ b/src/uTheme.pas
@@ -68,7 +68,8 @@ type
tiNone,
tiSnap, // прилипание: края притягиваются к общей линии
tiRipple, // схлопывание: дыра между кусками закрывается
- tiLog // журнал: полоса с сообщениями
+ tiLog, // журнал: полоса с сообщениями
+ tiGlue // курсор липнет к границам клипов
);
{ Полоска выполнения, которая рисует себя сама.
@@ -451,6 +452,7 @@ begin
tiSnap: Stream.WriteBuffer(IconSnapData[0], Length(IconSnapData));
tiRipple: Stream.WriteBuffer(IconRippleData[0], Length(IconRippleData));
tiLog: Stream.WriteBuffer(IconLogData[0], Length(IconLogData));
+ tiGlue: Stream.WriteBuffer(IconGlueData[0], Length(IconGlueData));
else
Exit;
end;
diff --git a/src/uTimelineCtrl.pas b/src/uTimelineCtrl.pas
index 0f0dd63..6f2a01a 100644
--- a/src/uTimelineCtrl.pas
+++ b/src/uTimelineCtrl.pas
@@ -100,6 +100,10 @@ type
выключено — временно включает. }
FSnapEnabled: Boolean;
FSnapSuspended: Boolean;
+ { Прилипание курсора воспроизведения к границам клипов. Отдельно от
+ прилипания клипов друг к другу: это разные привычки, и человек
+ может хотеть одно без другого. }
+ FPlayheadSnap: Boolean;
FDragOrigVolume: Double;
{ Во сколько раз растянуть форму звука по высоте. Только рисунок,
самого звука не касается: у тихих записей иначе не видно, где
@@ -260,6 +264,10 @@ type
{ Дорожка, выбранная щелчком по заголовку. }
property ActiveTrack: Integer read FActiveTrack write FActiveTrack;
property SnapEnabled: Boolean read FSnapEnabled write FSnapEnabled;
+ property PlayheadSnap: Boolean read FPlayheadSnap write FPlayheadSnap;
+ { Куда встанет курсор, если поставить его в это время. Открыто, чтобы
+ расчёт можно было проверить числами, не гоняя мышь по окну. }
+ function SnapPlayhead(const ATime: Double): Double;
property Project: TProject read FProject write FProject;
{ Усиление формы звука. Меняется по Shift со стрелками. }
@@ -380,6 +388,7 @@ begin
FHoverTrack := -1;
FActiveTrack := 0;
FSnapEnabled := True;
+ FPlayheadSnap := True;
end;
destructor TTimelineControl.Destroy;
@@ -1525,6 +1534,61 @@ begin
Result := Best;
end;
+{ Куда встанет курсор воспроизведения: к ближайшей границе клипа, если
+ она близко.
+
+ Зачем. Точно попасть мышью в стык двух кусков нельзя: одна точка экрана
+ на общем плане — это секунды материала. А ставят курсор чаще всего
+ именно на стык: посмотреть переход, разрезать вплотную, свести концы.
+
+ Границы берутся со всех дорожек: стык на нижней дорожке нужен не реже,
+ чем на текущей. }
+function TTimelineControl.SnapPlayhead(const ATime: Double): Double;
+var
+ T, C: Integer;
+ Track: TTrack;
+ Clip: TClip;
+ Best, BestDist, Dist, Tolerance: Double;
+
+ procedure Consider(const ACandidate: Double);
+ begin
+ Dist := Abs(ACandidate - ATime);
+ if Dist < BestDist then
+ begin
+ BestDist := Dist;
+ Best := ACandidate;
+ end;
+ end;
+
+begin
+ Result := ATime;
+ if FProject = nil then
+ Exit;
+ { Shift меняет решение на противоположное — как и у прилипания клипов. }
+ if FPlayheadSnap = FSnapSuspended then
+ Exit;
+ if FPixelsPerSecond <= 0 then
+ Exit;
+
+ Tolerance := SnapPixels / FPixelsPerSecond;
+ BestDist := Tolerance;
+ Best := ATime;
+
+ Consider(0);
+ for T := 0 to FProject.TrackCount - 1 do
+ begin
+ Track := FProject.Tracks[T];
+ for C := 0 to Track.Count - 1 do
+ begin
+ Clip := Track[C];
+ Consider(Clip.TlStart);
+ Consider(Clip.TlEnd);
+ end;
+ end;
+
+ Result := Best;
+end;
+
{ --- Мышь --- }
procedure TTimelineControl.MouseDown(Button: TMouseButton; Shift: TShiftState;
@@ -1589,7 +1653,7 @@ begin
if Y < FRulerHeight then
begin
FAction := taScrub;
- Playhead := Max(0, XToTime(X));
+ Playhead := Max(0, SnapPlayhead(XToTime(X)));
Exit;
end;
@@ -1606,7 +1670,7 @@ begin
FOnSelectionChange(Self);
end;
FAction := taScrub;
- Playhead := Max(0, XToTime(X));
+ Playhead := Max(0, SnapPlayhead(XToTime(X)));
Exit;
end;
@@ -1766,7 +1830,9 @@ begin
end;
taScrub:
- Playhead := Max(0, XToTime(X));
+ { Протяжка прилипает так же, как щелчок: иначе курсор, поставленный
+ на стык, соскакивал бы с него от малейшего движения мыши. }
+ Playhead := Max(0, SnapPlayhead(XToTime(X)));
taVolume:
if FDragClip <> nil then
@@ -2028,6 +2094,9 @@ var
Clip: TClip;
begin
inherited MouseUp(Button, Shift, X, Y);
+ { Shift читается и здесь: курсор по щелчку ставится при отпускании, и
+ решение о прилипании должно быть по клавише, которую держат сейчас. }
+ FSnapSuspended := ssShift in Shift;
WasEditing := FAction in [taDragClip, taTrimIn, taTrimOut, taVolume,
taFadeIn, taFadeOut];
WasTrimIn := FAction = taTrimIn;
@@ -2049,7 +2118,7 @@ begin
if FProject <> nil then
FProject.CancelChange;
if WasClipPress then
- Playhead := Max(0, XToTime(FPressX));
+ Playhead := Max(0, SnapPlayhead(XToTime(FPressX)));
Exit;
end;
diff --git a/tests/lfmcheck/lfmcheck.lpr b/tests/lfmcheck/lfmcheck.lpr
index 156fd7e..b01418f 100644
--- a/tests/lfmcheck/lfmcheck.lpr
+++ b/tests/lfmcheck/lfmcheck.lpr
@@ -14,7 +14,8 @@ program lfmcheck;
uses
{ Interfaces нужен, чтобы связалась вся LCL и заработала загрузка
файлов форм. }
- Interfaces, Forms, Classes, SysUtils, TypInfo, uTheme,
+ Interfaces, Forms, Classes, SysUtils, Math, TypInfo, uTheme,
+ uMediaProbe, uProject, uTimelineCtrl,
uPanCropForm, uDepsForm, uMismatchForm, uProgressForm, uProjectInfoForm,
uRemuxForm;
@@ -72,6 +73,86 @@ begin
end;
end;
+procedure CheckTrue(const AName: string; AValue: Boolean);
+begin
+ if AValue then
+ WriteLn(' ok ', AName)
+ else
+ begin
+ WriteLn(' ПЛОХО ', AName);
+ Inc(Failed);
+ end;
+end;
+
+{ Прилипание курсора воспроизведения к границам клипов.
+
+ Проверяется числами, а не мышью: расчёт открыт наружу именно ради
+ этого. Мышью пришлось бы поднимать окно, а окно в проверках — это уже
+ не проверка расчёта, а проверка окружения. }
+procedure CheckPlayheadSnap;
+var
+ Proj: TProject;
+ Info: TMediaInfo;
+ Media: TMediaItem;
+ Timeline: TTimelineControl;
+begin
+ WriteLn;
+ WriteLn('Прилипание курсора к границам клипов');
+ WriteLn;
+
+ Info := Default(TMediaInfo);
+ Info.Valid := True;
+ Info.Kind := mkVideo;
+ Info.Duration := 600;
+ Info.HasVideo := True;
+ Info.VideoCodec := 'hevc';
+ Info.Width := 1920;
+ Info.Height := 1080;
+ Info.FpsNum := 30;
+ Info.FpsDen := 1;
+ Info.PixFmt := 'yuv420p';
+
+ Proj := TProject.Create;
+ Timeline := TTimelineControl.Create(nil);
+ try
+ Proj.Clear;
+ Proj.AddTrack('V1');
+ Media := Proj.AddMedia('/несуществующий/видео.mp4', Info);
+ { Два куска встык: границы на 0, 1.5 и 3. }
+ Proj.AddClip(Proj.Tracks[0], Media, 0, 1.5, 0);
+ Proj.AddClip(Proj.Tracks[0], Media, 10, 1.5, 1.5);
+
+ Timeline.Project := Proj;
+ { Сто точек в секунду: порог прилипания в восемь точек — это 0.08 с. }
+ Timeline.PixelsPerSecond := 100;
+ Timeline.PlayheadSnap := True;
+
+ CheckTrue('стык рядом — притянуло',
+ Abs(Timeline.SnapPlayhead(1.53) - 1.5) < 0.0001);
+ CheckTrue('с другой стороны — тоже',
+ Abs(Timeline.SnapPlayhead(1.47) - 1.5) < 0.0001);
+ CheckTrue('далеко от границ — не тронуло',
+ Abs(Timeline.SnapPlayhead(0.7) - 0.7) < 0.0001);
+ CheckTrue('начало монтажа притягивает',
+ Abs(Timeline.SnapPlayhead(0.05)) < 0.0001);
+ CheckTrue('конец последнего клипа притягивает',
+ Abs(Timeline.SnapPlayhead(2.96) - 3) < 0.0001);
+
+ { На мелком масштабе порог в точках даёт больший запас по времени. }
+ Timeline.PixelsPerSecond := 10;
+ CheckTrue('масштаб мельче — притягивает дальше',
+ Abs(Timeline.SnapPlayhead(1.7) - 1.5) < 0.0001);
+
+ Timeline.PixelsPerSecond := 100;
+ Timeline.PlayheadSnap := False;
+ CheckTrue('выключено — не притягивает',
+ Abs(Timeline.SnapPlayhead(1.53) - 1.53) < 0.0001);
+ finally
+ Timeline.Free;
+ Proj.Free;
+ end;
+end;
+
begin
WriteLn('Свойства из файлов форм');
WriteLn;
@@ -98,6 +179,8 @@ begin
CheckForm(TProjectInfoForm);
CheckForm(TRemuxForm);
+ CheckPlayheadSnap;
+
WriteLn;
if Failed = 0 then
WriteLn('ВЕРДИКТ: все проверки пройдены')
diff --git a/tools/make_icons.py b/tools/make_icons.py
index b98f26e..1392c84 100644
--- a/tools/make_icons.py
+++ b/tools/make_icons.py
@@ -29,6 +29,7 @@ ICONS = [
('Snap', 'icons8-магнит-30.png', 24),
('Ripple', 'icons8-merge-vertical-64.png', 24),
('Log', 'icons8-property-30.png', 24),
+ ('Glue', 'icons8-клей-30.png', 24),
]
# Значок самой программы: отдельно, потому что окну нужен формат ico —