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

Напоминание о зависимостях и починка падения под Wine

Browse source 
Падение. Окно зависимостей роняло программу под Wine: «stack overflow»,
шестнадцать мегабайт стека съедались целиком. Причина — качели между
таблицей и своими полосами прокрутки: появление вертикальной полосы
сужает таблицу, от этого перестаёт помещаться содержимое по ширине,
появляется горизонтальная, от неё убавляется высота — и решение о
вертикальной принимается заново. В комментарии стояло обещание, что
второго круга не будет; под Wine круг не сходился никогда.

Теперь глубина пересчёта ограничена тремя кругами. Лишняя полоса
прокрутки не беда, падение — беда.

Искалось на невидимом экране в отдельном префиксе Wine: программа сама
писала след по шагам, и он показал, что окно создаётся целиком, а падает
на показе. Дальше отключением по одному проверены обработчики
перерисовки рамки, подновление полосы меню по таймеру и значок окна —
ни при чём.

Напоминание. Если не хватает ffmpeg или libmpv, при запуске появляется
окно: чего именно нет, и три кнопки — открыть окно зависимостей,
отложить, больше не напоминать. Последнее запоминается в настройках.
Для этого появился ThemedChoiceDlg: диалог со своими кнопками, готовых
«Да / Нет / Отмена» тут не хватало.

Высота надписи в обоих диалогах считалась по общей ширине текста и не
видела переводов строк — сообщение обрезалось снизу. Теперь каждая
строка считается отдельно.
This commit is contained in:
4aiman 2026-08-22 12:37:35 +03:00
commit e12d0df974
5 changed files with 236 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

2
.gitignore vendored
View file

@ -1,5 +1,7 @@
# Результаты сборки
/lib/
# Обёртка для macOS: её создаёт lazbuild при сборке под darwin.
/nlve.app/
/nlve
/nlve.exe
/nlve.dbg

55
src/uMainForm.pas
View file

@ -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;

7
src/uSettings.pas
View file

@ -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

161
src/uTheme.pas
View file

@ -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;

28
src/uThemedScroll.pas
View file

@ -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);