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

Затухания видны и настраиваются, сборка с перекодированием, свой журнал в окне сборки

Browse source 
Затухания. Механика была написана давно и работала в сборке, но увидеть
или задать её было нечем. Теперь у клипа два верхних угла — ручки:
левая тянет появление, правая уход. Взятое затухание рисуется срезанным
углом, так это устроено в монтажных программах. Ручки перехватывают
нажатие раньше растягивания за край: они мелкие, промахнуться мимо них
легче, а взяться за край можно ниже.

Перекрытие двух клипов одной дорожки — это переход, и он теперь помечен
косым крестом во всю высоту. Раньше о нём можно было узнать только по
предупреждению перед сборкой.

Сборка с перекодированием. Отдельный пункт меню и отдельное окно:
размер кадра от 720p до 4K, поток в килобитах, кодек HEVC или H.264.
Перекодирование идёт одним проходом на весь ролик — пересобирать куски
по отдельности нельзя, на стыках была бы видна смена качества.

Кодирование на видеокарте, и распаковка тоже: замерено на паре кусков
2688x1512 — 9.18 с на процессоре против 1.77 с с аппаратной распаковкой,
впятеро. Полностью карточный путь через scale_cuda оказался медленнее
(5.74 с) и не взят. Если аппаратная распаковка не пойдёт, сборка
повторяется без неё: медленно лучше, чем никак. Окно честно
предупреждает, когда аппаратного кодировщика в ffmpeg нет вовсе.

Журнал в окне сборки заменён на свой: у системного поля оставались
светлые полосы прокрутки и не работала прокрутка вбок с Shift. Это было
последнее такое место.
This commit is contained in:
4aiman 2026-08-21 18:11:59 +03:00
commit 7d9e1c4cbd
9 changed files with 589 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

224
src/uEncodeForm.pas Normal file
View file

@ -0,0 +1,224 @@
{
uEncodeForm — окно настроек сборки с перекодированием.
Зачем оно нужно. Обычная сборка копирует потоки и потому мгновенна, но
отдаёт ролик ровно в том виде, в каком снят исходник. Когда ролик надо
отдать под площадку — в 1080p с определённым потоком, — приходится
перекодировать, и это уже осознанный выбор, а не поведение по
умолчанию. Поэтому отдельный пункт меню и отдельное окно.
Окно собирается кодом, без файла формы: элементов в нём меньше десятка,
и описание заняло бы больше места, чем сам код. Так же сделано окно
сообщения в uTheme.
Перекодирование идёт на видеокарте. Процессорный кодировщик на
2688x1512 работает медленнее реального времени, и часовой ролик считал
бы часами; выбор кодировщика делает uFfmpegCmd, предпочитая NVENC.
Если аппаратного кодировщика нет, окно об этом честно предупреждает.
}
unit uEncodeForm;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Controls, Forms, Graphics, StdCtrls, Dialogs,
uTheme, uExport;
{ Спрашивает настройки. Возвращает False, если человек передумал.
ADefaultCodec — кодек проекта: с него разумно начинать, иначе первый же
выбор менял бы формат без спроса. }
function AskEncodeProfile(out AProfile: TEncodeProfile;
const ADefaultCodec: string): Boolean;
implementation
uses
uFfmpegCmd;
type
TPreset = record
Caption: string;
Width: Integer;
Height: Integer;
{ Поток в килобитах в секунду. Значения взяты как обычная рабочая
середина для съёмки с движением: меньше — заметны квадраты на
траве и воде, больше — файл растёт без видимой пользы. }
Bitrate: Integer;
end;
const
Presets: array[0..3] of TPreset = (
(Caption: '1280x720 (720p)'; Width: 1280; Height: 720; Bitrate: 8000),
(Caption: '1920x1080 (1080p)'; Width: 1920; Height: 1080; Bitrate: 16000),
(Caption: '2560x1440 (1440p)'; Width: 2560; Height: 1440; Bitrate: 28000),
(Caption: '3840x2160 (4K)'; Width: 3840; Height: 2160; Bitrate: 50000)
);
type
{ Обработчики живут в объекте: событиям нужны методы. }
TEncodeDialog = class(TComponent)
public
Form: TForm;
cbPreset: TComboBox;
cbCodec: TComboBox;
edBitrate: TEdit;
lblEncoder: TLabel;
procedure PresetChange(Sender: TObject);
procedure CodecChange(Sender: TObject);
procedure UpdateEncoderNote;
end;
procedure TEncodeDialog.PresetChange(Sender: TObject);
begin
if (cbPreset.ItemIndex >= 0) and (cbPreset.ItemIndex <= High(Presets)) then
edBitrate.Text := IntToStr(Presets[cbPreset.ItemIndex].Bitrate);
end;
procedure TEncodeDialog.CodecChange(Sender: TObject);
begin
UpdateEncoderNote;
end;
procedure TEncodeDialog.UpdateEncoderNote;
var
Codec, Enc: string;
begin
if cbCodec.ItemIndex = 0 then
Codec := 'hevc'
else
Codec := 'h264';
Enc := PreferredEncoder(Codec);
if Pos('nvenc', Enc) > 0 then
begin
lblEncoder.Font.Color := ThemeTextDim;
lblEncoder.Caption := 'Кодировщик: ' + Enc + ' — на видеокарте.';
end
else
begin
{ Предупреждение, а не запрет: пусть человек сам решит, готов ли
ждать. Молча уйти на процессор нельзя — разница в разы. }
lblEncoder.Font.Color := ThemeAccent;
lblEncoder.Caption := 'Кодировщик: ' + Enc +
' — аппаратного не нашлось, сборка будет очень долгой.';
end;
end;
function AskEncodeProfile(out AProfile: TEncodeProfile;
const ADefaultCodec: string): Boolean;
var
Dlg: TEncodeDialog;
Lbl: TLabel;
BtnOk, BtnCancel: TThemedButton;
I, Bitrate: Integer;
begin
Result := False;
AProfile := Default(TEncodeProfile);
Dlg := TEncodeDialog.Create(nil);
try
Dlg.Form := TForm.CreateNew(nil);
Dlg.Form.Caption := 'Сборка с перекодированием';
Dlg.Form.BorderStyle := bsDialog;
Dlg.Form.Position := poScreenCenter;
Dlg.Form.ClientWidth := 460;
Dlg.Form.ClientHeight := 220;
Lbl := TLabel.Create(Dlg.Form);
Lbl.Parent := Dlg.Form;
Lbl.SetBounds(16, 16, 120, 20);
Lbl.Caption := 'Размер кадра';
Dlg.cbPreset := TComboBox.Create(Dlg.Form);
Dlg.cbPreset.Parent := Dlg.Form;
Dlg.cbPreset.SetBounds(160, 12, 280, 26);
Dlg.cbPreset.Style := csDropDownList;
for I := 0 to High(Presets) do
Dlg.cbPreset.Items.Add(Presets[I].Caption);
Dlg.cbPreset.ItemIndex := 1;
Dlg.cbPreset.OnChange := @Dlg.PresetChange;
Lbl := TLabel.Create(Dlg.Form);
Lbl.Parent := Dlg.Form;
Lbl.SetBounds(16, 56, 140, 20);
Lbl.Caption := 'Поток, кбит/с';
Dlg.edBitrate := TEdit.Create(Dlg.Form);
Dlg.edBitrate.Parent := Dlg.Form;
Dlg.edBitrate.SetBounds(160, 52, 120, 26);
Dlg.edBitrate.Text := IntToStr(Presets[1].Bitrate);
Lbl := TLabel.Create(Dlg.Form);
Lbl.Parent := Dlg.Form;
Lbl.SetBounds(16, 96, 140, 20);
Lbl.Caption := 'Кодек';
Dlg.cbCodec := TComboBox.Create(Dlg.Form);
Dlg.cbCodec.Parent := Dlg.Form;
Dlg.cbCodec.SetBounds(160, 92, 280, 26);
Dlg.cbCodec.Style := csDropDownList;
Dlg.cbCodec.Items.Add('HEVC (H.265) — меньше файл');
Dlg.cbCodec.Items.Add('H.264 — совместимее');
if LowerCase(ADefaultCodec) = 'h264' then
Dlg.cbCodec.ItemIndex := 1
else
Dlg.cbCodec.ItemIndex := 0;
Dlg.cbCodec.OnChange := @Dlg.CodecChange;
Dlg.lblEncoder := TLabel.Create(Dlg.Form);
Dlg.lblEncoder.Parent := Dlg.Form;
Dlg.lblEncoder.SetBounds(16, 132, 424, 36);
Dlg.lblEncoder.WordWrap := True;
Dlg.lblEncoder.AutoSize := False;
Dlg.lblEncoder.ParentColor := False;
BtnOk := TThemedButton.Create(Dlg.Form);
BtnOk.Parent := Dlg.Form;
BtnOk.SetBounds(240, 180, 100, 28);
BtnOk.Caption := 'Собрать';
BtnOk.ModalResult := mrOk;
BtnOk.Default := True;
BtnCancel := TThemedButton.Create(Dlg.Form);
BtnCancel.Parent := Dlg.Form;
BtnCancel.SetBounds(348, 180, 100, 28);
BtnCancel.Caption := 'Отмена';
BtnCancel.ModalResult := mrCancel;
BtnCancel.Cancel := True;
{ Цвета задаются до первого показа, как и во всех остальных окнах. }
ApplyDarkTheme(Dlg.Form);
Dlg.UpdateEncoderNote;
if Dlg.Form.ShowModal <> mrOk then
Exit;
I := Dlg.cbPreset.ItemIndex;
if (I < 0) or (I > High(Presets)) then
I := 1;
Bitrate := StrToIntDef(Trim(Dlg.edBitrate.Text), Presets[I].Bitrate);
{ Ноль и отрицательное — не поток, а описка. Верхняя граница выбрана
с запасом: выше него кодировщики уже отказываются работать. }
if (Bitrate < 100) or (Bitrate > 400000) then
Bitrate := Presets[I].Bitrate;
AProfile.Enabled := True;
AProfile.Width := Presets[I].Width;
AProfile.Height := Presets[I].Height;
AProfile.BitrateKbps := Bitrate;
if Dlg.cbCodec.ItemIndex = 1 then
AProfile.Codec := 'h264'
else
AProfile.Codec := 'hevc';
Result := True;
finally
Dlg.Form.Free;
Dlg.Free;
end;
end;
end.

51
src/uExport.pas
View file

@ -51,6 +51,20 @@ uses
Classes, SysUtils, uAppTypes, uKeyframeIndex, uMediaProbe;
type
{ Настройки сборки с перекодированием.
Enabled = False означает обычную сборку копированием — то, ради чего
редактор и делался. Всё остальное имеет смысл только при True. }
TEncodeProfile = record
Enabled: Boolean;
Width: Integer;
Height: Integer;
BitrateKbps: Integer;
{ Кодек в привычных именах: h264 или hevc. Кодировщик под него
подбирается сам, с предпочтением аппаратного. }
Codec: string;
end;
{ Что получилось с одной частью.
Кусок монтажа обычно даёт одну часть, но при точном резе — две:
@ -116,6 +130,7 @@ type
FPacketCount: Int64;
FMaster: TMediaInfo;
FProfile: TEncodeProfile;
{ Формат промежуточных кусков: 'matroska' или 'mpegts'. }
FIntermediateFormat: string;
FIntermediateExt: string;
@ -155,7 +170,7 @@ type
по одному лишь числу источников. }
constructor Create(const ASegments, AAudio: TFlatSegmentArray;
const AOutputPath: string; AKeepIntermediate: Boolean;
const AMaster: TMediaInfo);
const AMaster: TMediaInfo; const AProfile: TEncodeProfile);
procedure RequestCancel;
@ -186,11 +201,12 @@ end;
constructor TExportThread.Create(const ASegments, AAudio: TFlatSegmentArray;
const AOutputPath: string; AKeepIntermediate: Boolean;
const AMaster: TMediaInfo);
const AMaster: TMediaInfo; const AProfile: TEncodeProfile);
var
I: Integer;
begin
FMaster := AMaster;
FProfile := AProfile;
inherited Create(True);
FreeOnTerminate := False;
@ -683,8 +699,37 @@ end;
function TExportThread.ConcatAll(const AListPath: string): Boolean;
begin
SetStage('Склеиваю');
FStepWork := FReport.TotalDuration;
if FProfile.Enabled then
begin
{ Перекодирование всего ролика одним проходом. Так весь результат
выходит из одного кодировщика с одними настройками: пересобирать
куски по отдельности здесь нельзя, на стыках была бы видна смена
качества. }
SetStage('Склеиваю и перекодирую');
if RunFfmpeg(ArgsConcatEncode(AListPath, FVideoPath,
FProfile.Width, FProfile.Height, FMaster.FpsNum, FMaster.FpsDen,
FProfile.BitrateKbps, FProfile.Codec, FMaster.PixFmt, True),
'Склейка с перекодированием') then
Exit(True);
if Terminated then
Exit(False);
{ Аппаратная распаковка не пошла — повторяем без неё.
Она даёт впятеро, но зависит от драйвера и от того, знаком ли
видеокарте кодек исходника. Отказываться из-за неё от сборки
нельзя: медленно лучше, чем никак. }
Log('Аппаратная распаковка не пошла, повторяю на процессоре.');
Exit(RunFfmpeg(ArgsConcatEncode(AListPath, FVideoPath,
FProfile.Width, FProfile.Height, FMaster.FpsNum, FMaster.FpsDen,
FProfile.BitrateKbps, FProfile.Codec, FMaster.PixFmt, False),
'Склейка с перекодированием без аппаратной распаковки'));
end;
SetStage('Склеиваю');
Result := RunFfmpeg(ArgsConcat(AListPath, FVideoPath), 'Склейка');
end;

79
src/uFfmpegCmd.pas
View file

@ -109,6 +109,20 @@ function TsSupportsCodecs(const AVideoCodec, AAudioCodec: string): Boolean;
{ Склеить куски по списку. Формат вывода ffmpeg определит по расширению. }
function ArgsConcat(const AListFile, ADst: string): TArgs;
{ Склеить куски и сразу перекодировать картинку в заданный размер и поток.
Нужно для сборки «под площадку»: когда ролик надо отдать в 1080p с
определённым битрейтом, а исходники сняты в 2688x1512. Отдельный путь, а
не пересборка каждого куска по отдельности: здесь важно, чтобы весь
ролик получился одним кодировщиком с одними настройками — иначе на
стыках видно смену качества.
Кодировщик выбирается аппаратный: перекодирование целого ролика на
процессоре идёт медленнее реального времени, и смысл теряется. }
function ArgsConcatEncode(const AListFile, ADst: string;
AWidth, AHeight, AFpsNum, AFpsDen, ABitrateKbps: Integer;
const AVideoCodec, APixFmt: string; AHwDecode: Boolean = True): TArgs;
{ Перепаковать файл в другой контейнер без перекодирования. }
{ Звук куска в сыром виде: 16 бит со знаком, частота и число каналов
проекта. Сырой поток нужен потому, что куски потом просто дописываются
@ -579,6 +593,71 @@ begin
(AAudioCodec = 'ac3') or (AAudioCodec = 'mp2');
end;
function ArgsConcatEncode(const AListFile, ADst: string;
AWidth, AHeight, AFpsNum, AFpsDen, ABitrateKbps: Integer;
const AVideoCodec, APixFmt: string; AHwDecode: Boolean): TArgs;
var
Fps, Enc: string;
begin
Enc := PreferredEncoder(AVideoCodec);
Result := Concat(CommonFfmpegPrefix, []);
{ Распаковка тоже на видеокарте. Замерено на паре кусков 2688x1512:
9.18 с без неё против 1.77 с с ней, впятеро.
Кадры при этом всё равно возвращаются в обычную память, а масштаб
считает процессор. Полностью карточный путь через scale_cuda в том же
замере оказался медленнее (5.74 с) — видимо, из-за преобразований
формата, и городить его незачем.
Признак необязательный: если распаковка не пойдёт, вызывающий
повторит без неё. }
if AHwDecode and (Pos('nvenc', Enc) > 0) then
Result := Concat(Result, ['-hwaccel', 'cuda']);
Result := Concat(Result, [
'-f', 'concat',
'-safe', '0',
'-i', AListFile,
'-map', '0:v:0',
'-map', '0:a:0?'
]);
{ Вписываем целиком и добиваем полями: соотношение сторон менять нельзя,
иначе кадр растянется. }
if (AWidth > 0) and (AHeight > 0) then
Result := Concat(Result, ['-vf', Format(
'scale=%d:%d:force_original_aspect_ratio=decrease,' +
'pad=%d:%d:(ow-iw)/2:(oh-ih)/2,setsar=1',
[AWidth, AHeight, AWidth, AHeight])]);
Result := Concat(Result, ['-c:v', Enc]);
if ABitrateKbps > 0 then
{ Верхняя граница и запас буфера задаются вместе со средним потоком:
без них кодировщик волен выдать всплеск вдвое выше заказанного. }
Result := Concat(Result, [
'-b:v', IntToStr(ABitrateKbps) + 'k',
'-maxrate', IntToStr(Round(ABitrateKbps * 1.5)) + 'k',
'-bufsize', IntToStr(ABitrateKbps * 2) + 'k']);
Fps := '';
if (AFpsNum > 0) and (AFpsDen > 0) then
Fps := IntToStr(AFpsNum) + '/' + IntToStr(AFpsDen);
if Fps <> '' then
Result := Concat(Result, ['-r', Fps]);
if APixFmt <> '' then
Result := Concat(Result, ['-pix_fmt', APixFmt]);
{ Звук уже собран и сжат отдельным проходом — трогать его незачем. }
Result := Concat(Result, ['-c:a', 'copy']);
Result := Concat(Result, ProgressArgs);
if WantsFaststart(ADst) then
Result := Concat(Result, ['-movflags', '+faststart']);
Result := Concat(Result, [ADst]);
end;
function ArgsConcat(const AListFile, ADst: string): TArgs;
begin
Result := Concat(CommonFfmpegPrefix, [

26
src/uMainForm.pas
View file

@ -25,7 +25,8 @@ uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
ComCtrls, Menus, Buttons, LCLType, LMessages,
uAppTypes, uEdl, uMpvLib, uMpvPlayer, uProject, uMediaProbe, uTimelineCtrl,
uFlatten, uGenerate, uExport, uProgressForm, uRemuxForm, uMismatchForm,
uFlatten, uGenerate, uExport, uEncodeForm, uProgressForm, uRemuxForm,
uMismatchForm,
uFfmpegJob, uSettings, uThumbs, uTransform, uPanCropForm,
uProjectInfoForm, ImgList, uTheme, uLogView, uDepsForm, uWaveform;
@ -236,6 +237,8 @@ type
procedure MenuSaveProject(Sender: TObject);
procedure MenuSaveProjectAs(Sender: TObject);
procedure MenuExport(Sender: TObject);
procedure MenuExportEncode(Sender: TObject);
procedure DoExport(const AProfile: TEncodeProfile);
procedure MenuRemux(Sender: TObject);
procedure MenuDeps(Sender: TObject);
procedure MenuQuit(Sender: TObject);
@ -566,6 +569,8 @@ begin
ShortCut(VK_I, [ssCtrl]));
AddSep(MFile);
AddItem(MFile, 'Собрать ролик...', @MenuExport, ShortCut(VK_E, [ssCtrl]));
AddItem(MFile, 'Собрать с перекодированием...', @MenuExportEncode,
ShortCut(VK_E, [ssCtrl, ssShift]));
AddItem(MFile, 'Перепаковка файлов...', @MenuRemux);
AddSep(MFile);
AddItem(MFile, 'Зависимости...', @MenuDeps);
@ -2573,7 +2578,24 @@ end;
{ --- Сборка ролика --- }
{ Обычная сборка: копирование потоков, ради чего редактор и делался. }
procedure TMainForm.MenuExport(Sender: TObject);
begin
DoExport(Default(TEncodeProfile));
end;
{ Сборка с перекодированием: отдельный пункт, потому что это осознанный
выбор — ролик пересобирается целиком, и быстрым это уже не будет. }
procedure TMainForm.MenuExportEncode(Sender: TObject);
var
Profile: TEncodeProfile;
begin
if not AskEncodeProfile(Profile, FProject.Master.VideoCodec) then
Exit;
DoExport(Profile);
end;
procedure TMainForm.DoExport(const AProfile: TEncodeProfile);
var
Segments, AudioSegs: TFlatSegmentArray;
Missing: TGenRequests;
@ -2657,7 +2679,7 @@ begin
SecondsToStr(TotalDuration(Segments))]));
FExport := TExportThread.Create(Segments, AudioSegs,
SaveExportDialog.FileName, True, FProject.Master);
SaveExportDialog.FileName, True, FProject.Master, AProfile);
FExport.OnProgress := @ExportProgress;
FExport.OnLog := @ExportLog;
FExport.OnTerminate := @ExportDone;

5
src/uProgressForm.lfm
View file

@ -49,7 +49,7 @@ object ProgressForm: TProgressForm
TabOrder = 1
end
end
object memoLog: TMemo
object memoLog: TLogView
Left = 0
Height = 310
Top = 110
@ -58,9 +58,6 @@ object ProgressForm: TProgressForm
Font.Height = -12
Font.Name = 'Monospace'
ParentFont = False
ReadOnly = True
ScrollBars = ssAutoBoth
TabOrder = 1
WordWrap = False
end
end

15
src/uProgressForm.pas
View file

@ -16,7 +16,8 @@ unit uProgressForm;
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, ComCtrls, StdCtrls, ExtCtrls, uTheme;
Classes, SysUtils, Forms, Controls, Graphics, ComCtrls, StdCtrls, ExtCtrls,
uTheme, uLogView;
type
@ -25,7 +26,7 @@ type
TProgressForm = class(TForm)
btnAction: TThemedButton;
lblStage: TLabel;
memoLog: TMemo;
memoLog: TLogView;
pbBar: TProgressBar;
pnlTop: TPanel;
procedure btnActionClick(Sender: TObject);
@ -87,13 +88,9 @@ end;
procedure TProgressForm.AddLog(const AText: string);
begin
{ Журнал одной операции не должен расти без предела: ffmpeg на битом
файле способен выдать тысячи одинаковых предупреждений. }
if memoLog.Lines.Count > 1000 then
memoLog.Lines.Delete(0);
memoLog.Lines.Add(AText);
{ Держим видимой последнюю строку. }
memoLog.SelStart := Length(memoLog.Text);
{ Свой журнал сам держится конца, пока пользователь не отмотал назад, и
сам обрезает старые строки. }
memoLog.Add(AText);
end;
procedure TProgressForm.Finish(ASuccess: Boolean; const AMessage: string);

207
src/uTimelineCtrl.pas
View file

@ -36,7 +36,9 @@ type
taTrimOut, // растягивание за правый край
taScrub, // протяжка курсора воспроизведения
taPan, // прокрутка средней кнопкой
taVolume // тянем ручку громкости клипа
taVolume, // тянем ручку громкости клипа
taFadeIn, // тянем появление за верхний левый угол
taFadeOut // тянем уход за верхний правый угол
);
{ Что находится под указателем в полосе заголовков дорожек. }
@ -140,6 +142,15 @@ type
procedure DrawPlayhead(ACanvas: TCanvas);
procedure DrawHeaders(ACanvas: TCanvas);
procedure DrawWaveform(ACanvas: TCanvas; AClip: TClip; const ABody: TRect);
{ Появление и уход: наклонная линия по верху клипа и квадратная ручка
на её конце. Так это устроено в монтажных программах, и так сразу
видно, где звук или картинка нарастают. }
procedure DrawFades(ACanvas: TCanvas; AClip: TClip; const ABody: TRect);
{ Ручка затухания. AIn = True — появление (левый угол), иначе уход. }
function FadeHandleRect(AClip: TClip; ATop: Integer; AIn: Boolean): TRect;
{ Полоса перекрытия двух клипов одной дорожки: там сам собой выходит
переход, и это надо видеть. }
procedure DrawOverlaps(ACanvas: TCanvas; ATrack: TTrack; ATop: Integer);
{ Кнопка кадрирования в правом нижнем углу видимой части клипа.
Именно видимой: у клипа длиной в час настоящий угол почти всегда за
краем экрана, и дотянуться до него мышью нельзя. }
@ -327,6 +338,9 @@ const
ColorClipAudio = TColor($5A4A2A); // приглушённый синий: звуковой клип
ColorVolumeLine = TColor($60E0E0); // жёлтый: линия громкости
ColorVolumeHandle = TColor($30C0FF); // оранжевый: ручка громкости
ColorFadeLine = TColor($E0E0E0); // белый: линия затухания
ColorFadeFill = TColor($505050); // серый: срезанный угол клипа
ColorOverlap = TColor($30C0FF); // оранжевый: полоса перехода
ColorHeaderActive = TColor($3A3A3A); // подсветка выбранной дорожки
ColorButtonOff = TColor($3A3A3A);
ColorMuteOn = TColor($4040D0); // красный: дорожка выключена
@ -737,6 +751,10 @@ begin
if AClip.Kind in [ckVideo, ckImage] then
DrawCropButton(ACanvas, Body);
{ Затухания идут до громкости и подписей: срезанный угол не должен
затирать ни линию громкости, ни название. }
DrawFades(ACanvas, AClip, Body);
{ Громкость рисуется до подписей: иначе её линия перечёркивает название
и длительность. }
DrawVolume(ACanvas, AClip, ATop, Body);
@ -819,6 +837,138 @@ begin
end;
end;
function TTimelineControl.FadeHandleRect(AClip: TClip; ATop: Integer;
AIn: Boolean): TRect;
const
Size = 9;
var
L, R, X: Integer;
Body: TRect;
FadeLen: Double;
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 R - L < Size * 4 then
Exit;
Body := Rect(L, ATop + 3, R, ATop + FTrackHeight - 3);
if AIn then
begin
FadeLen := AClip.FadeIn;
X := TimeToX(AClip.TlStart + FadeLen);
end
else
begin
FadeLen := AClip.FadeOut;
X := TimeToX(AClip.TlEnd - FadeLen);
end;
{ Ручка ненулевого затухания стоит на его конце, нулевого — в самом
углу: иначе её негде было бы взять в первый раз. }
Result := Rect(X - Size div 2, Body.Top, X + Size div 2, Body.Top + Size);
if Result.Left < FHeaderWidth then
Exit(Rect(0, 0, 0, 0));
if Result.Right > ClientWidth then
Exit(Rect(0, 0, 0, 0));
end;
procedure TTimelineControl.DrawFades(ACanvas: TCanvas; AClip: TClip;
const ABody: TRect);
var
X: Integer;
H: TRect;
procedure Corner(AX: Integer; AIn: Boolean);
begin
{ Срезанный угол: от угла клипа к концу затухания по верхней грани.
Закрашиваем сам срез, чтобы было видно, сколько взято. }
ACanvas.Brush.Color := ColorFadeFill;
ACanvas.Brush.Style := bsSolid;
ACanvas.Pen.Color := ColorFadeLine;
if AIn then
ACanvas.Polygon([Point(ABody.Left, ABody.Bottom), Point(ABody.Left, ABody.Top),
Point(AX, ABody.Top)])
else
ACanvas.Polygon([Point(ABody.Right, ABody.Bottom), Point(ABody.Right, ABody.Top),
Point(AX, ABody.Top)]);
end;
begin
if (AClip = nil) or (AClip.Kind = ckBlack) then
Exit;
if ABody.Right - ABody.Left < 8 then
Exit;
if AClip.FadeIn > 0.0005 then
begin
X := TimeToX(AClip.TlStart + AClip.FadeIn);
if X > ABody.Left then
Corner(Min(X, ABody.Right), True);
end;
if AClip.FadeOut > 0.0005 then
begin
X := TimeToX(AClip.TlEnd - AClip.FadeOut);
if X < ABody.Right then
Corner(Max(X, ABody.Left), False);
end;
{ Ручки рисуются всегда, даже при нулевом затухании: иначе непонятно,
за что тянуть. }
ACanvas.Brush.Style := bsSolid;
ACanvas.Pen.Color := ColorFadeLine;
H := FadeHandleRect(AClip, ABody.Top - 3, True);
if H.Right > H.Left then
begin
ACanvas.Brush.Color := ColorFadeLine;
ACanvas.Rectangle(H);
end;
H := FadeHandleRect(AClip, ABody.Top - 3, False);
if H.Right > H.Left then
begin
ACanvas.Brush.Color := ColorFadeLine;
ACanvas.Rectangle(H);
end;
end;
procedure TTimelineControl.DrawOverlaps(ACanvas: TCanvas; ATrack: TTrack;
ATop: Integer);
var
I, L, R: Integer;
A, B: TClip;
begin
if (ATrack = nil) or (ATrack.Count < 2) then
Exit;
ACanvas.Pen.Color := ColorOverlap;
ACanvas.Brush.Style := bsClear;
for I := 0 to ATrack.Count - 2 do
begin
A := ATrack[I];
B := ATrack[I + 1];
if B.TlStart >= A.TlEnd - 0.0005 then
Continue;
L := TimeToX(B.TlStart);
R := TimeToX(A.TlEnd);
if (R < FHeaderWidth) or (L > ClientWidth) or (R - L < 3) then
Continue;
if L < FHeaderWidth then
L := FHeaderWidth;
if R > ClientWidth then
R := ClientWidth;
{ Косой крест по всей высоте: так переход обозначают везде, и его
ширина сразу видна. }
ACanvas.Line(L, ATop + 3, R, ATop + FTrackHeight - 3);
ACanvas.Line(L, ATop + FTrackHeight - 3, R, ATop + 3);
end;
end;
function TTimelineControl.CropButtonRect(const ABody: TRect): TRect;
const
Size = 16;
@ -970,6 +1120,9 @@ begin
Track := FProject.Tracks[T];
for C := 0 to Track.Count - 1 do
DrawClip(ACanvas, Track[C], RowTop);
{ Перекрытия рисуются поверх клипов: крест должен быть виден на обоих
сразу, иначе непонятно, какие именно куски переходят друг в друга. }
DrawOverlaps(ACanvas, Track, RowTop);
end;
end;
@ -1290,6 +1443,7 @@ var
Part: THeaderPart;
VolHandle: TRect;
CropRect: TRect;
FadeHandle: TRect;
begin
inherited MouseDown(Button, Shift, X, Y);
SetFocus;
@ -1393,6 +1547,34 @@ begin
Exit;
end;
{ Ручки затухания стоят в верхних углах, а там же начинается зона
растягивания за край. Приоритет у ручек: они мелкие, промахнуться
мимо них легче, а растянуть клип можно, взявшись за край ниже. }
FadeHandle := FadeHandleRect(Clip, TrackTop(TrackIndexAt(Y)), True);
if (FadeHandle.Right > FadeHandle.Left) and
PtInRect(FadeHandle, Point(X, Y)) then
begin
FAction := taFadeIn;
FProject.BeginChange;
FPressX := X;
FPressY := Y;
FMovedWhileDown := False;
Invalidate;
Exit;
end;
FadeHandle := FadeHandleRect(Clip, TrackTop(TrackIndexAt(Y)), False);
if (FadeHandle.Right > FadeHandle.Left) and
PtInRect(FadeHandle, Point(X, Y)) then
begin
FAction := taFadeOut;
FProject.BeginChange;
FPressX := X;
FPressY := Y;
FMovedWhileDown := False;
Invalidate;
Exit;
end;
VolHandle := VolumeHandleRect(Clip, TrackTop(TrackIndexAt(Y)));
Edge := EdgeAtPoint(X, Clip);
@ -1504,6 +1686,26 @@ begin
end;
end;
taFadeIn:
if FDragClip <> nil then
begin
{ Длина появления — от начала клипа до указателя. Длиннее самого
клипа быть не может: тогда он не успел бы появиться. }
FDragClip.FadeIn := Max(0, Min(FDragClip.Duration,
XToTime(X) - FDragClip.TlStart));
FMovedWhileDown := True;
Invalidate;
end;
taFadeOut:
if FDragClip <> nil then
begin
FDragClip.FadeOut := Max(0, Min(FDragClip.Duration,
FDragClip.TlEnd - XToTime(X)));
FMovedWhileDown := True;
Invalidate;
end;
taDragClip:
if FDragClip <> nil then
begin
@ -1733,7 +1935,8 @@ var
Clip: TClip;
begin
inherited MouseUp(Button, Shift, X, Y);
WasEditing := FAction in [taDragClip, taTrimIn, taTrimOut, taVolume];
WasEditing := FAction in [taDragClip, taTrimIn, taTrimOut, taVolume,
taFadeIn, taFadeOut];
WasTrimIn := FAction = taTrimIn;
WasClipPress := FAction = taDragClip;
Clip := FDragClip;

4
tests/nlvetool.lpr
View file

@ -311,7 +311,7 @@ begin
{ Проверка вырезания и склейки картинки: звук здесь не собирается. }
Thread := TExportThread.Create(Segments, nil, ParamStr(FirstArg - 1), True,
Default(TMediaInfo));
Default(TMediaInfo), Default(TEncodeProfile));
Watcher := TExportWatcher.Create(Thread);
try
Thread.OnProgress := @Watcher.Progress;
@ -1013,7 +1013,7 @@ begin
end;
Thread := TExportThread.Create(Segs, AudioSegs,
ExpandFileName(ParamStr(3)), True, Proj.Master);
ExpandFileName(ParamStr(3)), True, Proj.Master, Default(TEncodeProfile));
Watcher := TExportWatcher.Create(Thread);
try
Thread.OnProgress := @Watcher.Progress;

BIN
ролик.mkv Normal file
View file

Binary file not shown.