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

Этап 2: кадрирование на клипе с перетаскиваемой рамкой

Browse source 
Настройка кадрирования переехала с файла на клип: два куска одного файла
бывает нужно кадрировать по-разному. У файла осталась такая же, но лишь
как заготовка — её берёт новый клип при добавлении. Проекты, записанные
раньше, читаются: клип без своей настройки берёт её у файла.

Открывается кнопкой в правом нижнем видимом углу клипа. Именно видимом:
у клипа длиной в час настоящий угол почти всегда за краем экрана — та же
задача, что уже решена для ручки громкости.

В окне слева появился кадр источника с рамкой, которую тянут мышью за
середину и за правый нижний угол. Рамка держит пропорции кадра проекта и
пересчитывается в увеличение и смещение; ползунки и рамка следуют друг за
другом.

Кусок пересобирается теперь не только когда файл не совпадает с проектом,
но и когда у клипа своё кадрирование.

Проверено сборкой: первый кусок без кадрирования скопирован, второй с
увеличением вдвое пересобран через scale=1280:720,crop=640:360:384:180.
154 пакета вошло, 154 вышло, декодирование без ошибок.

Заодно: правый щелчок по списку файлов теперь выделяет файл под курсором.
Без этого меню без выделения отключалось целиком и выглядело так, будто
его нет. Цвет формы звука сменён на пастельно-жёлтый.
This commit is contained in:
chaiman 2026-08-19 23:10:08 +03:00
commit b7b41f7cf0
8 changed files with 569 additions and 26 deletions
Download patch file Download diff file Expand all files Collapse all files

22
README.md
View file

@ -161,11 +161,23 @@ Ctrl+Shift+R, который схлопывает дыру под курсоро
Пересобираются **только они**. Остальной материал по-прежнему копируется
без потерь и почти мгновенно. Ролик целиком не перекодируется никогда.
Как именно кадр такого файла ложится в кадр проекта, решает окно
«Кадрирование и поворот» из контекстного меню библиотеки: вписать целиком
с полями, заполнить кадр с обрезкой или растянуть, плюс поворот на 90,
отражение, увеличение и смещение. Показывается настоящий кадр, пропущенный
через ту же цепочку фильтров, что пойдёт в дело.
Как именно кадр ложится в кадр проекта, решает окно «Кадрирование и
поворот»: вписать целиком с полями, заполнить кадр с обрезкой или
растянуть, плюс поворот на 90, отражение, увеличение и смещение.
Слева в окне — кадр источника с рамкой: её тянут мышью за середину и за
правый нижний угол, и она держит пропорции кадра проекта. Справа —
настоящий результат, пропущенный через ту же цепочку фильтров, что пойдёт
в дело.
**Настройка принадлежит клипу**, а открывается кнопкой в правом нижнем
видимом углу самого клипа. Именно видимом: у клипа длиной в час настоящий
угол почти всегда за краем экрана. Два куска одного файла можно
кадрировать по-разному.
У файла в библиотеке хранится такая же настройка, но она лишь заготовка:
её берёт новый клип при добавлении. Правится она из контекстного меню
библиотеки.
По умолчанию кадр вписывается целиком. Растяжение надо выбрать руками:
раньше оно применялось молча, и вертикальное видео размазывалось по ширине.

12
src/uFlatten.pas
View file

@ -332,12 +332,16 @@ begin
Seg.PreciseIn := (Winner.EdgeIn = edPrecise) and
(Abs(SegStart - Winner.TlStart) < 0.0005);
{ Файл, не совпадающий с параметрами проекта, скопировать нельзя:
придётся пересобрать. Но только его куски — всё остальное
{ Кусок нельзя скопировать по двум причинам: файл не совпадает с
параметрами проекта, либо у клипа своё кадрирование. И то, и
другое требует пересборки — но только этого куска, всё остальное
по-прежнему копируется. }
Seg.Transcode := HasBlocking(CompareToMaster(AProject.Master, Item.Info));
Seg.Transcode := HasBlocking(CompareToMaster(AProject.Master, Item.Info))
or (not TransformIsIdentity(Winner.Transform,
Item.Info.Width, Item.Info.Height,
AProject.Master.Width, AProject.Master.Height));
if Seg.Transcode then
Seg.Filter := TransformFilter(Item.Transform,
Seg.Filter := TransformFilter(Winner.Transform,
Item.Info.Width, Item.Info.Height,
AProject.Master.Width, AProject.Master.Height);

1
src/uMainForm.lfm
View file

@ -110,6 +110,7 @@ object MainForm: TMainForm
Align = alClient
ItemHeight = 100
OnClick = lstPoolClick
OnMouseDown = lstPoolMouseDown
OnDrawItem = lstPoolDrawItem
Style = lbOwnerDrawFixed
TabOrder = 0

63
src/uMainForm.pas
View file

@ -64,6 +64,8 @@ type
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormShow(Sender: TObject);
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
@ -144,6 +146,7 @@ type
procedure PoolRemoveFromTracks(Sender: TObject);
procedure PoolRemoveFromProject(Sender: TObject);
procedure PoolEditTransform(Sender: TObject);
procedure TimelineClipTransform(Sender: TObject; AClip: TClip);
procedure MenuProjectInfo(Sender: TObject);
procedure FormFilesDropped(Sender: TObject; const FileNames: array of string);
function ThumbIndexFor(const APath: string): Integer;
@ -445,6 +448,7 @@ begin
FTimeline.OnStructureChange := @TimelineStructureChange;
FTimeline.OnSelectionChange := @TimelineSelectionChange;
FTimeline.OnMediaDrop := @TimelineMediaDrop;
FTimeline.OnClipTransform := @TimelineClipTransform;
FTimeline.OnTrackAdded := @TimelineTrackAdded;
FTimeline.OnActiveTrackChange := @TimelineActiveTrackChange;
end;
@ -1594,6 +1598,23 @@ 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;
@ -1663,11 +1684,45 @@ begin
[Removed, Plural(Removed, 'клип', 'клипа', 'клипов')]));
end;
{ Как кадр файла ложится в кадр проекта.
{ Кадрирование отдельного клипа. Вызывается кнопкой в углу клипа.
Настройка живёт у файла, а не у клипа: она описывает сам материал, и для
всех его кусков одинакова. Применяется при приведении файла к проекту и
при пересборке его кусков во время сборки ролика. }
Настройка принадлежит клипу: два куска одного файла бывает нужно
кадрировать по-разному. У файла хранится такая же, но она лишь
заготовка для новых клипов. }
procedure TMainForm.TimelineClipTransform(Sender: TObject; AClip: TClip);
var
Item: TMediaItem;
T: TMediaTransform;
begin
if AClip = nil then
Exit;
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;
if not EditTransform(Self, Item.EffectivePath, Item.Info,
FProject.Master.Width, FProject.Master.Height, T,
FProject.CacheDir + 'pancrop.png') then
Exit;
FProject.BeginChange;
AClip.Transform := T;
FTimeline.Invalidate;
FLastLoadedEdl := '';
SchedulePreview;
UpdateCaption;
end;
{ Заготовка кадрирования для файла: её берёт новый клип при добавлении. }
procedure TMainForm.PoolEditTransform(Sender: TObject);
var
Idx: Integer;

29
src/uPanCropForm.lfm
View file

@ -1,24 +1,24 @@
object PanCropForm: TPanCropForm
Left = 380
Height = 560
Height = 620
Top = 220
Width = 940
Width = 1260
BorderIcons = [biSystemMenu]
Caption = 'Кадрирование и поворот'
ClientHeight = 560
ClientWidth = 940
ClientHeight = 620
ClientWidth = 1260
OnCreate = FormCreate
OnDestroy = FormDestroy
Position = poOwnerFormCenter
LCLVersion = '4.6'
object pnlLeft: TPanel
Left = 0
Height = 560
Height = 620
Top = 0
Width = 380
Align = alLeft
BevelOuter = bvNone
ClientHeight = 560
ClientHeight = 620
ClientWidth = 380
TabOrder = 0
object lblSource: TLabel
@ -180,12 +180,23 @@ object PanCropForm: TPanCropForm
TabOrder = 9
end
end
object imgPreview: TImage
object pbSource: TPaintBox
Left = 380
Height = 560
Height = 620
Top = 0
Width = 560
Width = 460
Align = alClient
OnMouseDown = pbSourceMouseDown
OnMouseMove = pbSourceMouseMove
OnMouseUp = pbSourceMouseUp
OnPaint = pbSourcePaint
end
object imgPreview: TImage
Left = 840
Height = 620
Top = 0
Width = 420
Align = alRight
Center = True
Proportional = True
Stretch = True

343
src/uPanCropForm.pas
View file

@ -36,6 +36,7 @@ type
chkFlipH: TCheckBox;
chkFlipV: TCheckBox;
imgPreview: TImage;
pbSource: TPaintBox;
lblFilter: TLabel;
lblFit: TLabel;
lblOffsetX: TLabel;
@ -53,6 +54,13 @@ type
procedure ControlChanged(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure pbSourcePaint(Sender: TObject);
procedure pbSourceMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure pbSourceMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
procedure pbSourceMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
FTransform: TMediaTransform;
FSourcePath: string;
@ -62,6 +70,27 @@ type
FPreviewFile: string;
FRefreshTimer: TTimer;
FUpdating: Boolean;
{ Кадр источника без всякой обработки — по нему тянут рамку. }
FSourceBmp: TBitmap;
{ Размеры кадра после поворота: рамка живёт в этих координатах. }
FRotW: Integer;
FRotH: Integer;
{ Рамка в координатах повёрнутого источника. }
FSel: TRect;
FDragMode: Integer;
FDragX: Integer;
FDragY: Integer;
FDragSel: TRect;
procedure LoadSourceFrame;
procedure UpdateRotatedSize;
{ Прямоугольник, в который вписан кадр источника на панели. }
function SourceRect: TRect;
function SelToScreen(const ASel: TRect): TRect;
function ScreenToSourceX(AX: Integer): Integer;
function ScreenToSourceY(AY: Integer): Integer;
{ Пересчёт между рамкой и настройкой. }
procedure SelFromTransform;
procedure TransformFromSel;
procedure ReadControls;
procedure WriteControls;
procedure ScheduleRefresh;
@ -84,7 +113,7 @@ implementation
{$R *.lfm}
uses
Math, uAppTypes, uFfmpegCmd, uProcRunner;
Math, Types, LCLIntf, uAppTypes, uFfmpegCmd, uProcRunner;
const
{ Ширина показываемого кадра. Больше незачем: тут важны пропорции и то,
@ -95,6 +124,14 @@ const
каждое движение бессмысленно. }
RefreshDelayMs = 300;
{ Что тянут мышью по кадру источника. }
dmNone = 0;
dmMove = 1;
dmResize = 2;
{ Сколько пикселей у угла считается «за угол». }
CornerGrip = 12;
ZoomMin = 50;
ZoomMax = 400;
OffsetRange = 50;
@ -144,6 +181,7 @@ end;
procedure TPanCropForm.FormDestroy(Sender: TObject);
begin
FreeAndNil(FSourceBmp);
FRefreshTimer.Enabled := False;
if (FPreviewFile <> '') and FileExists(FPreviewFile) then
DeleteFile(FPreviewFile);
@ -164,6 +202,8 @@ begin
[ExtractFileName(APath), AInfo.Width, AInfo.Height, ADstWidth, ADstHeight]);
WriteControls;
LoadSourceFrame;
SelFromTransform;
RefreshPreview(nil);
end;
@ -233,6 +273,9 @@ begin
if FUpdating then
Exit;
ReadControls;
{ Рамка следует за ползунками: иначе они разошлись бы с картинкой. }
SelFromTransform;
pbSource.Invalidate;
ScheduleRefresh;
end;
@ -253,6 +296,304 @@ begin
FRefreshTimer.Enabled := True;
end;
{ --- Рамка поверх кадра источника --- }
{ Размеры кадра после поворота: рамка живёт именно в них, иначе после
поворота на 90 она оказалась бы поперёк картинки. }
procedure TPanCropForm.UpdateRotatedSize;
var
Rot: Integer;
begin
FRotW := FSourceInfo.Width;
FRotH := FSourceInfo.Height;
Rot := ((FTransform.Rotation mod 360) + 360) mod 360;
if (Rot = 90) or (Rot = 270) then
begin
FRotW := FSourceInfo.Height;
FRotH := FSourceInfo.Width;
end;
end;
{ Кадр источника, вписанный в панель с сохранением пропорций. }
function TPanCropForm.SourceRect: TRect;
var
K: Double;
W, H: Integer;
begin
Result := Rect(0, 0, 0, 0);
if (FRotW <= 0) or (FRotH <= 0) then
Exit;
K := Min((pbSource.Width - 20) / FRotW, (pbSource.Height - 20) / FRotH);
if K <= 0 then
Exit;
W := Round(FRotW * K);
H := Round(FRotH * K);
Result := Rect((pbSource.Width - W) div 2, (pbSource.Height - H) div 2,
(pbSource.Width - W) div 2 + W, (pbSource.Height - H) div 2 + H);
end;
function TPanCropForm.SelToScreen(const ASel: TRect): TRect;
var
R: TRect;
KX, KY: Double;
begin
R := SourceRect;
if (FRotW <= 0) or (FRotH <= 0) or (R.Right <= R.Left) then
Exit(Rect(0, 0, 0, 0));
KX := (R.Right - R.Left) / FRotW;
KY := (R.Bottom - R.Top) / FRotH;
Result := Rect(
R.Left + Round(ASel.Left * KX), R.Top + Round(ASel.Top * KY),
R.Left + Round(ASel.Right * KX), R.Top + Round(ASel.Bottom * KY));
end;
function TPanCropForm.ScreenToSourceX(AX: Integer): Integer;
var
R: TRect;
begin
R := SourceRect;
if R.Right <= R.Left then
Exit(0);
Result := Round((AX - R.Left) * FRotW / (R.Right - R.Left));
end;
function TPanCropForm.ScreenToSourceY(AY: Integer): Integer;
var
R: TRect;
begin
R := SourceRect;
if R.Bottom <= R.Top then
Exit(0);
Result := Round((AY - R.Top) * FRotH / (R.Bottom - R.Top));
end;
{ Рамка по настройке. Обратное к TransformFromSel: там же и объяснение,
откуда берутся числа. }
procedure TPanCropForm.SelFromTransform;
var
KFit, KFill, K: Double;
SW, SH, CW, CH, CX, CY: Double;
W, H: Double;
begin
UpdateRotatedSize;
if (FRotW <= 0) or (FRotH <= 0) or (FDstWidth <= 0) or (FDstHeight <= 0) then
Exit;
KFit := Min(FDstWidth / FRotW, FDstHeight / FRotH);
KFill := Max(FDstWidth / FRotW, FDstHeight / FRotH);
if FTransform.Fit = fmFill then
K := KFill
else
K := KFit;
if FTransform.Fit = fmStretch then
begin
{ Растяжение рамкой не описывается: берётся весь кадр. }
FSel := Rect(0, 0, FRotW, FRotH);
Exit;
end;
if FTransform.Zoom > 0 then
K := K * FTransform.Zoom;
if K <= 0 then
Exit;
SW := FRotW * K;
SH := FRotH * K;
CW := Min(SW, FDstWidth);
CH := Min(SH, FDstHeight);
CX := (SW - CW) / 2 + FTransform.OffsetX * FDstWidth;
CY := (SH - CH) / 2 + FTransform.OffsetY * FDstHeight;
CX := Max(0, Min(SW - CW, CX));
CY := Max(0, Min(SH - CH, CY));
W := CW / K;
H := CH / K;
FSel := Rect(Round(CX / K), Round(CY / K),
Round(CX / K + W), Round(CY / K + H));
end;
{ Настройка по рамке.
Рамка говорит, какая часть источника займёт кадр проекта. Отсюда
увеличение — во сколько раз её надо растянуть, а смещение — насколько
она сдвинута относительно середины. }
procedure TPanCropForm.TransformFromSel;
var
KFit, KFill, KBase, K: Double;
SW, SH, CW, CH: Double;
begin
if (FRotW <= 0) or (FRotH <= 0) or (FDstWidth <= 0) or (FDstHeight <= 0) then
Exit;
if (FSel.Right - FSel.Left < 4) or (FSel.Bottom - FSel.Top < 4) then
Exit;
KFit := Min(FDstWidth / FRotW, FDstHeight / FRotH);
KFill := Max(FDstWidth / FRotW, FDstHeight / FRotH);
if FTransform.Fit = fmFill then
KBase := KFill
else
KBase := KFit;
if KBase <= 0 then
Exit;
K := FDstWidth / (FSel.Right - FSel.Left);
FTransform.Zoom := K / KBase;
SW := FRotW * K;
SH := FRotH * K;
CW := Min(SW, FDstWidth);
CH := Min(SH, FDstHeight);
FTransform.OffsetX := (FSel.Left * K - (SW - CW) / 2) / FDstWidth;
FTransform.OffsetY := (FSel.Top * K - (SH - CH) / 2) / FDstHeight;
end;
{ Кадр источника без обработки: по нему тянут рамку. }
procedure TPanCropForm.LoadSourceFrame;
var
Res: TProcResult;
Png: TPortableNetworkGraphic;
AtTime: Double;
Path: string;
begin
FreeAndNil(FSourceBmp);
if FSourcePath = '' then
Exit;
Path := FPreviewFile + '.src.png';
if FSourceInfo.Kind = mkImage then
AtTime := 0
else
AtTime := Min(5, Max(0, FSourceInfo.Duration * 0.1));
{ Пустая цепочка фильтров: нужен именно исходный кадр, без вписывания и
полей — иначе рамку не по чему тянуть. }
Res := RunProcess(FfmpegExe,
ArgsPreviewFrame(FSourcePath, Path, AtTime, ''), nil, nil, nil);
if (not Res.Started) or (Res.ExitCode <> 0) or (not FileExists(Path)) then
Exit;
Png := TPortableNetworkGraphic.Create;
try
try
Png.LoadFromFile(Path);
FSourceBmp := TBitmap.Create;
FSourceBmp.Assign(Png);
except
FreeAndNil(FSourceBmp);
end;
finally
Png.Free;
end;
SysUtils.DeleteFile(Path);
end;
procedure TPanCropForm.pbSourcePaint(Sender: TObject);
var
R, S: TRect;
begin
pbSource.Canvas.Brush.Style := bsSolid;
pbSource.Canvas.Brush.Color := ThemeWindow;
pbSource.Canvas.FillRect(pbSource.ClientRect);
R := SourceRect;
if R.Right <= R.Left then
Exit;
if FSourceBmp <> nil then
pbSource.Canvas.StretchDraw(R, FSourceBmp)
else
begin
pbSource.Canvas.Brush.Color := ThemeSurface;
pbSource.Canvas.FillRect(R);
end;
{ Затемнять то, что вне рамки, нечем без полупрозрачности, поэтому
просто рисуем саму рамку и её углы. }
S := SelToScreen(FSel);
pbSource.Canvas.Brush.Style := bsClear;
pbSource.Canvas.Pen.Color := ThemeAccent;
pbSource.Canvas.Pen.Width := 2;
pbSource.Canvas.Rectangle(S);
pbSource.Canvas.Pen.Width := 1;
pbSource.Canvas.Brush.Style := bsSolid;
pbSource.Canvas.Brush.Color := ThemeAccent;
pbSource.Canvas.FillRect(S.Right - 8, S.Bottom - 8, S.Right, S.Bottom);
end;
procedure TPanCropForm.pbSourceMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
S: TRect;
begin
if Button <> mbLeft then
Exit;
S := SelToScreen(FSel);
FDragSel := FSel;
FDragX := X;
FDragY := Y;
if (Abs(X - S.Right) <= CornerGrip) and (Abs(Y - S.Bottom) <= CornerGrip) then
FDragMode := dmResize
else if PtInRect(S, Point(X, Y)) then
FDragMode := dmMove
else
FDragMode := dmNone;
end;
procedure TPanCropForm.pbSourceMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var
DX, DY, W, H: Integer;
begin
if FDragMode = dmNone then
Exit;
DX := ScreenToSourceX(X) - ScreenToSourceX(FDragX);
DY := ScreenToSourceY(Y) - ScreenToSourceY(FDragY);
if FDragMode = dmMove then
begin
W := FDragSel.Right - FDragSel.Left;
H := FDragSel.Bottom - FDragSel.Top;
FSel.Left := Max(0, Min(FRotW - W, FDragSel.Left + DX));
FSel.Top := Max(0, Min(FRotH - H, FDragSel.Top + DY));
FSel.Right := FSel.Left + W;
FSel.Bottom := FSel.Top + H;
end
else
begin
{ Ширину меняем мышью, высоту считаем: рамка держит пропорции кадра
проекта, иначе картинка поехала бы. }
W := Max(16, FDragSel.Right - FDragSel.Left + DX);
W := Min(W, FRotW - FSel.Left);
H := Round(W * FDstHeight / FDstWidth);
if FSel.Top + H > FRotH then
begin
H := FRotH - FSel.Top;
W := Round(H * FDstWidth / FDstHeight);
end;
FSel.Right := FSel.Left + W;
FSel.Bottom := FSel.Top + H;
end;
TransformFromSel;
FUpdating := True;
try
WriteControls;
finally
FUpdating := False;
end;
pbSource.Invalidate;
ScheduleRefresh;
end;
procedure TPanCropForm.pbSourceMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FDragMode := dmNone;
end;
procedure TPanCropForm.RefreshPreview(Sender: TObject);
var
PrevW, PrevH: Integer;

36
src/uProject.pas
View file

@ -80,6 +80,7 @@ type
FKind: TClipKind;
FSelected: Boolean;
FVolume: Double;
FTransform: TMediaTransform;
public
constructor Create;
function TlEnd: Double;
@ -99,6 +100,13 @@ type
громче. Хранится множителем, а не в децибелах, чтобы не переводить
туда-сюда при каждой отрисовке; в интерфейсе показывается процентами. }
property Volume: Double read FVolume write FVolume;
{ Как кадр этого клипа ложится в кадр проекта.
Настройка принадлежит клипу, а не файлу: два куска одного файла
бывает нужно кадрировать по-разному. У файла остаётся такая же
настройка, но она лишь заготовка — её берёт новый клип при
добавлении. }
property Transform: TMediaTransform read FTransform write FTransform;
{ Выделение живёт только в памяти и в файл проекта не пишется. }
property Selected: Boolean read FSelected write FSelected;
end;
@ -264,6 +272,7 @@ begin
inherited Create;
{ Без явного значения множитель был бы нулём, то есть тишиной. }
FVolume := 1;
FTransform := DefaultTransform;
end;
function TClip.TlEnd: Double;
@ -548,6 +557,9 @@ begin
Result.Kind := ckImage
else
Result.Kind := ckVideo;
{ Настройка файла — заготовка: новый клип берёт её при добавлении и
дальше живёт своей. }
Result.Transform := AMedia.Transform;
ATrack.Add(Result);
FModified := True;
end;
@ -937,7 +949,16 @@ begin
'edge_in', EdgeToStr(Clip.EdgeIn),
'edge_out', EdgeToStr(Clip.EdgeOut),
'kind', KindToStr(Clip.Kind),
'volume', Clip.Volume
'volume', Clip.Volume,
'transform', TJSONObject.Create([
'fit', FitModeToStr(Clip.Transform.Fit),
'rotation', Clip.Transform.Rotation,
'flip_h', Clip.Transform.FlipH,
'flip_v', Clip.Transform.FlipV,
'zoom', Clip.Transform.Zoom,
'offset_x', Clip.Transform.OffsetX,
'offset_y', Clip.Transform.OffsetY
])
]));
end;
Obj.Add('clips', ClipsArr);
@ -963,7 +984,7 @@ var
Obj, ItemObj, TrackObj, ClipObj, Settings: TJSONObject;
Arr, ClipsArr: TJSONArray;
I, J: Integer;
Item: TMediaItem;
Item, Media: TMediaItem;
Track: TTrack;
Clip: TClip;
begin
@ -1036,6 +1057,17 @@ begin
Clip.EdgeOut := StrToEdge(ClipObj.Get('edge_out', 'snap'));
Clip.Kind := StrToKind(ClipObj.Get('kind', 'video'));
Clip.Volume := ClipObj.Get('volume', Double(1));
{ Проекты, записанные до появления кадрирования у клипа,
берут его у файла — там оно и хранилось раньше. }
if ClipObj.Find('transform') <> nil then
Clip.Transform := JsonToTransform(
ClipObj.Get('transform', TJSONObject(nil)))
else
begin
Media := FindMedia(Clip.MediaId);
if Media <> nil then
Clip.Transform := Media.Transform;
end;
Track.Add(Clip);
end;
Track.Sort;

89
src/uTimelineCtrl.pas
View file

@ -50,6 +50,9 @@ type
TMediaDropEvent = procedure(Sender: TObject; ASource: TObject;
ATrackIndex: Integer; const ATime: Double) of object;
{ Нажали кнопку кадрирования на клипе. }
TClipEvent = procedure(Sender: TObject; AClip: TClip) of object;
TTimelineControl = class(TCustomControl)
private
FProject: TProject;
@ -109,6 +112,7 @@ type
FOnStructureChange: TNotifyEvent;
FOnSelectionChange: TNotifyEvent;
FOnMediaDrop: TMediaDropEvent;
FOnClipTransform: TClipEvent;
FOnTrackAdded: TNotifyEvent;
FOnActiveTrackChange: TNotifyEvent;
@ -134,6 +138,14 @@ type
procedure DrawPlayhead(ACanvas: TCanvas);
procedure DrawHeaders(ACanvas: TCanvas);
procedure DrawWaveform(ACanvas: TCanvas; AClip: TClip; const ABody: TRect);
{ Кнопка кадрирования в правом нижнем углу видимой части клипа.
Именно видимой: у клипа длиной в час настоящий угол почти всегда за
краем экрана, и дотянуться до него мышью нельзя. }
function CropButtonRect(const ABody: TRect): TRect;
{ Тот же прямоугольник, но по клипу: тело считается так же, как при
отрисовке. }
function ClipCropRect(AClip: TClip; ATop: Integer): TRect;
procedure DrawCropButton(ACanvas: TCanvas; const ABody: TRect);
procedure DrawVolume(ACanvas: TCanvas; AClip: TClip; ATop: Integer;
const ABody: TRect);
@ -228,6 +240,9 @@ type
property OnSelectionChange: TNotifyEvent read FOnSelectionChange
write FOnSelectionChange;
property OnMediaDrop: TMediaDropEvent read FOnMediaDrop write FOnMediaDrop;
{ Нажата кнопка кадрирования в углу клипа. }
property OnClipTransform: TClipEvent read FOnClipTransform
write FOnClipTransform;
{ Компонент сам создал дорожку при перетаскивании клипа вниз. }
property OnTrackAdded: TNotifyEvent read FOnTrackAdded write FOnTrackAdded;
property OnActiveTrackChange: TNotifyEvent read FOnActiveTrackChange
@ -294,7 +309,8 @@ const
ColorPlayhead = TColor($4040FF); // красный: привычный цвет курсора
ColorEdgeSnap = TColor($909090); // серый: рез притянут к опорному кадру
ColorEdgePrecise = TColor($FFC030); // голубой: рез потребует перекодирования
ColorWave = TColor($7A6A55); // приглушённый синий: форма звука
ColorWave = TColor($96C8D2); // пастельно-жёлтый: форма звука
ColorCropButton = TColor($4A6A8A); // кнопка кадрирования на клипе
ColorVolumeLine = TColor($60E0E0); // жёлтый: линия громкости
ColorVolumeHandle = TColor($30C0FF); // оранжевый: ручка громкости
ColorHeaderActive = TColor($3A3A3A); // подсветка выбранной дорожки
@ -675,6 +691,11 @@ begin
нём рисуется. }
DrawWaveform(ACanvas, AClip, Body);
{ Кнопка кадрирования — поверх всего, чтобы её не перекрывала ни форма
звука, ни подписи. }
if AClip.Kind <> ckBlack then
DrawCropButton(ACanvas, Body);
{ Громкость рисуется до подписей: иначе её линия перечёркивает название
и длительность. }
DrawVolume(ACanvas, AClip, ATop, Body);
@ -755,6 +776,60 @@ begin
end;
end;
function TTimelineControl.CropButtonRect(const ABody: TRect): TRect;
const
Size = 16;
Margin = 3;
begin
Result := Rect(ABody.Right - Size - Margin, ABody.Bottom - Size - Margin,
ABody.Right - Margin, ABody.Bottom - Margin);
{ На узком или низком клипе кнопке не место: она закроет собой сам клип. }
if (ABody.Right - ABody.Left < Size * 3) or
(ABody.Bottom - ABody.Top < Size + Margin * 2) then
Result := Rect(0, 0, 0, 0);
end;
function TTimelineControl.ClipCropRect(AClip: TClip; ATop: Integer): TRect;
var
L, R: Integer;
begin
Result := Rect(0, 0, 0, 0);
if (AClip = nil) or (AClip.Kind = ckBlack) then
Exit;
L := TimeToX(AClip.TlStart);
R := TimeToX(AClip.TlEnd);
if (R < FHeaderWidth) or (L > ClientWidth) then
Exit;
if L < FHeaderWidth then
L := FHeaderWidth;
if R > ClientWidth then
R := ClientWidth;
Result := CropButtonRect(Rect(L, ATop + 3, R, ATop + FTrackHeight - 3));
end;
procedure TTimelineControl.DrawCropButton(ACanvas: TCanvas; const ABody: TRect);
var
R: TRect;
begin
R := CropButtonRect(ABody);
if R.Right <= R.Left then
Exit;
ACanvas.Brush.Style := bsSolid;
ACanvas.Brush.Color := ColorCropButton;
ACanvas.FillRect(R);
ACanvas.Pen.Color := ColorClipBorder;
ACanvas.Brush.Style := bsClear;
ACanvas.Rectangle(R);
{ Значок: рамка внутри рамки — то самое кадрирование. }
ACanvas.Pen.Color := ColorClipText;
ACanvas.Rectangle(R.Left + 4, R.Top + 4, R.Right - 4, R.Bottom - 4);
ACanvas.Brush.Style := bsSolid;
end;
procedure TTimelineControl.SetWaveGain(const AValue: Double);
var
V: Double;
@ -1171,6 +1246,7 @@ var
Edge, Idx: Integer;
Part: THeaderPart;
VolHandle: TRect;
CropRect: TRect;
begin
inherited MouseDown(Button, Shift, X, Y);
SetFocus;
@ -1260,6 +1336,17 @@ begin
{ Ручка громкости имеет приоритет над переносом клипа: она мелкая, и
промахнуться мимо неё легче, чем мимо всего клипа. }
{ Кнопка кадрирования перехватывает щелчок раньше всех: иначе клип
успеет выделиться и поехать за мышью. }
CropRect := ClipCropRect(Clip, TrackTop(TrackIndexAt(Y)));
if (CropRect.Right > CropRect.Left) and PtInRect(CropRect, Point(X, Y)) then
begin
FAction := taNone;
if Assigned(FOnClipTransform) then
FOnClipTransform(Self, Clip);
Exit;
end;
VolHandle := VolumeHandleRect(Clip, TrackTop(TrackIndexAt(Y)));
Edge := EdgeAtPoint(X, Clip);