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

Звук больше не глохнет насовсем, меню открывается каждый раз

Browse source 
Общая громкость плеера выставлялась по громкости единственной звуковой
дорожки и обратно уже не возвращалась. Клип с выключенным звуком —
обычное дело, и стоило монтажу на миг остаться с одной такой дорожкой,
как плеер немел до конца работы: на всём монтаже, сколько бы дорожек
потом ни появилось. Теперь в ветке смешивания громкость всегда полная —
громкость каждой дорожки задана внутри цепочки. Случай «дорожек нет
вовсе» тоже снимает и цепочку, и приглушение.

Замер: одна дорожка с громкостью 0 даёт точный ноль, после возврата
дорожек звук возвращается на -11.4 dB. Раньше он не возвращался.

Список меню открывается через таймер, а не прямо из обработчика щелчка.
Пока обработчик не завершился, указатель захвачен кнопкой, и раскрытому
списку захват не достаётся. Внешне это выглядело как «меню открывается
через раз»: замерено 175 мс, не открылось, 175 мс, не открылось. Показ
по нажатию, как в настоящих полосах меню, под gtk2 не открывает список
ни разу. Теперь восемь щелчков подряд — восемь открытий по 168 мс, в том
числе во время фонового разбора звука.

Рамка фокуса больше не рисуется на кнопках, которые фокус не берут:
на пунктах меню она выглядела как испорченный пункт.

Фоновая работа видна в нижней полосе: надпись с числом файлов и своя
полоска выполнения. Разбор звука читает файл целиком, на шести
гигабайтах это больше десяти секунд, и молчать об этом нельзя.
This commit is contained in:
4aiman 2026-08-20 22:32:50 +03:00
commit 53a90f0d4e
5 changed files with 259 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

148
src/uMainForm.pas
View file

@ -91,6 +91,16 @@ type
системной полосы меню нет, и форма сама их не найдёт. }
FMenus: TFPList;
FMenuX: Integer;
{ Отложенный показ списка меню. Номер списка и точка, где его
раскрыть; таймер срабатывает один раз. }
{ Показ фоновой работы. Пока что-то считается в стороне от окна,
здесь видно, что именно и сколько осталось. }
FJobLabel: TLabel;
FJobBar: TThemedProgress;
FJobTimer: TTimer;
FMenuPending: Integer;
FMenuPendingAt: TPoint;
FMenuTimer: TTimer;
{ Уплощённый монтаж, отданный плееру. Хранится, чтобы по времени
находить звучащий кусок и брать у него громкость. }
FPreviewSegments: TFlatSegmentArray;
@ -179,6 +189,9 @@ type
{ --- окно и меню --- }
procedure BuildMenu;
procedure MenuBarClick(Sender: TObject);
procedure MenuTimerTick(Sender: TObject);
procedure BuildJobIndicator;
procedure JobTimerTick(Sender: TObject);
procedure FormShortCut(var Msg: TLMKey; var Handled: Boolean);
procedure BuildTimeline;
procedure StartPlayer;
@ -527,8 +540,14 @@ procedure TMainForm.BuildMenu;
var
MFile, MEdit, MView, MProject: TMenuItem;
begin
BuildJobIndicator;
FMenus := TFPList.Create;
FMenuX := 4;
FMenuPending := -1;
FMenuTimer := TTimer.Create(Self);
FMenuTimer.Enabled := False;
FMenuTimer.Interval := 1;
FMenuTimer.OnTimer := @MenuTimerTick;
OnShortCut := @FormShortCut;
MFile := AddTop('Файл');
@ -585,20 +604,137 @@ begin
AddItem(MProject, 'Удалить последнюю дорожку', @MenuRemoveTrack);
end;
{ Щелчок по названию в полосе меню раскрывает соответствующий список. }
{ Показ фоновой работы.
Разбор звука читает файл целиком — на шести гигабайтах это больше
десяти секунд, и всё это время программа выглядит просто задумчивой.
Молчать об этом нельзя: непонятно, идёт ли что-то вообще.
Место справа в нижней полосе отводится сразу и насовсем, а надпись с
полоской показываются только когда работа есть. Так строка состояния и
показатель не наезжают друг на друга. }
procedure TMainForm.BuildJobIndicator;
const
JobWidth = 330;
begin
FJobLabel := TLabel.Create(Self);
FJobLabel.Parent := pnlBottom;
FJobLabel.AutoSize := False;
FJobLabel.Alignment := taRightJustify;
FJobLabel.Anchors := [akTop, akRight];
FJobLabel.SetBounds(pnlBottom.ClientWidth - JobWidth - 12, 6,
JobWidth, 16);
FJobLabel.ParentColor := False;
FJobLabel.Font.Color := ThemeTextDim;
FJobLabel.Visible := False;
FJobBar := TThemedProgress.Create(Self);
FJobBar.Parent := pnlBottom;
FJobBar.Anchors := [akTop, akRight];
FJobBar.SetBounds(pnlBottom.ClientWidth - JobWidth - 12, 26, JobWidth, 6);
FJobBar.Visible := False;
{ Строка состояния ужимается, чтобы её длинные сообщения не залезали
под показатель. }
lblStatus.Width := pnlBottom.ClientWidth - lblStatus.Left - JobWidth - 24;
FJobTimer := TTimer.Create(Self);
FJobTimer.Interval := 300;
FJobTimer.OnTimer := @JobTimerTick;
FJobTimer.Enabled := True;
end;
{ Опрос по таймеру, а не уведомления из потоков: поток сообщает о готовом
файле, а не о ходе внутри файла, и на шестигигабайтном файле между
сообщениями проходят десятки секунд. Опрос показывает движение и там. }
procedure TMainForm.JobTimerTick(Sender: TObject);
var
{ Не Text: так называется свойство самой формы, а имена в Паскале
нечувствительны к регистру. }
Note: string;
Frac: Double;
Total, Done: Integer;
begin
Note := '';
Frac := 0;
if Assigned(FPeaksThread) and (not FPeaksFinished) then
begin
Total := FPeaksThread.Total;
Done := FPeaksThread.Done;
if Total > 0 then
begin
Note := Format('Разбор звука: %d из %d', [Done + 1, Total]);
Frac := Done / Total;
end;
end
else if Assigned(FThumbThread) then
begin
Total := FThumbThread.Total;
Done := FThumbThread.Done;
if (Total > 0) and (Done < Total) then
begin
Note := Format('Миниатюры: %d из %d', [Done + 1, Total]);
Frac := Done / Total;
end;
end;
if Note = '' then
begin
if FJobLabel.Visible then
begin
FJobLabel.Visible := False;
FJobBar.Visible := False;
end;
Exit;
end;
FJobLabel.Caption := Note;
FJobBar.Fraction := Frac;
if not FJobLabel.Visible then
begin
FJobLabel.Visible := True;
FJobBar.Visible := True;
end;
end;
{ Щелчок по названию в полосе меню раскрывает соответствующий список.
Сам показ откладывается на один оборот очереди сообщений.
Причина замерена. Пока идёт обработка щелчка, указатель захвачен
кнопкой, и раскрытому списку захват уже не достаётся. Внешне это
выглядело так, что меню открывается через раз: первый щелчок 175 мс,
второй не открывает вовсе, третий снова 175 мс. Попытка открывать по
нажатию, как это делают настоящие полосы меню, под gtk2 не открывает
список ни разу — захват там держится ещё крепче.
Таймер отпускает обработчик, захват снимается, и список открывается
каждый раз. }
procedure TMainForm.MenuBarClick(Sender: TObject);
var
Btn: TThemedButton;
Popup: TPopupMenu;
P: TPoint;
begin
Btn := Sender as TThemedButton;
if (Btn.Tag < 0) or (Btn.Tag >= FMenus.Count) then
Exit;
Popup := TPopupMenu(FMenus[Btn.Tag]);
FMenuPending := Btn.Tag;
FMenuPendingAt := Btn.ClientToScreen(Point(0, Btn.Height));
FMenuTimer.Enabled := False;
FMenuTimer.Enabled := True;
end;
procedure TMainForm.MenuTimerTick(Sender: TObject);
var
Popup: TPopupMenu;
begin
FMenuTimer.Enabled := False;
if (FMenuPending < 0) or (FMenuPending >= FMenus.Count) then
Exit;
Popup := TPopupMenu(FMenus[FMenuPending]);
FMenuPending := -1;
ApplyDarkMenu(Popup);
P := Btn.ClientToScreen(Point(0, Btn.Height));
Popup.PopUp(P.X, P.Y);
Popup.PopUp(FMenuPendingAt.X, FMenuPendingAt.Y);
end;
{ Сочетания клавиш ищем сами: системной полосы меню больше нет, а значит

19
src/uMpvPlayer.pas
View file

@ -805,7 +805,17 @@ begin
if FHandle = nil then
Exit;
if Length(FAudioIds) = 0 then
begin
{ Дорожек нет — снимаем и цепочку, и приглушение. Иначе они пережили
бы смену монтажа и заглушили следующий. }
SetVolume(100);
if FLastGraph <> '' then
begin
FLastGraph := '';
mpv_set_property_string(FHandle, 'lavfi-complex', '');
end;
Exit;
end;
{ Одна дорожка играется как есть: цепочка фильтров тут только мешала бы,
да и громкость для неё задаётся обычным способом. }
@ -819,6 +829,15 @@ begin
end
else
begin
{ Общая громкость возвращается на место обязательно.
Ветка выше выставляет её по громкости единственной дорожки, и ноль
там — обычное дело: клип с выключенным звуком. Раньше здесь она не
трогалась, и плеер, однажды заглушённый, оставался немым до конца
работы — на всём монтаже сразу, сколько бы дорожек потом ни
появилось. Здесь громкость каждой дорожки задана в самой цепочке,
поэтому общая всегда полная. }
SetVolume(100);
Graph := '';
for I := 0 to High(FAudioIds) do
begin

72
src/uTheme.pas
View file

@ -52,6 +52,26 @@ const
type
{ Полоска выполнения, которая рисует себя сама.
Системная берёт цвета у темы оформления и на тёмном окне остаётся
светлой — та же причина, по которой здесь своя кнопка и свои полосы
прокрутки.
Доля хранится числом от нуля до единицы, а не «позицией» и
«максимумом»: снаружи она всегда получается делением одного на
другое, и хранить обе части незачем. }
TThemedProgress = class(TGraphicControl)
private
FFraction: Double;
procedure SetFraction(const AValue: Double);
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
property Fraction: Double read FFraction write SetFraction;
end;
{ Кнопка, которая рисует себя сама.
Свойства Default, Cancel и ModalResult повторяют поведение обычной
@ -194,6 +214,53 @@ const
MenuTextRight = 16; { отступ справа: место под стрелку подменю }
MenuGap = 28; { просвет между названием и сочетанием клавиш }
{ TThemedProgress }
constructor TThemedProgress.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FFraction := 0;
Height := 6;
Width := 120;
end;
procedure TThemedProgress.SetFraction(const AValue: Double);
var
V: Double;
begin
V := AValue;
if V < 0 then
V := 0;
if V > 1 then
V := 1;
{ Перерисовываем только при заметном изменении: полоска обновляется по
таймеру, и дёргать отрисовку на каждую тысячную незачем. }
if Abs(V - FFraction) < 0.002 then
Exit;
FFraction := V;
Invalidate;
end;
procedure TThemedProgress.Paint;
var
R: TRect;
W: Integer;
begin
R := ClientRect;
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := ThemeButtonDown;
Canvas.FillRect(R);
W := Round(R.Right * FFraction);
if W > 0 then
begin
Canvas.Brush.Color := ThemeAccent;
Canvas.FillRect(Rect(0, 0, W, R.Bottom));
end;
Canvas.Brush.Style := bsClear;
Canvas.Pen.Color := ThemeBorder;
Canvas.Rectangle(R);
end;
{ TThemedButton }
constructor TThemedButton.Create(AOwner: TComponent);
@ -287,7 +354,10 @@ begin
Canvas.TextOut((R.Right - TS.cx) div 2, (R.Bottom - TS.cy) div 2, Caption);
end;
if Focused then
{ Рамка фокуса рисуется только там, где фокус вообще предусмотрен.
Кнопки полосы меню его не берут, а рамка на них появлялась и
выглядела как испорченный пункт. }
if Focused and TabStop then
begin
Canvas.Pen.Color := ThemeTextDim;
Canvas.Pen.Style := psDot;

13
src/uThumbs.pas
View file

@ -45,6 +45,7 @@ type
private
FRequests: TThumbRequests;
FCurrent: Integer;
FDone: Integer;
FOnReady: TThumbReadyEvent;
procedure SyncReady;
function CancelQuery: Boolean;
@ -53,6 +54,9 @@ type
public
constructor Create(const ARequests: TThumbRequests);
property OnReady: TThumbReadyEvent read FOnReady write FOnReady;
{ Столько же, сколько у разбора звука: очередь и сделанное. }
function Total: Integer;
property Done: Integer read FDone;
end;
{ Путь к миниатюре в кэше проекта. Имя выводится из пути к исходнику,
@ -91,11 +95,17 @@ var
begin
inherited Create(True);
FreeOnTerminate := False;
FDone := 0;
SetLength(FRequests, Length(ARequests));
for I := 0 to High(ARequests) do
FRequests[I] := ARequests[I];
end;
function TThumbThread.Total: Integer;
begin
Result := Length(FRequests);
end;
function TThumbThread.CancelQuery: Boolean;
begin
Result := Terminated;
@ -122,11 +132,13 @@ begin
Exit;
FCurrent := I;
FDone := I;
{ Уже готовая миниатюра — просто сообщаем о ней. }
if FileExists(FRequests[I].TargetPath) then
begin
Synchronize(@SyncReady);
FDone := I + 1;
Continue;
end;
@ -143,6 +155,7 @@ begin
if Res.Started and (Res.ExitCode = 0) and
FileExists(FRequests[I].TargetPath) then
Synchronize(@SyncReady);
FDone := I + 1;
end;
end;

14
src/uWaveform.pas
View file

@ -79,6 +79,7 @@ type
private
FRequests: TPeaksRequests;
FCurrent: Integer;
FDone: Integer;
FOnReady: TPeaksReadyEvent;
procedure SyncReady;
function CancelQuery: Boolean;
@ -87,6 +88,11 @@ type
public
constructor Create(const ARequests: TPeaksRequests);
property OnReady: TPeaksReadyEvent read FOnReady write FOnReady;
{ Сколько всего файлов в очереди и сколько уже разобрано. Читаются из
главного потока для показа хода работы; целое читается и пишется
одним действием, поэтому замок здесь не нужен. }
function Total: Integer;
property Done: Integer read FDone;
end;
implementation
@ -338,11 +344,17 @@ begin
{ Освобождает поток окно, а не он сам: окно обращается к нему и после
завершения, чтобы понять, надо ли начинать заново. }
FreeOnTerminate := False;
FDone := 0;
SetLength(FRequests, Length(ARequests));
for I := 0 to High(ARequests) do
FRequests[I] := ARequests[I];
end;
function TPeaksThread.Total: Integer;
begin
Result := Length(FRequests);
end;
function TPeaksThread.CancelQuery: Boolean;
begin
Result := Terminated;
@ -368,11 +380,13 @@ begin
if FileExists(FRequests[I].TargetPath) then
begin
Synchronize(@SyncReady);
FDone := I + 1;
Continue;
end;
if BuildPeaks(FRequests[I].SourcePath, FRequests[I].TargetPath,
@CancelQuery, Err) then
Synchronize(@SyncReady);
FDone := I + 1;
end;
end;