From e12d0df974deed119ceca5b217fb32850399af14 Mon Sep 17 00:00:00 2001 From: 4aiman Date: Sat, 22 Aug 2026 12:37:35 +0300 Subject: [PATCH] =?UTF-8?q?=D0=9D=D0=B0=D0=BF=D0=BE=D0=BC=D0=B8=D0=BD?= =?UTF-8?q?=D0=B0=D0=BD=D0=B8=D0=B5=20=D0=BE=20=D0=B7=D0=B0=D0=B2=D0=B8?= =?UTF-8?q?=D1=81=D0=B8=D0=BC=D0=BE=D1=81=D1=82=D1=8F=D1=85=20=D0=B8=20?= =?UTF-8?q?=D0=BF=D0=BE=D1=87=D0=B8=D0=BD=D0=BA=D0=B0=20=D0=BF=D0=B0=D0=B4?= =?UTF-8?q?=D0=B5=D0=BD=D0=B8=D1=8F=20=D0=BF=D0=BE=D0=B4=20Wine?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Падение. Окно зависимостей роняло программу под Wine: «stack overflow», шестнадцать мегабайт стека съедались целиком. Причина — качели между таблицей и своими полосами прокрутки: появление вертикальной полосы сужает таблицу, от этого перестаёт помещаться содержимое по ширине, появляется горизонтальная, от неё убавляется высота — и решение о вертикальной принимается заново. В комментарии стояло обещание, что второго круга не будет; под Wine круг не сходился никогда. Теперь глубина пересчёта ограничена тремя кругами. Лишняя полоса прокрутки не беда, падение — беда. Искалось на невидимом экране в отдельном префиксе Wine: программа сама писала след по шагам, и он показал, что окно создаётся целиком, а падает на показе. Дальше отключением по одному проверены обработчики перерисовки рамки, подновление полосы меню по таймеру и значок окна — ни при чём. Напоминание. Если не хватает ffmpeg или libmpv, при запуске появляется окно: чего именно нет, и три кнопки — открыть окно зависимостей, отложить, больше не напоминать. Последнее запоминается в настройках. Для этого появился ThemedChoiceDlg: диалог со своими кнопками, готовых «Да / Нет / Отмена» тут не хватало. Высота надписи в обоих диалогах считалась по общей ширине текста и не видела переводов строк — сообщение обрезалось снизу. Теперь каждая строка считается отдельно. --- .gitignore | 2 + src/uMainForm.pas | 55 ++++++++++++++- src/uSettings.pas | 7 ++ src/uTheme.pas | 161 ++++++++++++++++++++++++++++++++++++++---- src/uThemedScroll.pas | 28 ++++++-- 5 files changed, 236 insertions(+), 17 deletions(-) diff --git a/.gitignore b/.gitignore index 5cf5375..cd5a3f0 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,7 @@ # Результаты сборки /lib/ +# Обёртка для macOS: её создаёт lazbuild при сборке под darwin. +/nlve.app/ /nlve /nlve.exe /nlve.dbg diff --git a/src/uMainForm.pas b/src/uMainForm.pas index 376b358..ee219dd 100644 --- a/src/uMainForm.pas +++ b/src/uMainForm.pas @@ -72,7 +72,7 @@ type procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormShow(Sender: TObject); {$IFDEF LCLWIN32} - { Остаток полосы меню закрашивается после того, как систему нарисовала + { Остаток полосы меню закрашивается после того, как система нарисовала рамку окна. Раньше — бесполезно: она закрасит поверх. } procedure WMNCPaint(var Msg: TLMessage); message MsgNcPaint; procedure WMNCActivate(var Msg: TLMessage); message MsgNcActivate; @@ -218,6 +218,9 @@ type procedure ApplyLogVisible(AVisible: Boolean); procedure BuildTimeline; procedure StartPlayer; + { Чего не хватает для работы. Пустая строка — всё на месте. } + function MissingDeps: string; + procedure RemindAboutDeps; procedure Log(const AText: string); procedure LogToFile(const AText: string); procedure SetStatus(const AText: string); @@ -946,6 +949,7 @@ begin {$ENDIF} StartPlayer; + RemindAboutDeps; { Файлы из командной строки попадают в список проекта. Так на программу можно перетащить файлы из файлового менеджера. @@ -987,6 +991,55 @@ begin end; end; +{ Проверка не по одному месту, а разом: человеку нужен ответ «чего не + хватает», а не «на чём именно споткнулись первым». } +function TMainForm.MissingDeps: string; +var + Err: string; +begin + Result := ''; + if not MpvLibLoaded then + Result := 'libmpv — без неё нет предпросмотра'; + if not ToolsAvailable(Err) then + begin + if Result <> '' then + Result := Result + LineEnding; + Result := Result + 'ffmpeg — без него не собрать ролик'; + end; +end; + +{ Напоминание при запуске. + + Программа без ffmpeg и libmpv открывается и даже даёт разложить клипы, + но ничего не покажет и ничего не соберёт. Молча об этом сообщать в + журнал мало: журнал можно и спрятать. + + Три кнопки: открыть окно зависимостей, отложить, больше не напоминать. + Последняя запоминается в настройках. } +procedure TMainForm.RemindAboutDeps; +var + Missing: string; + Choice: Integer; +begin + if not FSettings.DepsReminder then + Exit; + Missing := MissingDeps; + if Missing = '' then + Exit; + + Choice := ThemedChoiceDlg('nlve', + 'Не хватает того, на чём программа работает:' + LineEnding + + LineEnding + Missing + LineEnding + LineEnding + + 'Окно «Зависимости» умеет скачать недостающее с официальных сайтов.' + + LineEnding + 'Открыть его сейчас?', + ['Открыть', 'Потом', 'Не напоминать']); + + case Choice of + 0: MenuDeps(nil); + 2: FSettings.DepsReminder := False; + end; +end; + procedure TMainForm.StartPlayer; var Err: string; diff --git a/src/uSettings.pas b/src/uSettings.pas index 4076aa6..505ca92 100644 --- a/src/uSettings.pas +++ b/src/uSettings.pas @@ -36,6 +36,7 @@ type FWaveGain: Double; FVideoPanelHeight: Integer; FLogVisible: Boolean; + FDepsReminder: Boolean; FRecentProjects: TStringList; function FileName: string; public @@ -66,6 +67,9 @@ type { Видна ли нижняя полоса с журналом. По умолчанию видна: пока программа молодая, её сообщения нужнее, чем лишние строки монтажа. } property LogVisible: Boolean read FLogVisible write FLogVisible; + { Напоминать ли о недостающих зависимостях при запуске. Гасится + кнопкой «Не напоминать» в самом напоминании. } + property DepsReminder: Boolean read FDepsReminder write FDepsReminder; end; implementation @@ -95,6 +99,7 @@ begin FWaveGain := DefaultWaveGain; FVideoPanelHeight := DefaultVideoHeight; FLogVisible := True; + FDepsReminder := True; end; destructor TSettings.Destroy; @@ -174,6 +179,7 @@ begin FWaveGain := Obj.Get('wave_gain', FWaveGain); FVideoPanelHeight := Obj.Get('video_panel_height', FVideoPanelHeight); FLogVisible := Obj.Get('log_visible', FLogVisible); + FDepsReminder := Obj.Get('deps_reminder', FDepsReminder); Arr := Obj.Find('recent_projects', jtArray) as TJSONArray; FRecentProjects.Clear; @@ -224,6 +230,7 @@ begin Root.Add('wave_gain', FWaveGain); Root.Add('video_panel_height', FVideoPanelHeight); Root.Add('log_visible', FLogVisible); + Root.Add('deps_reminder', FDepsReminder); Arr := TJSONArray.Create; for I := 0 to FRecentProjects.Count - 1 do diff --git a/src/uTheme.pas b/src/uTheme.pas index 1b38eba..a249fd0 100644 --- a/src/uTheme.pas +++ b/src/uTheme.pas @@ -219,6 +219,14 @@ function ThemedMessageDlg(const ACaption, AText: string; ADlgType: TMsgDlgType; AButtons: TMsgDlgButtons; AHelpCtx: Longint = 0): TModalResult; +{ Вопрос со своими кнопками. Возвращает номер нажатой, считая с нуля, или + -1, если окно просто закрыли. + + Нужен там, где готовых «Да / Нет / Отмена» не хватает: например, + третьей кнопкой «Больше не напоминать». } +function ThemedChoiceDlg(const ACaption, AText: string; + const ACaptions: array of string): Integer; + implementation {$IFDEF LCLGTK2} @@ -1039,6 +1047,8 @@ end; var TailNote: string = 'закраска полосы меню не вызывалась'; + { Идёт ли закраска прямо сейчас. См. пояснение у PaintMenuBarTail. } + TailBusy: Boolean = False; function MenuBarTailNote: string; begin @@ -1047,6 +1057,16 @@ end; procedure PaintMenuBarTail(AForm: TCustomForm); {$IFDEF LCLWIN32} +{ Защита от повторного входа. + + Закраска вызывается из обработчика перерисовки рамки окна, а сама + рисует в эту рамку — и под Wine рисование снова просило перерисовку. + Получалась воронка: при появлении любого модального окна стек кончался + и программа падала с «stack overflow». Найдено на невидимом экране в + отдельном префиксе Wine: падало и из напоминания о зависимостях, и из + меню «Файл → Зависимости». } +{$ENDIF} +{$IFDEF LCLWIN32} var Info: TMenuBarInfoRec; WinRect, ItemRect, Fill: TRect; @@ -1056,6 +1076,8 @@ var {$ENDIF} begin {$IFDEF LCLWIN32} + if TailBusy then + Exit; if (AForm = nil) or (not AForm.HandleAllocated) or (MenuBrush = 0) then begin TailNote := 'полоса: нет окна или кисти'; @@ -1114,16 +1136,21 @@ begin Exit; end; - DC := SysGetWindowDC(AForm.Handle); - if DC = 0 then - begin - TailNote := TailNote + ' — окно не дало холста'; - Exit; - end; + TailBusy := True; try - SysFillRect(DC, Fill, MenuBrush); + DC := SysGetWindowDC(AForm.Handle); + if DC = 0 then + begin + TailNote := TailNote + ' — окно не дало холста'; + Exit; + end; + try + SysFillRect(DC, Fill, MenuBrush); + finally + SysReleaseDC(AForm.Handle, DC); + end; finally - SysReleaseDC(AForm.Handle, DC); + TailBusy := False; end; {$ENDIF} end; @@ -1205,6 +1232,118 @@ end; { Окно сообщения } +{ Высота надписи с переносом. + + Считать по общей ширине текста нельзя: в сообщении бывают свои переводы + строк, и оценка «ширина поделить на ширину поля» их не видит — текст + обрезается снизу. Здесь каждая строка считается отдельно, а пустые + строки дают пустой ряд. } +function WrappedTextHeight(ACanvas: TCanvas; const AText: string; + AWidth: Integer): Integer; +var + Lines: TStringList; + I, Rows, RowH: Integer; +begin + RowH := ACanvas.TextHeight('Wg'); + Rows := 0; + Lines := TStringList.Create; + try + Lines.Text := AText; + if Lines.Count = 0 then + Rows := 1; + for I := 0 to Lines.Count - 1 do + if Lines[I] = '' then + Inc(Rows) + else + Inc(Rows, 1 + (ACanvas.TextWidth(Lines[I]) div AWidth)); + finally + Lines.Free; + end; + Result := Rows * RowH + RowH div 2; +end; + +function ThemedChoiceDlg(const ACaption, AText: string; + const ACaptions: array of string): Integer; +const + MarginX = 20; + MarginY = 18; + ButtonH = 30; + ButtonGap = 10; +var + Dlg: TForm; + Lbl: TLabel; + Btn: TThemedButton; + I, X, TotalW, Wid: Integer; + Widths: array of Integer; +begin + Result := -1; + if Length(ACaptions) = 0 then + Exit; + + Dlg := TForm.CreateNew(nil); + try + Dlg.Caption := ACaption; + Dlg.BorderStyle := bsDialog; + Dlg.Position := poScreenCenter; + Dlg.Color := ThemeWindow; + Dlg.Font.Color := ThemeText; + + Lbl := TLabel.Create(Dlg); + Lbl.Parent := Dlg; + Lbl.Left := MarginX; + Lbl.Top := MarginY; + Lbl.WordWrap := True; + Lbl.AutoSize := False; + Lbl.Width := 520; + Lbl.Caption := AText; + Lbl.Font.Color := ThemeText; + Lbl.Transparent := True; + + Lbl.Height := WrappedTextHeight(Dlg.Canvas, AText, Lbl.Width); + + { Ширина у каждой кнопки своя: надписи разной длины, а одинаковая + ширина по самой длинной растянула бы «ОК» на пол-окна. } + SetLength(Widths, Length(ACaptions)); + TotalW := 0; + for I := 0 to High(ACaptions) do + begin + Wid := Dlg.Canvas.TextWidth(ACaptions[I]) + 32; + if Wid < 90 then + Wid := 90; + Widths[I] := Wid; + Inc(TotalW, Wid); + end; + Inc(TotalW, ButtonGap * High(ACaptions)); + + Dlg.ClientWidth := Lbl.Width + MarginX * 2; + if TotalW + MarginX * 2 > Dlg.ClientWidth then + Dlg.ClientWidth := TotalW + MarginX * 2; + Dlg.ClientHeight := MarginY + Lbl.Height + MarginY + ButtonH + MarginY; + + X := (Dlg.ClientWidth - TotalW) div 2; + for I := 0 to High(ACaptions) do + begin + Btn := TThemedButton.Create(Dlg); + Btn.Parent := Dlg; + Btn.SetBounds(X, Dlg.ClientHeight - MarginY - ButtonH, Widths[I], + ButtonH); + Btn.Caption := ACaptions[I]; + { Номер кнопки возвращается через ModalResult: mrNone равен нулю, + поэтому считаем с единицы и вычитаем её обратно. } + Btn.ModalResult := I + 1; + Btn.Default := I = 0; + Btn.Cancel := I = High(ACaptions); + Inc(X, Widths[I] + ButtonGap); + end; + + Result := Dlg.ShowModal - 1; + if Result > High(ACaptions) then + Result := -1; + finally + Dlg.Free; + end; +end; + function ThemedMessageDlg(const ACaption, AText: string; ADlgType: TMsgDlgType; AButtons: TMsgDlgButtons; AHelpCtx: Longint): TModalResult; @@ -1221,7 +1360,7 @@ var Order: array[0..3] of TModalResult = (mrOk, mrYes, mrNo, mrCancel); Names: array[0..3] of string = ('ОК', 'Да', 'Нет', 'Отмена'); Flags: array[0..3] of TMsgDlgBtn = (mbOK, mbYes, mbNo, mbCancel); - I, Count, X, TextW, TextH, TotalW: Integer; + I, Count, X, TotalW: Integer; begin Dlg := TForm.CreateNew(nil); try @@ -1251,9 +1390,7 @@ begin { Высоту надписи считаем по её содержимому: сообщения бывают и в одну строку, и в десять. } - TextH := Dlg.Canvas.TextHeight('Wg'); - TextW := Dlg.Canvas.TextWidth(AText); - Lbl.Height := TextH * (1 + TextW div Lbl.Width) + TextH div 2; + Lbl.Height := WrappedTextHeight(Dlg.Canvas, AText, Lbl.Width); TotalW := Count * ButtonW + (Count - 1) * ButtonGap; Dlg.ClientWidth := Lbl.Width + MarginX * 2; diff --git a/src/uThemedScroll.pas b/src/uThemedScroll.pas index a85c2af..bd49f8a 100644 --- a/src/uThemedScroll.pas +++ b/src/uThemedScroll.pas @@ -93,6 +93,8 @@ type FVBar: TThemedScrollBar; FHBar: TThemedScrollBar; FUpdating: Boolean; + { Глубина вложенности пересчёта размещения. Ограничена: см. SyncBars. } + FDepth: Integer; { Сколько места занимает всё содержимое таблицы. Считается сложением ширин столбцов и высот строк, а не свойствами GridWidth и GridHeight: с выключенными полосами прокрутки те возвращают не @@ -475,10 +477,28 @@ begin finally FUpdating := False; end; - { Пересчёт размещения сам вызовет согласование ещё раз, но уже без - расхождения — второго круга не будет. } - if NeedRelayout then - Relayout; + { Пересчёт размещения сам вызовет согласование ещё раз. + + Обещать, что второго круга не будет, нельзя, и это стоило падения: + появление вертикальной полосы сужает таблицу, от этого перестаёт + помещаться содержимое по ширине, появляется горизонтальная полоса, + от неё убавляется высота — и решение о вертикальной принимается + заново. Под Wine эти качели не сходились никогда: стек в шестнадцать + мегабайт съедался целиком, и программа падала при открытии окна + зависимостей. + + Поэтому глубина ограничена. Три круга хватает любому разумному + случаю, а на четвёртом мы просто оставляем как есть: лишняя полоса + прокрутки не беда, а падение — беда. } + if NeedRelayout and (FDepth < 3) then + begin + Inc(FDepth); + try + Relayout; + finally + Dec(FDepth); + end; + end; end; procedure TScrolledGrid.GridTopLeftChanged(Sender: TObject);