Текст на видео: модель, разметка ASS, предпросмотр и редактор
ffmpeg умеет рисовать текст, но не тем фильтром, о котором думают. drawtext в местной сборке отсутствует: с версии 7.1 ему нужен harfbuzz. Зато есть libass — и он для задачи лучше. Проверено отрисовкой: цвет, обводка, тень, шрифт по имени, размер, поля и девять положений. Девять положений — родное понятие ASS, ровно та сетка, которую просили. Чего libass не делает — не уменьшает шрифт, чтобы текст влез. Это считаем мы: сами переносим по словам и сами подбираем размер, а libass получает готовые переводы строк, чтобы нарисовать ровно то, что мы померили. Размер ищется делением отрезка пополам. Прикидка «уменьшить во столько же раз, во сколько не влезли» давала слишком мелко: после переноса строк становится меньше, и места остаётся вдоволь — на длинной надписи вместо 29 помещался 37. Замер готового блока: ровно 144 точки при разрешённых 144, то есть пятая часть кадра 720p. Текст живёт на своей дорожке, как звук: правило «верхний клип побеждает» на него не распространяется, он лежит поверх и ничего не закрывает. Предпросмотр ничего не стоит. mpv рисует внешний файл ASS поверх нашего виртуального списка кусков — правка текста видна сразу, без пересборки участка, в отличие от прозрачности. Подключение сделано в двух местах: при смене файла и при загрузке нового списка кусков, потому что тогда mpv забывает все внешние дорожки. Редактор: текст, шрифт из установленных в системе, размер, три цвета образцами, толщина обводки и тени, сетка три на три, доля высоты. Рядом сказано, во что превратится надпись, — считает тот же код, что и сборка разметки. Замер ширины подключается снаружи: точный требует холста, а холст — оконного набора. Служебная программа без экрана обходится оценкой, окно ставит точный. Из-за этого же из модели убран TColor: она не должна тянуть за собой оконную библиотеку. Сборки ролика с текстом пока нет — это следующий этап, он расписан в IMPLEMENTATION_PLAN.md.
This commit is contained in:
parent
e4a77d1a72
commit
d55b624560
10 changed files with 1251 additions and 13 deletions
|
|
@ -15,6 +15,14 @@ uses
|
|||
{$IFDEF UNIX}, BaseUnix{$ENDIF};
|
||||
|
||||
type
|
||||
{ Цвет в записи, принятой в LCL: $00BBGGRR.
|
||||
|
||||
Свой тип, а не TColor из Graphics: модель не должна тянуть за собой
|
||||
оконную библиотеку. Стоило один раз потянуть — и консольная проверка
|
||||
перестала собираться. Значения совпадают, окно приводит одно к
|
||||
другому без пересчёта. }
|
||||
TRgb = LongInt;
|
||||
|
||||
{ Чем заполнен сегмент готового ряда.
|
||||
|
||||
skVideo — кусок настоящего исходного файла, копируется без перекодирования.
|
||||
|
|
|
|||
|
|
@ -29,7 +29,7 @@ uses
|
|||
uRemuxForm, uMismatchForm,
|
||||
uFfmpegJob, uSettings, uThumbs, uTransform, uPanCropForm,
|
||||
uProjectInfoForm, ImgList, uTheme, uLogView, uDepsForm, uWaveform,
|
||||
uIconData;
|
||||
uIconData, uSubtitles, uTextMeasure, uTextForm;
|
||||
|
||||
const
|
||||
{ Номера системных сообщений о перерисовке рамки окна. Берём числами, а
|
||||
|
|
@ -171,6 +171,8 @@ type
|
|||
FSeekWaitTicks: Integer;
|
||||
|
||||
procedure ApplyVolumeAt(const ATime: Double);
|
||||
{ Переписывает файл субтитров и отдаёт его плееру. }
|
||||
procedure UpdateSubtitles;
|
||||
procedure UpdateRippleButton;
|
||||
procedure UpdateSnapButton;
|
||||
procedure RippleModeChosen(Sender: TObject);
|
||||
|
|
@ -215,6 +217,9 @@ type
|
|||
procedure LogButtonClick(Sender: TObject);
|
||||
procedure MenuToggleLog(Sender: TObject);
|
||||
procedure MenuAbout(Sender: TObject);
|
||||
procedure MenuAddText(Sender: TObject);
|
||||
{ Открывает редактор текста для клипа. True — что-то изменилось. }
|
||||
function EditTextOf(AClip: TClip): Boolean;
|
||||
procedure ApplyLogVisible(AVisible: Boolean);
|
||||
procedure BuildTimeline;
|
||||
procedure StartPlayer;
|
||||
|
|
@ -581,6 +586,10 @@ begin
|
|||
Application.HintPause := 100;
|
||||
Application.HintHidePause := 15000;
|
||||
|
||||
{ Точный замер текста ставится до первой сборки субтитров: без него
|
||||
размер подбирался бы по грубой оценке. }
|
||||
InstallTextMeasure;
|
||||
|
||||
ApplyWindowIcon;
|
||||
|
||||
BuildJobIndicator;
|
||||
|
|
@ -640,6 +649,8 @@ begin
|
|||
MProject := AddTop('Проект');
|
||||
AddItem(MProject, 'Сведения о проекте...', @MenuProjectInfo);
|
||||
AddSep(MProject);
|
||||
AddItem(MProject, 'Добавить текст', @MenuAddText, ShortCut(VK_T, [ssCtrl]));
|
||||
AddSep(MProject);
|
||||
AddItem(MProject, 'Добавить дорожку', @MenuAddTrack);
|
||||
AddItem(MProject, 'Удалить последнюю дорожку', @MenuRemoveTrack);
|
||||
|
||||
|
|
@ -757,6 +768,86 @@ begin
|
|||
ApplyLogVisible(not memoLog.Visible);
|
||||
end;
|
||||
|
||||
{ Новая надпись.
|
||||
|
||||
Кладётся на текстовую дорожку в место курсора. Дорожки нет — заводится:
|
||||
просить сначала создать дорожку, а потом положить на неё текст значило
|
||||
бы заставлять человека знать наше устройство. }
|
||||
procedure TMainForm.MenuAddText(Sender: TObject);
|
||||
var
|
||||
Track: TTrack;
|
||||
Clip: TClip;
|
||||
I: Integer;
|
||||
begin
|
||||
Track := nil;
|
||||
for I := 0 to FProject.TrackCount - 1 do
|
||||
if FProject.Tracks[I].Kind = tkText then
|
||||
begin
|
||||
Track := FProject.Tracks[I];
|
||||
Break;
|
||||
end;
|
||||
|
||||
FProject.BeginChange;
|
||||
|
||||
if Track = nil then
|
||||
Track := FProject.AddTrackOfKind('Т1', tkText);
|
||||
|
||||
Clip := TClip.Create;
|
||||
Clip.Id := FProject.NewId('c');
|
||||
Clip.Kind := ckText;
|
||||
Clip.TlStart := Max(0, FTimeline.Playhead);
|
||||
{ Три секунды — столько держится короткая надпись, чтобы её успели
|
||||
прочесть. Дальше человек растянет клип как захочет. }
|
||||
Clip.Duration := 3;
|
||||
Clip.Text := 'Надпись';
|
||||
Clip.TextStyle := DefaultTextStyle;
|
||||
Track.Add(Clip);
|
||||
Track.Sort;
|
||||
|
||||
if not EditTextOf(Clip) then
|
||||
begin
|
||||
{ Передумал — клипа быть не должно, иначе на монтаже останется
|
||||
пустая надпись, которую он не заказывал. }
|
||||
Track.Remove(Clip);
|
||||
FProject.CancelChange;
|
||||
FTimeline.Invalidate;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
FProject.ClearSelection;
|
||||
Clip.Selected := True;
|
||||
TimelineStructureChange(nil);
|
||||
end;
|
||||
|
||||
function TMainForm.EditTextOf(AClip: TClip): Boolean;
|
||||
var
|
||||
{ Не Text: так называется свойство самой формы. }
|
||||
Body: string;
|
||||
Style: TTextStyle;
|
||||
W, H: Integer;
|
||||
begin
|
||||
Result := False;
|
||||
if AClip = nil then
|
||||
Exit;
|
||||
|
||||
Body := AClip.Text;
|
||||
Style := AClip.TextStyle;
|
||||
W := FProject.Master.Width;
|
||||
H := FProject.Master.Height;
|
||||
if (W < 2) or (H < 2) then
|
||||
begin
|
||||
W := 1920;
|
||||
H := 1080;
|
||||
end;
|
||||
|
||||
if not EditTextClip(Body, Style, W, H) then
|
||||
Exit;
|
||||
|
||||
AClip.Text := Body;
|
||||
AClip.TextStyle := Style;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
procedure TMainForm.MenuAbout(Sender: TObject);
|
||||
begin
|
||||
ShowAboutForm;
|
||||
|
|
@ -1731,6 +1822,10 @@ begin
|
|||
Exit;
|
||||
end;
|
||||
|
||||
{ Текст поверх картинки рисует сам плеер: ему отдаётся файл разметки,
|
||||
а не пересобранный кусок. Поэтому правка текста видна сразу. }
|
||||
UpdateSubtitles;
|
||||
|
||||
{ Участки с прозрачностью и переходами плееру не по зубам: список
|
||||
кусков накладывать не умеет. Подставляем вместо них заранее
|
||||
посчитанные файлы, а чего ещё нет — заказываем. }
|
||||
|
|
@ -2172,6 +2267,19 @@ var
|
|||
begin
|
||||
if AClip = nil then
|
||||
Exit;
|
||||
|
||||
{ У надписи кнопка на клипе открывает не кадрирование, а правку текста:
|
||||
кадрировать там нечего. }
|
||||
if AClip.Kind = ckText then
|
||||
begin
|
||||
FProject.BeginChange;
|
||||
if EditTextOf(AClip) then
|
||||
TimelineStructureChange(nil)
|
||||
else
|
||||
FProject.CancelChange;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
Item := FProject.FindMedia(AClip.MediaId);
|
||||
if Item = nil then
|
||||
Exit;
|
||||
|
|
@ -2321,6 +2429,22 @@ end;
|
|||
|
||||
Пересобирать цепочку на каждый кадр нельзя — она создаётся заново и
|
||||
звук щёлкает. Поэтому только при изменении. }
|
||||
procedure TMainForm.UpdateSubtitles;
|
||||
var
|
||||
Path: string;
|
||||
begin
|
||||
if (FProject = nil) or (FPlayer = nil) then
|
||||
Exit;
|
||||
if FProject.CacheDir = '' then
|
||||
Exit;
|
||||
|
||||
Path := IncludeTrailingPathDelimiter(FProject.CacheDir) + 'subs.ass';
|
||||
if WriteAssFile(FProject, Path) then
|
||||
FPlayer.SetSubtitleFile(Path)
|
||||
else
|
||||
FPlayer.SetSubtitleFile('');
|
||||
end;
|
||||
|
||||
procedure TMainForm.ApplyVolumeAt(const ATime: Double);
|
||||
var
|
||||
I: Integer;
|
||||
|
|
|
|||
|
|
@ -63,6 +63,7 @@ type
|
|||
{ Номера подключённых звуковых дорожек, в порядке подключения. }
|
||||
FAudioIds: array of string;
|
||||
FLastGraph: string;
|
||||
FSubtitlePath: string;
|
||||
{ Что произошло с выбором звуковой дорожки. Читается окном для
|
||||
журнала: без этого понять, откуда взялся звук, нечем. }
|
||||
FAudioTrackNote: string;
|
||||
|
|
@ -195,6 +196,11 @@ type
|
|||
{ Цепочка смешивания, отданная mpv. Нужна журналу: по ней видно, какая
|
||||
дорожка какую громкость получила на самом деле. }
|
||||
property AudioGraph: string read FLastGraph;
|
||||
{ Файл субтитров поверх картинки. Пустая строка снимает его.
|
||||
|
||||
Держится отдельно от списка кусков: текст правится чаще, чем
|
||||
монтаж, и перезагружать из-за него картинку незачем. }
|
||||
procedure SetSubtitleFile(const APath: string);
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
|
@ -899,6 +905,25 @@ begin
|
|||
mpv_set_property_string(FHandle, 'lavfi-complex', PAnsiChar(Graph));
|
||||
end;
|
||||
|
||||
{ Субтитры подключаются двумя путями, и оба нужны.
|
||||
|
||||
Здесь — когда файл поменялся, а картинка та же: снимаем прежние и
|
||||
подключаем новые, не трогая воспроизведение. При загрузке нового списка
|
||||
кусков mpv забывает все внешние дорожки, поэтому там подключение
|
||||
повторяется — см. SelectExternalAudio. }
|
||||
procedure TMpvPlayer.SetSubtitleFile(const APath: string);
|
||||
begin
|
||||
if FSubtitlePath = APath then
|
||||
Exit;
|
||||
FSubtitlePath := APath;
|
||||
if FHandle = nil then
|
||||
Exit;
|
||||
|
||||
Command(['sub-remove']);
|
||||
if APath <> '' then
|
||||
Command(['sub-add', APath, 'select']);
|
||||
end;
|
||||
|
||||
procedure TMpvPlayer.SelectExternalAudio;
|
||||
var
|
||||
Count, I, Found: Integer;
|
||||
|
|
@ -1001,7 +1026,13 @@ begin
|
|||
MPV_EVENT_LOG_MESSAGE:
|
||||
HandleLogMessage(Pmpv_event_log_message(Ev^.data));
|
||||
MPV_EVENT_FILE_LOADED:
|
||||
SelectExternalAudio;
|
||||
begin
|
||||
SelectExternalAudio;
|
||||
{ Загрузка нового списка кусков сбрасывает все внешние дорожки,
|
||||
в том числе субтитры. Подключаем заново. }
|
||||
if FSubtitlePath <> '' then
|
||||
Command(['sub-add', FSubtitlePath, 'select']);
|
||||
end;
|
||||
MPV_EVENT_SHUTDOWN:
|
||||
begin
|
||||
FPump.Enabled := False;
|
||||
|
|
|
|||
134
src/uProject.pas
134
src/uProject.pas
|
|
@ -38,7 +38,37 @@ type
|
|||
|
||||
Отдельный вид, а не признак дорожки, потому что решение принимается по
|
||||
клипу: сборка спрашивает у куска, что из него доставать. }
|
||||
TClipKind = (ckVideo, ckImage, ckBlack, ckAudio);
|
||||
TClipKind = (ckVideo, ckImage, ckBlack, ckAudio, ckText);
|
||||
|
||||
{ Положение текста в кадре: девять клеток, как на цифровой клавиатуре.
|
||||
Числа совпадают с полем Alignment в ASS — переводить не приходится. }
|
||||
TTextPlace = (
|
||||
tpBottomLeft = 1, tpBottomCenter = 2, tpBottomRight = 3,
|
||||
tpMiddleLeft = 4, tpMiddleCenter = 5, tpMiddleRight = 6,
|
||||
tpTopLeft = 7, tpTopCenter = 8, tpTopRight = 9
|
||||
);
|
||||
|
||||
{ Оформление текстового клипа.
|
||||
|
||||
Цвета хранятся как TColor, а в ASS переводятся: там свой порядок
|
||||
составляющих и своя запись прозрачности. }
|
||||
TTextStyle = record
|
||||
FontName: string;
|
||||
{ Размер в точках кадра проекта, а не экрана. Он же верхняя граница:
|
||||
если текст не влезает в отведённую полосу, размер уменьшается. }
|
||||
FontSize: Integer;
|
||||
Color: TRgb;
|
||||
OutlineColor: TRgb;
|
||||
{ Толщина обводки и смещение тени в точках. Ноль — нет вовсе. }
|
||||
Outline: Integer;
|
||||
Shadow: Integer;
|
||||
ShadowColor: TRgb;
|
||||
Place: TTextPlace;
|
||||
{ Какую долю высоты кадра тексту позволено занять. 0.2 — пятую часть. }
|
||||
MaxHeight: Double;
|
||||
Bold: Boolean;
|
||||
Italic: Boolean;
|
||||
end;
|
||||
|
||||
{ На какие дорожки действует схлопывание.
|
||||
|
||||
|
|
@ -89,6 +119,8 @@ type
|
|||
FOpacity: Double;
|
||||
FFadeIn: Double;
|
||||
FFadeOut: Double;
|
||||
FText: string;
|
||||
FTextStyle: TTextStyle;
|
||||
public
|
||||
constructor Create;
|
||||
function TlEnd: Double;
|
||||
|
|
@ -131,6 +163,10 @@ type
|
|||
удаляются вместе. По умолчанию так связаны картинка и её звук;
|
||||
Ctrl+G связывает и развязывает что угодно. }
|
||||
property GroupId: string read FGroupId write FGroupId;
|
||||
{ Текст и его оформление. Имеют смысл только у клипа вида ckText;
|
||||
у остальных лежат пустыми и в файл проекта не пишутся. }
|
||||
property Text: string read FText write FText;
|
||||
property TextStyle: TTextStyle read FTextStyle write FTextStyle;
|
||||
{ Выделение живёт только в памяти и в файл проекта не пишется. }
|
||||
property Selected: Boolean read FSelected write FSelected;
|
||||
end;
|
||||
|
|
@ -138,7 +174,7 @@ type
|
|||
{ Что живёт на дорожке. Картинка и звук разделены, потому что их можно
|
||||
двигать порознь: звук из одного места монтажа под картинкой из
|
||||
другого — обычное дело. }
|
||||
TTrackKind = (tkVideo, tkAudio);
|
||||
TTrackKind = (tkVideo, tkAudio, tkText);
|
||||
|
||||
TTrack = class
|
||||
private
|
||||
|
|
@ -188,10 +224,12 @@ type
|
|||
function GetPoolCount: Integer;
|
||||
function GetTrack(AIndex: Integer): TTrack;
|
||||
function GetTrackCount: Integer;
|
||||
function NewId(const APrefix: string): string;
|
||||
function Serialize: string;
|
||||
procedure Deserialize(const AText: string);
|
||||
public
|
||||
{ Неповторимый номер для нового клипа или дорожки. Публичный: клипы
|
||||
заводит не только сам проект — например, надпись создаёт окно. }
|
||||
function NewId(const APrefix: string): string;
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
|
||||
|
|
@ -298,6 +336,15 @@ const
|
|||
{ Сколько длится картинка, пока её не растянули. }
|
||||
DefaultImageDuration = 5.0;
|
||||
|
||||
{ Оформление текста по умолчанию: белые буквы с тёмной обводкой внизу по
|
||||
центру — то, что читается на любой картинке. }
|
||||
function DefaultTextStyle: TTextStyle;
|
||||
|
||||
{ Шрифт по умолчанию. Разный по системам: одинаковых имён у них нет. }
|
||||
const
|
||||
DefaultTextFont =
|
||||
{$IFDEF WINDOWS}'Arial'{$ELSE}'DejaVu Sans'{$ENDIF};
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
|
|
@ -332,6 +379,7 @@ begin
|
|||
FVolume := 1;
|
||||
FOpacity := 1;
|
||||
FTransform := DefaultTransform;
|
||||
FTextStyle := DefaultTextStyle;
|
||||
end;
|
||||
|
||||
function TClip.TlEnd: Double;
|
||||
|
|
@ -594,6 +642,19 @@ begin
|
|||
if AKind = tkVideo then
|
||||
begin
|
||||
Pos := FTracks.Count;
|
||||
for I := 0 to FTracks.Count - 1 do
|
||||
if TTrack(FTracks[I]).Kind in [tkAudio, tkText] then
|
||||
begin
|
||||
Pos := I;
|
||||
Break;
|
||||
end;
|
||||
FTracks.Insert(Pos, Result);
|
||||
end
|
||||
else if AKind = tkText then
|
||||
begin
|
||||
{ Текст выше звука, но ниже картинки: на монтаже он читается как
|
||||
надстройка над видеорядом, а не как ещё одна дорожка звука. }
|
||||
Pos := FTracks.Count;
|
||||
for I := 0 to FTracks.Count - 1 do
|
||||
if TTrack(FTracks[I]).Kind = tkAudio then
|
||||
begin
|
||||
|
|
@ -1053,18 +1114,59 @@ begin
|
|||
Result := edSnap;
|
||||
end;
|
||||
|
||||
{ Оформление текста по умолчанию: белые буквы с тёмной обводкой внизу по
|
||||
центру — то, что читается на любой картинке. }
|
||||
function DefaultTextStyle: TTextStyle;
|
||||
begin
|
||||
Result.FontName := DefaultTextFont;
|
||||
Result.FontSize := 48;
|
||||
Result.Color := TRgb($FFFFFF);
|
||||
Result.OutlineColor := TRgb($202020);
|
||||
Result.Outline := 3;
|
||||
Result.Shadow := 2;
|
||||
Result.ShadowColor := TRgb($000000);
|
||||
Result.Place := tpBottomCenter;
|
||||
Result.MaxHeight := 0.2;
|
||||
Result.Bold := False;
|
||||
Result.Italic := False;
|
||||
end;
|
||||
|
||||
function JsonToTextStyle(AObj: TJSONObject): TTextStyle;
|
||||
begin
|
||||
Result := DefaultTextStyle;
|
||||
if AObj = nil then
|
||||
Exit;
|
||||
Result.FontName := AObj.Get('font', Result.FontName);
|
||||
Result.FontSize := AObj.Get('size', Result.FontSize);
|
||||
Result.Color := TRgb(AObj.Get('color', Integer(Result.Color)));
|
||||
Result.OutlineColor := TRgb(AObj.Get('outline_color',
|
||||
Integer(Result.OutlineColor)));
|
||||
Result.Outline := AObj.Get('outline', Result.Outline);
|
||||
Result.Shadow := AObj.Get('shadow', Result.Shadow);
|
||||
Result.ShadowColor := TRgb(AObj.Get('shadow_color',
|
||||
Integer(Result.ShadowColor)));
|
||||
Result.Place := TTextPlace(AObj.Get('place', Integer(Ord(Result.Place))));
|
||||
Result.MaxHeight := AObj.Get('max_height', Result.MaxHeight);
|
||||
Result.Bold := AObj.Get('bold', Result.Bold);
|
||||
Result.Italic := AObj.Get('italic', Result.Italic);
|
||||
end;
|
||||
|
||||
function TrackKindToStr(AKind: TTrackKind): string;
|
||||
begin
|
||||
if AKind = tkAudio then
|
||||
Result := 'audio'
|
||||
case AKind of
|
||||
tkAudio: Result := 'audio';
|
||||
tkText: Result := 'text';
|
||||
else
|
||||
Result := 'video';
|
||||
end;
|
||||
end;
|
||||
|
||||
function StrToTrackKind(const AValue: string): TTrackKind;
|
||||
begin
|
||||
if AValue = 'audio' then
|
||||
Result := tkAudio
|
||||
else if AValue = 'text' then
|
||||
Result := tkText
|
||||
else
|
||||
Result := tkVideo;
|
||||
end;
|
||||
|
|
@ -1075,6 +1177,7 @@ begin
|
|||
ckImage: Result := 'image';
|
||||
ckBlack: Result := 'black';
|
||||
ckAudio: Result := 'audio';
|
||||
ckText: Result := 'text';
|
||||
else
|
||||
Result := 'video';
|
||||
end;
|
||||
|
|
@ -1088,6 +1191,8 @@ begin
|
|||
Result := ckBlack
|
||||
else if AValue = 'audio' then
|
||||
Result := ckAudio
|
||||
else if AValue = 'text' then
|
||||
Result := ckText
|
||||
else
|
||||
Result := ckVideo;
|
||||
end;
|
||||
|
|
@ -1238,6 +1343,22 @@ begin
|
|||
'zoom', Clip.Transform.Zoom,
|
||||
'offset_x', Clip.Transform.OffsetX,
|
||||
'offset_y', Clip.Transform.OffsetY
|
||||
]),
|
||||
{ Оформление пишется только у текстовых клипов: у остальных оно
|
||||
пустое, и таскать его в файле незачем. }
|
||||
'text', Clip.Text,
|
||||
'text_style', TJSONObject.Create([
|
||||
'font', Clip.TextStyle.FontName,
|
||||
'size', Clip.TextStyle.FontSize,
|
||||
'color', Integer(Clip.TextStyle.Color),
|
||||
'outline_color', Integer(Clip.TextStyle.OutlineColor),
|
||||
'outline', Clip.TextStyle.Outline,
|
||||
'shadow', Clip.TextStyle.Shadow,
|
||||
'shadow_color', Integer(Clip.TextStyle.ShadowColor),
|
||||
'place', Integer(Ord(Clip.TextStyle.Place)),
|
||||
'max_height', Clip.TextStyle.MaxHeight,
|
||||
'bold', Clip.TextStyle.Bold,
|
||||
'italic', Clip.TextStyle.Italic
|
||||
])
|
||||
]));
|
||||
end;
|
||||
|
|
@ -1353,6 +1474,9 @@ begin
|
|||
if Media <> nil then
|
||||
Clip.Transform := Media.Transform;
|
||||
end;
|
||||
Clip.Text := ClipObj.Get('text', '');
|
||||
Clip.TextStyle := JsonToTextStyle(
|
||||
ClipObj.Get('text_style', TJSONObject(nil)));
|
||||
Track.Add(Clip);
|
||||
end;
|
||||
Track.Sort;
|
||||
|
|
|
|||
444
src/uSubtitles.pas
Normal file
444
src/uSubtitles.pas
Normal file
|
|
@ -0,0 +1,444 @@
|
|||
{
|
||||
uSubtitles — текст поверх картинки.
|
||||
|
||||
Рисует не эта программа, а libass: он есть и внутри mpv, и внутри
|
||||
ffmpeg, поэтому предпросмотр и готовый ролик показывают одно и то же.
|
||||
Наше дело — собрать для него файл ASS.
|
||||
|
||||
Почему переносы считаем сами. libass умеет переносить, но тогда
|
||||
неизвестно, сколько выйдет строк, и подобрать размер под отведённую
|
||||
полосу нечем. Поэтому меряем и переносим здесь, а в файл отдаём готовые
|
||||
переводы строк: что померили, то и нарисуется.
|
||||
|
||||
Чем меряем. Тем же шрифтом, что уйдёт в libass, через холст LCL — за
|
||||
обоими стоит FreeType, и ширины сходятся. Небольшой запас всё равно
|
||||
берём: настройки сглаживания у них разные.
|
||||
|
||||
Замер, на котором держится подбор размера (DejaVu Sans, кадр 1280x720):
|
||||
шаг строк почти равен размеру шрифта, высота блока из N строк ≈
|
||||
размер × (N − 0.16). В полосу 20% высоты влезает три строки размером до
|
||||
50, четыре до 37, пять до 30.
|
||||
}
|
||||
unit uSubtitles;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, uAppTypes, uProject;
|
||||
|
||||
type
|
||||
{ Как померить ширину строки. Возвращает ширину в точках кадра. }
|
||||
TTextMeasure = function(const AText: string; const AStyle: TTextStyle;
|
||||
ASize: Integer): Integer;
|
||||
|
||||
var
|
||||
{ Замерщик ширины текста.
|
||||
|
||||
Подключается снаружи: точный замер требует холста, а холст —
|
||||
работающего оконного набора. Служебной программе без экрана он
|
||||
недоступен, и она обходится оценкой (см. EstimateWidth) — для
|
||||
проверки самого файла ASS этого хватает.
|
||||
|
||||
Окно ставит сюда замер тем же шрифтом, каким libass будет рисовать. }
|
||||
TextMeasure: TTextMeasure = nil;
|
||||
|
||||
{ Собирает ASS из всех текстовых клипов проекта.
|
||||
|
||||
Возвращает пустую строку, если текста нет вовсе — тогда и файл писать
|
||||
незачем. }
|
||||
function BuildAss(AProject: TProject): string;
|
||||
|
||||
{ Пишет ASS в файл. False — писать было нечего или не вышло. }
|
||||
function WriteAssFile(AProject: TProject; const APath: string): Boolean;
|
||||
|
||||
{ Есть ли в проекте хоть один текстовый клип. }
|
||||
function HasText(AProject: TProject): Boolean;
|
||||
|
||||
{ Подбор размера и переносов — для окна редактора: оно показывает, во что
|
||||
превратится надпись, ещё до сборки разметки. Тот же код, что и в самой
|
||||
сборке, поэтому расхождения быть не может. }
|
||||
function FitTextForPreview(const AText: string; const AStyle: TTextStyle;
|
||||
AFrameWidth, AFrameHeight: Integer; ALines: TStringList): Integer;
|
||||
|
||||
{ Занят ли текстом этот отрезок монтажа. Нужно сборке: вжигать текст
|
||||
приходится только в те куски, которые он покрывает. }
|
||||
function TextCovers(AProject: TProject; const AFrom, ATo: Double): Boolean;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Math, LazUTF8;
|
||||
|
||||
const
|
||||
{ Запас по ширине: наши мерки и мерки libass расходятся на проценты. }
|
||||
WidthSafety = 0.95;
|
||||
{ Поля от краёв кадра в долях ширины и высоты. }
|
||||
MarginShare = 0.05;
|
||||
{ Ниже этого размер не опускаем: дальше текст всё равно не прочесть,
|
||||
и лучше показать его крупным с выходом за полосу, чем нечитаемым. }
|
||||
MinFontSize = 14;
|
||||
|
||||
{ Время в записи ASS: часы:минуты:секунды.сотые. }
|
||||
function AssTime(const ASeconds: Double): string;
|
||||
var
|
||||
T: Double;
|
||||
H, M: Integer;
|
||||
S: Double;
|
||||
begin
|
||||
T := Max(0, ASeconds);
|
||||
H := Trunc(T) div 3600;
|
||||
M := (Trunc(T) mod 3600) div 60;
|
||||
S := T - H * 3600 - M * 60;
|
||||
{ Дробную часть добиваем нулём вручную: %05.2f у Паскаля дополняет
|
||||
пробелом, а ASS с пробелом внутри времени не читается. }
|
||||
Result := Format('%d:%.2d:%.2d.%.2d',
|
||||
[H, M, Trunc(S), Round(Frac(S) * 100)]);
|
||||
end;
|
||||
|
||||
{ Цвет в записи ASS: &HAABBGGRR. Порядок обратный привычному, а первым
|
||||
идёт не прозрачность, а её отсутствие — ноль значит «непрозрачно». }
|
||||
function AssColor(AColor: TRgb; ATransparent: Boolean = False): string;
|
||||
var
|
||||
Alpha: Integer;
|
||||
begin
|
||||
if ATransparent then
|
||||
Alpha := $FF
|
||||
else
|
||||
Alpha := 0;
|
||||
Result := Format('&H%.2X%.2X%.2X%.2X',
|
||||
[Alpha, (AColor shr 16) and $FF, (AColor shr 8) and $FF, AColor and $FF]);
|
||||
end;
|
||||
|
||||
{ Внутри строки ASS перевод строки записывается как \N, а фигурные скобки
|
||||
начинают команду — их надо обезвредить. }
|
||||
function AssEscape(const AText: string): string;
|
||||
begin
|
||||
Result := StringReplace(AText, '\', '\\', [rfReplaceAll]);
|
||||
Result := StringReplace(Result, '{', '(', [rfReplaceAll]);
|
||||
Result := StringReplace(Result, '}', ')', [rfReplaceAll]);
|
||||
Result := StringReplace(Result, LineEnding, '\N', [rfReplaceAll]);
|
||||
Result := StringReplace(Result, #10, '\N', [rfReplaceAll]);
|
||||
Result := StringReplace(Result, #13, '\N', [rfReplaceAll]);
|
||||
end;
|
||||
|
||||
{ Оценка ширины, когда точного замера нет.
|
||||
|
||||
Множитель взят из замера: DejaVu Sans, размер 54, строка из двадцати
|
||||
знаков кириллицы заняла 530 точек — это 0.49 размера на знак. Оценка
|
||||
грубая, но для проверки самой разметки годится, а окно всегда ставит
|
||||
точный замер. }
|
||||
function EstimateWidth(const AText: string; ASize: Integer): Integer;
|
||||
begin
|
||||
Result := Round(UTF8Length(AText) * ASize * 0.49);
|
||||
end;
|
||||
|
||||
function MeasureWidth(const AText: string; const AStyle: TTextStyle;
|
||||
ASize: Integer): Integer;
|
||||
begin
|
||||
if Assigned(TextMeasure) then
|
||||
Result := TextMeasure(AText, AStyle, ASize)
|
||||
else
|
||||
Result := EstimateWidth(AText, ASize);
|
||||
end;
|
||||
|
||||
{ Перенос по словам под заданную ширину. Возвращает число строк, сами
|
||||
строки складывает в ALines. }
|
||||
function WrapText(const AText: string; const AStyle: TTextStyle;
|
||||
ASize, AMaxWidth: Integer; ALines: TStringList): Integer;
|
||||
var
|
||||
Src: TStringList;
|
||||
I: Integer;
|
||||
Rest, Word, Line: string;
|
||||
Space: Integer;
|
||||
begin
|
||||
ALines.Clear;
|
||||
Src := TStringList.Create;
|
||||
try
|
||||
{ Свои переводы строк человек ставил не зря — они остаются. }
|
||||
Src.Text := AText;
|
||||
for I := 0 to Src.Count - 1 do
|
||||
begin
|
||||
Rest := Src[I];
|
||||
if Trim(Rest) = '' then
|
||||
begin
|
||||
ALines.Add('');
|
||||
Continue;
|
||||
end;
|
||||
|
||||
Line := '';
|
||||
while Rest <> '' do
|
||||
begin
|
||||
Space := Pos(' ', Rest);
|
||||
if Space = 0 then
|
||||
begin
|
||||
Word := Rest;
|
||||
Rest := '';
|
||||
end
|
||||
else
|
||||
begin
|
||||
Word := Copy(Rest, 1, Space - 1);
|
||||
Rest := Copy(Rest, Space + 1, Length(Rest));
|
||||
end;
|
||||
|
||||
if Line = '' then
|
||||
Line := Word
|
||||
else if MeasureWidth(Line + ' ' + Word, AStyle, ASize) <= AMaxWidth then
|
||||
Line := Line + ' ' + Word
|
||||
else
|
||||
begin
|
||||
ALines.Add(Line);
|
||||
Line := Word;
|
||||
end;
|
||||
end;
|
||||
if Line <> '' then
|
||||
ALines.Add(Line);
|
||||
end;
|
||||
finally
|
||||
Src.Free;
|
||||
end;
|
||||
Result := ALines.Count;
|
||||
end;
|
||||
|
||||
{ Подбор размера и переносов под отведённую полосу.
|
||||
|
||||
Идём от заданного размера вниз: он же и верхняя граница. Уменьшаем,
|
||||
пока блок не влезет по высоте — по ширине перенос справляется сам. }
|
||||
function FitText(const AText: string; const AStyle: TTextStyle;
|
||||
AFrameWidth, AFrameHeight: Integer; ALines: TStringList): Integer;
|
||||
var
|
||||
MaxWidth, MaxHeight, Size, BlockHeight: Integer;
|
||||
Lo, Hi, Mid, Best, Count: Integer;
|
||||
begin
|
||||
MaxWidth := Round(AFrameWidth * (1 - MarginShare * 2) * WidthSafety);
|
||||
MaxHeight := Round(AFrameHeight * AStyle.MaxHeight);
|
||||
Size := AStyle.FontSize;
|
||||
if Size < MinFontSize then
|
||||
Size := MinFontSize;
|
||||
|
||||
{ Ищем наибольший размер, при котором блок влезает, делением отрезка
|
||||
пополам.
|
||||
|
||||
Прикидка «уменьшить во столько же раз, во сколько не влезли» даёт
|
||||
слишком мелкий шрифт: после переноса строк становится меньше, и
|
||||
места остаётся вдоволь. Проверено на длинной надписи — вместо 29
|
||||
помещался 40. Десятка кругов хватает на любой разумный размер. }
|
||||
Lo := MinFontSize;
|
||||
Hi := Size;
|
||||
Best := MinFontSize;
|
||||
|
||||
while Lo <= Hi do
|
||||
begin
|
||||
Mid := (Lo + Hi) div 2;
|
||||
Count := WrapText(AText, AStyle, Mid, MaxWidth, ALines);
|
||||
if Count < 1 then
|
||||
Count := 1;
|
||||
{ Высота блока по замеру: шаг строк равен размеру, последняя строка
|
||||
занимает чуть меньше. }
|
||||
BlockHeight := Round(Mid * (Count - 0.16));
|
||||
if BlockHeight <= MaxHeight then
|
||||
begin
|
||||
Best := Mid;
|
||||
Lo := Mid + 1;
|
||||
end
|
||||
else
|
||||
Hi := Mid - 1;
|
||||
end;
|
||||
|
||||
{ Последний перенос должен соответствовать выбранному размеру: во время
|
||||
поиска он мог остаться от неподошедшей примерки. }
|
||||
WrapText(AText, AStyle, Best, MaxWidth, ALines);
|
||||
Result := Best;
|
||||
end;
|
||||
|
||||
function FitTextForPreview(const AText: string; const AStyle: TTextStyle;
|
||||
AFrameWidth, AFrameHeight: Integer; ALines: TStringList): Integer;
|
||||
begin
|
||||
Result := FitText(AText, AStyle, AFrameWidth, AFrameHeight, ALines);
|
||||
end;
|
||||
|
||||
function HasText(AProject: TProject): Boolean;
|
||||
var
|
||||
T, C: Integer;
|
||||
begin
|
||||
Result := False;
|
||||
if AProject = nil then
|
||||
Exit;
|
||||
for T := 0 to AProject.TrackCount - 1 do
|
||||
begin
|
||||
if AProject.Tracks[T].Kind <> tkText then
|
||||
Continue;
|
||||
if not AProject.TrackAudible(AProject.Tracks[T]) then
|
||||
Continue;
|
||||
for C := 0 to AProject.Tracks[T].Count - 1 do
|
||||
if Trim(AProject.Tracks[T][C].Text) <> '' then
|
||||
Exit(True);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TextCovers(AProject: TProject; const AFrom, ATo: Double): Boolean;
|
||||
var
|
||||
T, C: Integer;
|
||||
Clip: TClip;
|
||||
begin
|
||||
Result := False;
|
||||
if AProject = nil then
|
||||
Exit;
|
||||
for T := 0 to AProject.TrackCount - 1 do
|
||||
begin
|
||||
if AProject.Tracks[T].Kind <> tkText then
|
||||
Continue;
|
||||
if not AProject.TrackAudible(AProject.Tracks[T]) then
|
||||
Continue;
|
||||
for C := 0 to AProject.Tracks[T].Count - 1 do
|
||||
begin
|
||||
Clip := AProject.Tracks[T][C];
|
||||
if Trim(Clip.Text) = '' then
|
||||
Continue;
|
||||
{ Пересечение отрезков, а не попадание точки: кусок может быть
|
||||
длиннее надписи и наоборот. }
|
||||
if (Clip.TlStart < ATo - 0.0005) and (Clip.TlEnd > AFrom + 0.0005) then
|
||||
Exit(True);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function BuildAss(AProject: TProject): string;
|
||||
var
|
||||
Lines: TStringList;
|
||||
Styles, Events: TStringList;
|
||||
T, C, I, Size: Integer;
|
||||
Clip: TClip;
|
||||
Track: TTrack;
|
||||
Name, Body: string;
|
||||
W, H, MarginH, MarginV: Integer;
|
||||
begin
|
||||
Result := '';
|
||||
if (AProject = nil) or (not HasText(AProject)) then
|
||||
Exit;
|
||||
|
||||
W := AProject.Master.Width;
|
||||
H := AProject.Master.Height;
|
||||
if (W < 2) or (H < 2) then
|
||||
begin
|
||||
W := 1920;
|
||||
H := 1080;
|
||||
end;
|
||||
MarginH := Round(W * MarginShare);
|
||||
MarginV := Round(H * MarginShare);
|
||||
|
||||
Lines := TStringList.Create;
|
||||
Styles := TStringList.Create;
|
||||
Events := TStringList.Create;
|
||||
try
|
||||
for T := 0 to AProject.TrackCount - 1 do
|
||||
begin
|
||||
Track := AProject.Tracks[T];
|
||||
if Track.Kind <> tkText then
|
||||
Continue;
|
||||
if not AProject.TrackAudible(Track) then
|
||||
Continue;
|
||||
|
||||
for C := 0 to Track.Count - 1 do
|
||||
begin
|
||||
Clip := Track[C];
|
||||
if Trim(Clip.Text) = '' then
|
||||
Continue;
|
||||
|
||||
Size := FitText(Clip.Text, Clip.TextStyle, W, H, Lines);
|
||||
|
||||
{ У каждого клипа своё оформление, поэтому и свой стиль. Имя
|
||||
выводим из номера дорожки и клипа — оно должно быть
|
||||
неповторимым и не содержать запятых. }
|
||||
Name := Format('s%d_%d', [T, C]);
|
||||
Styles.Add(Format(
|
||||
'Style: %s,%s,%d,%s,%s,%s,%s,%d,%d,0,0,100,100,0,0,1,%d,%d,%d,' +
|
||||
'%d,%d,%d,1',
|
||||
[Name, Clip.TextStyle.FontName, Size,
|
||||
AssColor(Clip.TextStyle.Color),
|
||||
AssColor(Clip.TextStyle.Color),
|
||||
AssColor(Clip.TextStyle.OutlineColor),
|
||||
AssColor(Clip.TextStyle.ShadowColor,
|
||||
Clip.TextStyle.Shadow <= 0),
|
||||
Ord(Clip.TextStyle.Bold) * -1, Ord(Clip.TextStyle.Italic) * -1,
|
||||
Clip.TextStyle.Outline, Clip.TextStyle.Shadow,
|
||||
Ord(Clip.TextStyle.Place),
|
||||
MarginH, MarginH, MarginV]));
|
||||
|
||||
Body := '';
|
||||
for I := 0 to Lines.Count - 1 do
|
||||
begin
|
||||
if Body <> '' then
|
||||
Body := Body + '\N';
|
||||
Body := Body + AssEscape(Lines[I]);
|
||||
end;
|
||||
|
||||
Events.Add(Format('Dialogue: 0,%s,%s,%s,,0,0,0,,%s',
|
||||
[AssTime(Clip.TlStart), AssTime(Clip.TlEnd), Name, Body]));
|
||||
end;
|
||||
end;
|
||||
|
||||
if Events.Count = 0 then
|
||||
Exit;
|
||||
|
||||
Result :=
|
||||
'[Script Info]' + LineEnding +
|
||||
'ScriptType: v4.00+' + LineEnding +
|
||||
Format('PlayResX: %d', [W]) + LineEnding +
|
||||
Format('PlayResY: %d', [H]) + LineEnding +
|
||||
{ Переносы мы уже расставили, libass переносить нечего. }
|
||||
'WrapStyle: 2' + LineEnding +
|
||||
'ScaledBorderAndShadow: yes' + LineEnding +
|
||||
'YCbCr Matrix: None' + LineEnding +
|
||||
LineEnding +
|
||||
'[V4+ Styles]' + LineEnding +
|
||||
'Format: Name,Fontname,Fontsize,PrimaryColour,SecondaryColour,' +
|
||||
'OutlineColour,BackColour,Bold,Italic,Underline,StrikeOut,ScaleX,' +
|
||||
'ScaleY,Spacing,Angle,BorderStyle,Outline,Shadow,Alignment,' +
|
||||
'MarginL,MarginR,MarginV,Encoding' + LineEnding +
|
||||
Styles.Text +
|
||||
LineEnding +
|
||||
'[Events]' + LineEnding +
|
||||
'Format: Layer,Start,End,Style,Name,MarginL,MarginR,MarginV,' +
|
||||
'Effect,Text' + LineEnding +
|
||||
Events.Text;
|
||||
finally
|
||||
Events.Free;
|
||||
Styles.Free;
|
||||
Lines.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function WriteAssFile(AProject: TProject; const APath: string): Boolean;
|
||||
var
|
||||
Text: string;
|
||||
Stream: TFileStream;
|
||||
begin
|
||||
Result := False;
|
||||
Text := BuildAss(AProject);
|
||||
if Text = '' then
|
||||
begin
|
||||
{ Текста не стало — старый файл убираем, иначе плеер покажет то,
|
||||
чего на монтаже уже нет. }
|
||||
if FileExists(APath) then
|
||||
SysUtils.DeleteFile(APath);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
try
|
||||
ForceDirectories(ExtractFilePath(APath));
|
||||
Stream := TFileStream.Create(APath, fmCreate);
|
||||
try
|
||||
if Length(Text) > 0 then
|
||||
Stream.WriteBuffer(Text[1], Length(Text));
|
||||
finally
|
||||
Stream.Free;
|
||||
end;
|
||||
Result := True;
|
||||
except
|
||||
Result := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
372
src/uTextForm.pas
Normal file
372
src/uTextForm.pas
Normal file
|
|
@ -0,0 +1,372 @@
|
|||
{
|
||||
uTextForm — окно текстового клипа.
|
||||
|
||||
Всё, что можно задать надписи: сам текст, шрифт, размер, три цвета,
|
||||
толщина обводки, тень, место в кадре и доля высоты, которую тексту
|
||||
позволено занять.
|
||||
|
||||
Место выбирается сеткой три на три — это девять положений ASS, ровно
|
||||
тех, что понимает libass. Кнопки сетки хранят номер положения прямо в
|
||||
Tag: перекладывать его в отдельный список незачем.
|
||||
|
||||
Размер шрифта здесь — верхняя граница, а не приказ. Если текст не
|
||||
влезает в отведённую полосу, при сборке разметки он уменьшится; здесь
|
||||
же рядом показано, до чего именно.
|
||||
}
|
||||
unit uTextForm;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Controls, Forms, Graphics, StdCtrls, Dialogs, ExtCtrls,
|
||||
uAppTypes, uTheme, uProject;
|
||||
|
||||
{ Показывает окно. True — человек нажал «Готово», и в AText с AStyle лежит
|
||||
изменённое. }
|
||||
function EditTextClip(var AText: string; var AStyle: TTextStyle;
|
||||
AFrameWidth, AFrameHeight: Integer): Boolean;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
uSubtitles;
|
||||
|
||||
type
|
||||
TTextDialog = class(TComponent)
|
||||
public
|
||||
Form: TForm;
|
||||
Memo: TMemo;
|
||||
cbFont: TComboBox;
|
||||
edSize: TEdit;
|
||||
edOutline: TEdit;
|
||||
edShadow: TEdit;
|
||||
edHeight: TEdit;
|
||||
cbBold: TCheckBox;
|
||||
cbItalic: TCheckBox;
|
||||
BtnColor: TThemedButton;
|
||||
BtnOutlineColor: TThemedButton;
|
||||
BtnShadowColor: TThemedButton;
|
||||
Places: array[1..9] of TThemedButton;
|
||||
lblFit: TLabel;
|
||||
Style: TTextStyle;
|
||||
FrameW: Integer;
|
||||
FrameH: Integer;
|
||||
procedure PlaceClick(Sender: TObject);
|
||||
procedure ColorClick(Sender: TObject);
|
||||
procedure AnyChange(Sender: TObject);
|
||||
procedure ReadControls;
|
||||
procedure UpdateFit;
|
||||
end;
|
||||
|
||||
{ Кнопка цвета показывает сам цвет: подпись «выбрать» ничего не сообщает,
|
||||
а образец нужного цвета сообщает всё. }
|
||||
procedure PaintColorButton(ABtn: TThemedButton; AColor: TRgb);
|
||||
begin
|
||||
ABtn.Swatch := TColor(AColor);
|
||||
end;
|
||||
|
||||
procedure TTextDialog.PlaceClick(Sender: TObject);
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
Style.Place := TTextPlace((Sender as TThemedButton).Tag);
|
||||
for I := 1 to 9 do
|
||||
Places[I].Down := Places[I].Tag = Ord(Style.Place);
|
||||
UpdateFit;
|
||||
end;
|
||||
|
||||
procedure TTextDialog.ColorClick(Sender: TObject);
|
||||
var
|
||||
Dlg: TColorDialog;
|
||||
Btn: TThemedButton;
|
||||
begin
|
||||
Btn := Sender as TThemedButton;
|
||||
Dlg := TColorDialog.Create(nil);
|
||||
try
|
||||
if Btn = BtnColor then
|
||||
Dlg.Color := TColor(Style.Color)
|
||||
else if Btn = BtnOutlineColor then
|
||||
Dlg.Color := TColor(Style.OutlineColor)
|
||||
else
|
||||
Dlg.Color := TColor(Style.ShadowColor);
|
||||
|
||||
if not Dlg.Execute then
|
||||
Exit;
|
||||
|
||||
if Btn = BtnColor then
|
||||
Style.Color := TRgb(Dlg.Color)
|
||||
else if Btn = BtnOutlineColor then
|
||||
Style.OutlineColor := TRgb(Dlg.Color)
|
||||
else
|
||||
Style.ShadowColor := TRgb(Dlg.Color);
|
||||
PaintColorButton(Btn, TRgb(Dlg.Color));
|
||||
finally
|
||||
Dlg.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTextDialog.ReadControls;
|
||||
var
|
||||
V: Integer;
|
||||
D: Double;
|
||||
begin
|
||||
if cbFont.ItemIndex >= 0 then
|
||||
Style.FontName := cbFont.Items[cbFont.ItemIndex];
|
||||
|
||||
V := StrToIntDef(Trim(edSize.Text), Style.FontSize);
|
||||
if (V >= 8) and (V <= 400) then
|
||||
Style.FontSize := V;
|
||||
|
||||
V := StrToIntDef(Trim(edOutline.Text), Style.Outline);
|
||||
if (V >= 0) and (V <= 20) then
|
||||
Style.Outline := V;
|
||||
|
||||
V := StrToIntDef(Trim(edShadow.Text), Style.Shadow);
|
||||
if (V >= 0) and (V <= 20) then
|
||||
Style.Shadow := V;
|
||||
|
||||
{ Доля вводится процентами: «двадцать» понятнее, чем «ноль целых два». }
|
||||
V := StrToIntDef(Trim(edHeight.Text), Round(Style.MaxHeight * 100));
|
||||
if (V >= 5) and (V <= 100) then
|
||||
begin
|
||||
D := V / 100;
|
||||
Style.MaxHeight := D;
|
||||
end;
|
||||
|
||||
Style.Bold := cbBold.Checked;
|
||||
Style.Italic := cbItalic.Checked;
|
||||
end;
|
||||
|
||||
{ Показывает, во что превратится надпись: сколько строк и каким размером.
|
||||
Считает тот же код, что и сборка разметки, поэтому расхождения быть не
|
||||
может. }
|
||||
procedure TTextDialog.UpdateFit;
|
||||
var
|
||||
Lines: TStringList;
|
||||
Size: Integer;
|
||||
begin
|
||||
ReadControls;
|
||||
Lines := TStringList.Create;
|
||||
try
|
||||
Size := FitTextForPreview(Memo.Lines.Text, Style, FrameW, FrameH, Lines);
|
||||
if Size < Style.FontSize then
|
||||
lblFit.Caption := Format(
|
||||
'Не влезает: размер уменьшится с %d до %d, строк — %d',
|
||||
[Style.FontSize, Size, Lines.Count])
|
||||
else
|
||||
lblFit.Caption := Format('Влезает: размер %d, строк — %d',
|
||||
[Size, Lines.Count]);
|
||||
finally
|
||||
Lines.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTextDialog.AnyChange(Sender: TObject);
|
||||
begin
|
||||
UpdateFit;
|
||||
end;
|
||||
|
||||
function EditTextClip(var AText: string; var AStyle: TTextStyle;
|
||||
AFrameWidth, AFrameHeight: Integer): Boolean;
|
||||
const
|
||||
Rows: array[0..2] of Integer = (7, 4, 1);
|
||||
var
|
||||
Dlg: TTextDialog;
|
||||
BtnOk, BtnCancel: TThemedButton;
|
||||
Lbl: TLabel;
|
||||
I, R, C, Place: Integer;
|
||||
Grid: TPanel;
|
||||
begin
|
||||
Result := False;
|
||||
Dlg := TTextDialog.Create(nil);
|
||||
try
|
||||
Dlg.Style := AStyle;
|
||||
Dlg.FrameW := AFrameWidth;
|
||||
Dlg.FrameH := AFrameHeight;
|
||||
|
||||
Dlg.Form := TForm.CreateNew(nil);
|
||||
Dlg.Form.Caption := 'Текст';
|
||||
Dlg.Form.Position := poScreenCenter;
|
||||
Dlg.Form.ClientWidth := 640;
|
||||
Dlg.Form.ClientHeight := 470;
|
||||
|
||||
Lbl := TLabel.Create(Dlg.Form);
|
||||
Lbl.Parent := Dlg.Form;
|
||||
Lbl.SetBounds(12, 10, 200, 20);
|
||||
Lbl.Caption := 'Текст надписи';
|
||||
|
||||
Dlg.Memo := TMemo.Create(Dlg.Form);
|
||||
Dlg.Memo.Parent := Dlg.Form;
|
||||
Dlg.Memo.SetBounds(12, 32, 616, 100);
|
||||
Dlg.Memo.Anchors := [akTop, akLeft, akRight];
|
||||
Dlg.Memo.ScrollBars := ssAutoVertical;
|
||||
Dlg.Memo.Text := AText;
|
||||
Dlg.Memo.OnChange := @Dlg.AnyChange;
|
||||
|
||||
Lbl := TLabel.Create(Dlg.Form);
|
||||
Lbl.Parent := Dlg.Form;
|
||||
Lbl.SetBounds(12, 146, 60, 20);
|
||||
Lbl.Caption := 'Шрифт';
|
||||
|
||||
Dlg.cbFont := TComboBox.Create(Dlg.Form);
|
||||
Dlg.cbFont.Parent := Dlg.Form;
|
||||
Dlg.cbFont.SetBounds(80, 142, 260, 26);
|
||||
Dlg.cbFont.Style := csDropDownList;
|
||||
Dlg.cbFont.Items.Assign(Screen.Fonts);
|
||||
Dlg.cbFont.ItemIndex := Dlg.cbFont.Items.IndexOf(AStyle.FontName);
|
||||
if Dlg.cbFont.ItemIndex < 0 then
|
||||
Dlg.cbFont.ItemIndex := Dlg.cbFont.Items.IndexOf(DefaultTextFont);
|
||||
Dlg.cbFont.OnChange := @Dlg.AnyChange;
|
||||
|
||||
Lbl := TLabel.Create(Dlg.Form);
|
||||
Lbl.Parent := Dlg.Form;
|
||||
Lbl.SetBounds(356, 146, 60, 20);
|
||||
Lbl.Caption := 'Размер';
|
||||
|
||||
Dlg.edSize := TEdit.Create(Dlg.Form);
|
||||
Dlg.edSize.Parent := Dlg.Form;
|
||||
Dlg.edSize.SetBounds(420, 142, 60, 26);
|
||||
Dlg.edSize.Text := IntToStr(AStyle.FontSize);
|
||||
Dlg.edSize.OnChange := @Dlg.AnyChange;
|
||||
|
||||
Dlg.cbBold := TCheckBox.Create(Dlg.Form);
|
||||
Dlg.cbBold.Parent := Dlg.Form;
|
||||
Dlg.cbBold.SetBounds(492, 144, 76, 22);
|
||||
Dlg.cbBold.Caption := 'Жирный';
|
||||
Dlg.cbBold.Checked := AStyle.Bold;
|
||||
Dlg.cbBold.OnChange := @Dlg.AnyChange;
|
||||
|
||||
Dlg.cbItalic := TCheckBox.Create(Dlg.Form);
|
||||
Dlg.cbItalic.Parent := Dlg.Form;
|
||||
Dlg.cbItalic.SetBounds(568, 144, 66, 22);
|
||||
Dlg.cbItalic.Caption := 'Косой';
|
||||
Dlg.cbItalic.Checked := AStyle.Italic;
|
||||
Dlg.cbItalic.OnChange := @Dlg.AnyChange;
|
||||
|
||||
{ --- Цвета --- }
|
||||
Lbl := TLabel.Create(Dlg.Form);
|
||||
Lbl.Parent := Dlg.Form;
|
||||
Lbl.SetBounds(12, 186, 60, 20);
|
||||
Lbl.Caption := 'Цвет';
|
||||
|
||||
Dlg.BtnColor := TThemedButton.Create(Dlg.Form);
|
||||
Dlg.BtnColor.Parent := Dlg.Form;
|
||||
Dlg.BtnColor.SetBounds(80, 182, 70, 26);
|
||||
Dlg.BtnColor.OnClick := @Dlg.ColorClick;
|
||||
PaintColorButton(Dlg.BtnColor, AStyle.Color);
|
||||
|
||||
Lbl := TLabel.Create(Dlg.Form);
|
||||
Lbl.Parent := Dlg.Form;
|
||||
Lbl.SetBounds(160, 186, 70, 20);
|
||||
Lbl.Caption := 'Обводка';
|
||||
|
||||
Dlg.BtnOutlineColor := TThemedButton.Create(Dlg.Form);
|
||||
Dlg.BtnOutlineColor.Parent := Dlg.Form;
|
||||
Dlg.BtnOutlineColor.SetBounds(232, 182, 70, 26);
|
||||
Dlg.BtnOutlineColor.OnClick := @Dlg.ColorClick;
|
||||
PaintColorButton(Dlg.BtnOutlineColor, AStyle.OutlineColor);
|
||||
|
||||
Dlg.edOutline := TEdit.Create(Dlg.Form);
|
||||
Dlg.edOutline.Parent := Dlg.Form;
|
||||
Dlg.edOutline.SetBounds(310, 182, 40, 26);
|
||||
Dlg.edOutline.Text := IntToStr(AStyle.Outline);
|
||||
Dlg.edOutline.OnChange := @Dlg.AnyChange;
|
||||
|
||||
Lbl := TLabel.Create(Dlg.Form);
|
||||
Lbl.Parent := Dlg.Form;
|
||||
Lbl.SetBounds(360, 186, 50, 20);
|
||||
Lbl.Caption := 'Тень';
|
||||
|
||||
Dlg.BtnShadowColor := TThemedButton.Create(Dlg.Form);
|
||||
Dlg.BtnShadowColor.Parent := Dlg.Form;
|
||||
Dlg.BtnShadowColor.SetBounds(412, 182, 70, 26);
|
||||
Dlg.BtnShadowColor.OnClick := @Dlg.ColorClick;
|
||||
PaintColorButton(Dlg.BtnShadowColor, AStyle.ShadowColor);
|
||||
|
||||
Dlg.edShadow := TEdit.Create(Dlg.Form);
|
||||
Dlg.edShadow.Parent := Dlg.Form;
|
||||
Dlg.edShadow.SetBounds(490, 182, 40, 26);
|
||||
Dlg.edShadow.Text := IntToStr(AStyle.Shadow);
|
||||
Dlg.edShadow.OnChange := @Dlg.AnyChange;
|
||||
|
||||
{ --- Место в кадре --- }
|
||||
Lbl := TLabel.Create(Dlg.Form);
|
||||
Lbl.Parent := Dlg.Form;
|
||||
Lbl.SetBounds(12, 224, 160, 20);
|
||||
Lbl.Caption := 'Место в кадре';
|
||||
|
||||
Grid := TPanel.Create(Dlg.Form);
|
||||
Grid.Parent := Dlg.Form;
|
||||
Grid.SetBounds(12, 246, 130, 130);
|
||||
Grid.BevelOuter := bvNone;
|
||||
|
||||
for R := 0 to 2 do
|
||||
for C := 0 to 2 do
|
||||
begin
|
||||
Place := Rows[R] + C;
|
||||
Dlg.Places[Place] := TThemedButton.Create(Dlg.Form);
|
||||
Dlg.Places[Place].Parent := Grid;
|
||||
Dlg.Places[Place].SetBounds(C * 44, R * 44, 40, 40);
|
||||
Dlg.Places[Place].Tag := Place;
|
||||
Dlg.Places[Place].TabStop := False;
|
||||
Dlg.Places[Place].Down := Place = Ord(AStyle.Place);
|
||||
Dlg.Places[Place].OnClick := @Dlg.PlaceClick;
|
||||
end;
|
||||
|
||||
Lbl := TLabel.Create(Dlg.Form);
|
||||
Lbl.Parent := Dlg.Form;
|
||||
Lbl.SetBounds(160, 250, 260, 20);
|
||||
Lbl.Caption := 'Доля высоты кадра под текст, %';
|
||||
|
||||
Dlg.edHeight := TEdit.Create(Dlg.Form);
|
||||
Dlg.edHeight.Parent := Dlg.Form;
|
||||
Dlg.edHeight.SetBounds(420, 246, 60, 26);
|
||||
Dlg.edHeight.Text := IntToStr(Round(AStyle.MaxHeight * 100));
|
||||
Dlg.edHeight.OnChange := @Dlg.AnyChange;
|
||||
|
||||
Dlg.lblFit := TLabel.Create(Dlg.Form);
|
||||
Dlg.lblFit.Parent := Dlg.Form;
|
||||
Dlg.lblFit.SetBounds(160, 284, 460, 40);
|
||||
Dlg.lblFit.AutoSize := False;
|
||||
Dlg.lblFit.WordWrap := True;
|
||||
|
||||
BtnOk := TThemedButton.Create(Dlg.Form);
|
||||
BtnOk.Parent := Dlg.Form;
|
||||
BtnOk.SetBounds(420, 424, 100, 30);
|
||||
BtnOk.Anchors := [akRight, akBottom];
|
||||
BtnOk.Caption := 'Готово';
|
||||
BtnOk.ModalResult := mrOk;
|
||||
BtnOk.Default := True;
|
||||
|
||||
BtnCancel := TThemedButton.Create(Dlg.Form);
|
||||
BtnCancel.Parent := Dlg.Form;
|
||||
BtnCancel.SetBounds(528, 424, 100, 30);
|
||||
BtnCancel.Anchors := [akRight, akBottom];
|
||||
BtnCancel.Caption := 'Отмена';
|
||||
BtnCancel.ModalResult := mrCancel;
|
||||
BtnCancel.Cancel := True;
|
||||
|
||||
ApplyDarkTheme(Dlg.Form);
|
||||
{ Цвета кнопок ставятся после раскраски: она сбрасывает цвет надписи
|
||||
всем кнопкам разом. }
|
||||
PaintColorButton(Dlg.BtnColor, Dlg.Style.Color);
|
||||
PaintColorButton(Dlg.BtnOutlineColor, Dlg.Style.OutlineColor);
|
||||
PaintColorButton(Dlg.BtnShadowColor, Dlg.Style.ShadowColor);
|
||||
Dlg.UpdateFit;
|
||||
|
||||
if Dlg.Form.ShowModal <> mrOk then
|
||||
Exit;
|
||||
|
||||
Dlg.ReadControls;
|
||||
AText := TrimRight(Dlg.Memo.Lines.Text);
|
||||
AStyle := Dlg.Style;
|
||||
Result := True;
|
||||
finally
|
||||
Dlg.Form.Free;
|
||||
Dlg.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
62
src/uTextMeasure.pas
Normal file
62
src/uTextMeasure.pas
Normal file
|
|
@ -0,0 +1,62 @@
|
|||
{
|
||||
uTextMeasure — точный замер ширины текста для подбора размера.
|
||||
|
||||
Живёт отдельно от uSubtitles нарочно: там модель, а здесь холст, то есть
|
||||
оконная библиотека. Служебная программа собирает субтитры без окна и
|
||||
обходится приблизительной оценкой; окно ставит сюда точный замер.
|
||||
|
||||
Меряем тем же шрифтом и тем же движком, каким libass будет рисовать: за
|
||||
обоими стоит FreeType. Полного совпадения нет — настройки сглаживания
|
||||
разные, — поэтому в подборе размера заложен запас.
|
||||
}
|
||||
unit uTextMeasure;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
{ Ставит точный замер в uSubtitles. Вызывается один раз при запуске. }
|
||||
procedure InstallTextMeasure;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
SysUtils, Graphics, uProject, uSubtitles;
|
||||
|
||||
var
|
||||
{ Холст для замеров. Один на всё время работы: заводить растр на каждое
|
||||
слово было бы расточительно, а слов бывают тысячи. }
|
||||
Bitmap: TBitmap = nil;
|
||||
|
||||
function MeasureText(const AText: string; const AStyle: TTextStyle;
|
||||
ASize: Integer): Integer;
|
||||
begin
|
||||
if Bitmap = nil then
|
||||
begin
|
||||
Bitmap := TBitmap.Create;
|
||||
Bitmap.SetSize(4, 4);
|
||||
end;
|
||||
|
||||
Bitmap.Canvas.Font.Name := AStyle.FontName;
|
||||
{ Height, а не Size: он задаётся в точках холста, и отношение к размеру
|
||||
в кадре получается прямым. Size пересчитывался бы через разрешение
|
||||
экрана, а оно к кадру проекта отношения не имеет. }
|
||||
Bitmap.Canvas.Font.Height := ASize;
|
||||
Bitmap.Canvas.Font.Style := [];
|
||||
if AStyle.Bold then
|
||||
Bitmap.Canvas.Font.Style := Bitmap.Canvas.Font.Style + [fsBold];
|
||||
if AStyle.Italic then
|
||||
Bitmap.Canvas.Font.Style := Bitmap.Canvas.Font.Style + [fsItalic];
|
||||
|
||||
Result := Bitmap.Canvas.TextWidth(AText);
|
||||
end;
|
||||
|
||||
procedure InstallTextMeasure;
|
||||
begin
|
||||
uSubtitles.TextMeasure := @MeasureText;
|
||||
end;
|
||||
|
||||
finalization
|
||||
Bitmap.Free;
|
||||
|
||||
end.
|
||||
|
|
@ -99,6 +99,7 @@ type
|
|||
TThemedButton = class(TCustomControl)
|
||||
private
|
||||
FArrow: Boolean;
|
||||
FSwatch: TColor;
|
||||
FIcon: TThemedIcon;
|
||||
FFlat: Boolean;
|
||||
FDown: Boolean;
|
||||
|
|
@ -109,6 +110,7 @@ type
|
|||
FModalResult: TModalResult;
|
||||
procedure SetArrow(AValue: Boolean);
|
||||
procedure SetIcon(AValue: TThemedIcon);
|
||||
procedure SetSwatch(AValue: TColor);
|
||||
procedure DrawIcon(const ARect: TRect; AColor: TColor);
|
||||
procedure SetFlat(AValue: Boolean);
|
||||
procedure SetDown(AValue: Boolean);
|
||||
|
|
@ -145,6 +147,9 @@ type
|
|||
{ Значок вместо надписи. Надпись при этом не пропадает зря: её место —
|
||||
подсказка, которая всплывает по наведению. }
|
||||
property Icon: TThemedIcon read FIcon write SetIcon default tiNone;
|
||||
{ Образец цвета вместо надписи: кнопка выбора цвета должна показывать
|
||||
сам цвет, а не слово «выбрать». clNone — обычная кнопка. }
|
||||
property Swatch: TColor read FSwatch write SetSwatch default clNone;
|
||||
property Default: Boolean read FDefault write SetDefault default False;
|
||||
property Down: Boolean read FDown write SetDown default False;
|
||||
property Enabled;
|
||||
|
|
@ -380,6 +385,9 @@ begin
|
|||
ControlStyle := ControlStyle + [csHasDefaultAction, csHasCancelAction];
|
||||
TabStop := True;
|
||||
DoubleBuffered := True;
|
||||
{ Без явного значения образец был бы чёрным (ноль — это clBlack), и
|
||||
чёрные прямоугольники полезли бы на все кнопки разом. }
|
||||
FSwatch := clNone;
|
||||
with GetControlClassDefaultSize do
|
||||
SetInitialBounds(0, 0, cx, cy);
|
||||
end;
|
||||
|
|
@ -390,6 +398,14 @@ begin
|
|||
Result.cy := 28;
|
||||
end;
|
||||
|
||||
procedure TThemedButton.SetSwatch(AValue: TColor);
|
||||
begin
|
||||
if FSwatch = AValue then
|
||||
Exit;
|
||||
FSwatch := AValue;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TThemedButton.SetIcon(AValue: TThemedIcon);
|
||||
begin
|
||||
if FIcon = AValue then
|
||||
|
|
@ -560,6 +576,14 @@ begin
|
|||
Canvas.Polygon([Point(CX - 5, CY - 2), Point(CX + 5, CY - 2),
|
||||
Point(CX, CY + 4)]);
|
||||
end
|
||||
else if FSwatch <> clNone then
|
||||
begin
|
||||
{ Образец с рамкой: без неё белый цвет на светлой кнопке сливается. }
|
||||
Canvas.Brush.Color := FSwatch;
|
||||
Canvas.Brush.Style := bsSolid;
|
||||
Canvas.Pen.Color := ThemeBorder;
|
||||
Canvas.Rectangle(R.Left + 5, R.Top + 5, R.Right - 5, R.Bottom - 5);
|
||||
end
|
||||
else if FIcon <> tiNone then
|
||||
DrawIcon(R, Fore)
|
||||
else
|
||||
|
|
|
|||
|
|
@ -698,7 +698,7 @@ end;
|
|||
procedure TTimelineControl.DrawClip(ACanvas: TCanvas; AClip: TClip;
|
||||
ATop: Integer);
|
||||
var
|
||||
L, R, W: Integer;
|
||||
L, R, W, I: Integer;
|
||||
Item: TMediaItem;
|
||||
{ Не Caption и не Top: эти имена заняты свойствами TControl, и локальная
|
||||
переменная их перекроет. Компилятор ловит, но сообщение неочевидное. }
|
||||
|
|
@ -760,8 +760,9 @@ begin
|
|||
нём рисуется. }
|
||||
DrawWaveform(ACanvas, AClip, Body);
|
||||
|
||||
{ Кнопка кадрирования — только у картинки: звук кадрировать нечем. }
|
||||
if AClip.Kind in [ckVideo, ckImage] then
|
||||
{ Кнопка на клипе: у картинки — кадрирование, у надписи — правка
|
||||
текста. У звука нет ни того, ни другого. }
|
||||
if AClip.Kind in [ckVideo, ckImage, ckText] then
|
||||
DrawCropButton(ACanvas, Body);
|
||||
|
||||
{ Затухания идут до громкости и подписей: срезанный угол не должен
|
||||
|
|
@ -777,7 +778,18 @@ begin
|
|||
Item := nil;
|
||||
if FProject <> nil then
|
||||
Item := FProject.FindMedia(AClip.MediaId);
|
||||
if Item <> nil then
|
||||
if AClip.Kind = ckText then
|
||||
begin
|
||||
{ У надписи имени файла нет — показываем её саму, первой строкой:
|
||||
по ней клип и узнаётся. }
|
||||
ClipCaption := AClip.Text;
|
||||
I := Pos(#10, ClipCaption);
|
||||
if I > 0 then
|
||||
ClipCaption := Copy(ClipCaption, 1, I - 1) + '…';
|
||||
if Trim(ClipCaption) = '' then
|
||||
ClipCaption := '(пустая надпись)';
|
||||
end
|
||||
else if Item <> nil then
|
||||
ClipCaption := ExtractFileName(Item.Path)
|
||||
else
|
||||
ClipCaption := '(нет файла)';
|
||||
|
|
@ -1000,7 +1012,9 @@ var
|
|||
L, R: Integer;
|
||||
begin
|
||||
Result := Rect(0, 0, 0, 0);
|
||||
if (AClip = nil) or (not (AClip.Kind in [ckVideo, ckImage])) then
|
||||
{ У надписи та же кнопка открывает правку текста — окно решает, что
|
||||
именно показать. }
|
||||
if (AClip = nil) or (not (AClip.Kind in [ckVideo, ckImage, ckText])) then
|
||||
Exit;
|
||||
|
||||
L := TimeToX(AClip.TlStart);
|
||||
|
|
|
|||
|
|
@ -23,6 +23,9 @@
|
|||
render <проект.nlve> <выход>
|
||||
уплотить проект, создать вставки, собрать ролик
|
||||
и сверить число кадров
|
||||
subs <проект.nlve>
|
||||
собрать разметку субтитров из текстовых клипов
|
||||
и напечатать её
|
||||
preview <проект.nlve>
|
||||
собрать список кусков так же, как это делает
|
||||
предпросмотр: с готовыми наложениями вместо
|
||||
|
|
@ -44,7 +47,7 @@ uses
|
|||
{$ENDIF}
|
||||
Classes, SysUtils, DateUtils, Math, StrUtils,
|
||||
uAppTypes, uEdl, uKeyframeIndex, uFfmpegCmd, uExport, uRemuxQueue,
|
||||
uMediaProbe, uProject, uFlatten, uGenerate;
|
||||
uMediaProbe, uProject, uFlatten, uGenerate, uSubtitles;
|
||||
|
||||
procedure PrintUsage;
|
||||
begin
|
||||
|
|
@ -950,6 +953,36 @@ end;
|
|||
Отличается от сборки одним: участки с прозрачностью и переходами плеер
|
||||
показать не может, поэтому они заранее сводятся в отдельные файлы. Здесь
|
||||
видно, какие именно участки и во что превратились. }
|
||||
|
||||
{ Разметка субтитров из текстовых клипов.
|
||||
|
||||
Точного замера шрифта здесь нет — он требует холста, а холст оконного
|
||||
набора. Поэтому ширины оцениваются приблизительно; для проверки самой
|
||||
разметки этого хватает, а окно ставит точный замер. }
|
||||
procedure CmdSubs;
|
||||
var
|
||||
Proj: TProject;
|
||||
Err, Text: string;
|
||||
begin
|
||||
Proj := TProject.Create;
|
||||
try
|
||||
if not Proj.LoadFromFile(ExpandFileName(ParamStr(2)), Err) then
|
||||
begin
|
||||
WriteLn('Не удалось прочитать проект: ', Err);
|
||||
Halt(1);
|
||||
end;
|
||||
Text := BuildAss(Proj);
|
||||
if Text = '' then
|
||||
begin
|
||||
WriteLn('Текстовых клипов в проекте нет.');
|
||||
Halt(1);
|
||||
end;
|
||||
Write(Text);
|
||||
finally
|
||||
Proj.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CmdPreview;
|
||||
var
|
||||
Proj: TProject;
|
||||
|
|
@ -1172,6 +1205,8 @@ begin
|
|||
CmdBuild
|
||||
else if (Cmd = 'buildcut') and (ParamCount >= 3) then
|
||||
CmdBuildCut
|
||||
else if (Cmd = 'subs') and (ParamCount >= 2) then
|
||||
CmdSubs
|
||||
else if (Cmd = 'preview') and (ParamCount >= 2) then
|
||||
CmdPreview
|
||||
else if (Cmd = 'audio') and (ParamCount >= 2) then
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue