diff --git a/src/uMainForm.pas b/src/uMainForm.pas index e483f55..dd00ad4 100644 --- a/src/uMainForm.pas +++ b/src/uMainForm.pas @@ -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; { Сочетания клавиш ищем сами: системной полосы меню больше нет, а значит diff --git a/src/uMpvPlayer.pas b/src/uMpvPlayer.pas index 2169b22..d237921 100644 --- a/src/uMpvPlayer.pas +++ b/src/uMpvPlayer.pas @@ -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 diff --git a/src/uTheme.pas b/src/uTheme.pas index 562d943..f00c857 100644 --- a/src/uTheme.pas +++ b/src/uTheme.pas @@ -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; diff --git a/src/uThumbs.pas b/src/uThumbs.pas index c9a7e00..198cc9f 100644 --- a/src/uThumbs.pas +++ b/src/uThumbs.pas @@ -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; diff --git a/src/uWaveform.pas b/src/uWaveform.pas index 9977f87..154eda7 100644 --- a/src/uWaveform.pas +++ b/src/uWaveform.pas @@ -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;