From b7b41f7cf00bea3d5e5f46417cbd4cb9793d4855 Mon Sep 17 00:00:00 2001 From: chaiman Date: Wed, 19 Aug 2026 23:10:08 +0300 Subject: [PATCH] =?UTF-8?q?=D0=AD=D1=82=D0=B0=D0=BF=202:=20=D0=BA=D0=B0?= =?UTF-8?q?=D0=B4=D1=80=D0=B8=D1=80=D0=BE=D0=B2=D0=B0=D0=BD=D0=B8=D0=B5=20?= =?UTF-8?q?=D0=BD=D0=B0=20=D0=BA=D0=BB=D0=B8=D0=BF=D0=B5=20=D1=81=20=D0=BF?= =?UTF-8?q?=D0=B5=D1=80=D0=B5=D1=82=D0=B0=D1=81=D0=BA=D0=B8=D0=B2=D0=B0?= =?UTF-8?q?=D0=B5=D0=BC=D0=BE=D0=B9=20=D1=80=D0=B0=D0=BC=D0=BA=D0=BE=D0=B9?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Настройка кадрирования переехала с файла на клип: два куска одного файла бывает нужно кадрировать по-разному. У файла осталась такая же, но лишь как заготовка — её берёт новый клип при добавлении. Проекты, записанные раньше, читаются: клип без своей настройки берёт её у файла. Открывается кнопкой в правом нижнем видимом углу клипа. Именно видимом: у клипа длиной в час настоящий угол почти всегда за краем экрана — та же задача, что уже решена для ручки громкости. В окне слева появился кадр источника с рамкой, которую тянут мышью за середину и за правый нижний угол. Рамка держит пропорции кадра проекта и пересчитывается в увеличение и смещение; ползунки и рамка следуют друг за другом. Кусок пересобирается теперь не только когда файл не совпадает с проектом, но и когда у клипа своё кадрирование. Проверено сборкой: первый кусок без кадрирования скопирован, второй с увеличением вдвое пересобран через scale=1280:720,crop=640:360:384:180. 154 пакета вошло, 154 вышло, декодирование без ошибок. Заодно: правый щелчок по списку файлов теперь выделяет файл под курсором. Без этого меню без выделения отключалось целиком и выглядело так, будто его нет. Цвет формы звука сменён на пастельно-жёлтый. --- README.md | 22 ++- src/uFlatten.pas | 12 +- src/uMainForm.lfm | 1 + src/uMainForm.pas | 63 +++++++- src/uPanCropForm.lfm | 29 ++-- src/uPanCropForm.pas | 343 +++++++++++++++++++++++++++++++++++++++++- src/uProject.pas | 36 ++++- src/uTimelineCtrl.pas | 89 ++++++++++- 8 files changed, 569 insertions(+), 26 deletions(-) diff --git a/README.md b/README.md index 4487804..66a472e 100644 --- a/README.md +++ b/README.md @@ -161,11 +161,23 @@ Ctrl+Shift+R, который схлопывает дыру под курсоро Пересобираются **только они**. Остальной материал по-прежнему копируется без потерь и почти мгновенно. Ролик целиком не перекодируется никогда. -Как именно кадр такого файла ложится в кадр проекта, решает окно -«Кадрирование и поворот» из контекстного меню библиотеки: вписать целиком -с полями, заполнить кадр с обрезкой или растянуть, плюс поворот на 90, -отражение, увеличение и смещение. Показывается настоящий кадр, пропущенный -через ту же цепочку фильтров, что пойдёт в дело. +Как именно кадр ложится в кадр проекта, решает окно «Кадрирование и +поворот»: вписать целиком с полями, заполнить кадр с обрезкой или +растянуть, плюс поворот на 90, отражение, увеличение и смещение. + +Слева в окне — кадр источника с рамкой: её тянут мышью за середину и за +правый нижний угол, и она держит пропорции кадра проекта. Справа — +настоящий результат, пропущенный через ту же цепочку фильтров, что пойдёт +в дело. + +**Настройка принадлежит клипу**, а открывается кнопкой в правом нижнем +видимом углу самого клипа. Именно видимом: у клипа длиной в час настоящий +угол почти всегда за краем экрана. Два куска одного файла можно +кадрировать по-разному. + +У файла в библиотеке хранится такая же настройка, но она лишь заготовка: +её берёт новый клип при добавлении. Правится она из контекстного меню +библиотеки. По умолчанию кадр вписывается целиком. Растяжение надо выбрать руками: раньше оно применялось молча, и вертикальное видео размазывалось по ширине. diff --git a/src/uFlatten.pas b/src/uFlatten.pas index 8dfcbb2..f7ad5ea 100644 --- a/src/uFlatten.pas +++ b/src/uFlatten.pas @@ -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); diff --git a/src/uMainForm.lfm b/src/uMainForm.lfm index 3e41355..39475e5 100644 --- a/src/uMainForm.lfm +++ b/src/uMainForm.lfm @@ -110,6 +110,7 @@ object MainForm: TMainForm Align = alClient ItemHeight = 100 OnClick = lstPoolClick + OnMouseDown = lstPoolMouseDown OnDrawItem = lstPoolDrawItem Style = lbOwnerDrawFixed TabOrder = 0 diff --git a/src/uMainForm.pas b/src/uMainForm.pas index 9a7bbf6..69dae88 100644 --- a/src/uMainForm.pas +++ b/src/uMainForm.pas @@ -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; diff --git a/src/uPanCropForm.lfm b/src/uPanCropForm.lfm index be3f746..022d3bc 100644 --- a/src/uPanCropForm.lfm +++ b/src/uPanCropForm.lfm @@ -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 diff --git a/src/uPanCropForm.pas b/src/uPanCropForm.pas index edb2148..61bd6a9 100644 --- a/src/uPanCropForm.pas +++ b/src/uPanCropForm.pas @@ -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; diff --git a/src/uProject.pas b/src/uProject.pas index c6501b0..9040149 100644 --- a/src/uProject.pas +++ b/src/uProject.pas @@ -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; diff --git a/src/uTimelineCtrl.pas b/src/uTimelineCtrl.pas index f70b662..964a602 100644 --- a/src/uTimelineCtrl.pas +++ b/src/uTimelineCtrl.pas @@ -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);