From f7fc7a050347e848e713f10c15661b54d2b2786d Mon Sep 17 00:00:00 2001 From: chaiman Date: Wed, 19 Aug 2026 19:16:50 +0300 Subject: [PATCH] =?UTF-8?q?=D0=A1=D0=B2=D0=BE=D0=B8=20=D0=BF=D0=BE=D0=BB?= =?UTF-8?q?=D0=BE=D1=81=D1=8B=20=D0=BF=D1=80=D0=BE=D0=BA=D1=80=D1=83=D1=82?= =?UTF-8?q?=D0=BA=D0=B8=20=D1=83=20=D1=82=D0=B0=D0=B1=D0=BB=D0=B8=D1=86=20?= =?UTF-8?q?=D0=B8=20=D1=82=D1=80=D0=B8=20=D0=B8=D1=81=D0=BF=D1=80=D0=B0?= =?UTF-8?q?=D0=B2=D0=BB=D0=B5=D0=BD=D0=B8=D1=8F=20=D0=BA=20=D0=BD=D0=B8?= =?UTF-8?q?=D0=BC?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Полосы прокрутки рисует система, и цвет им задать нечем. Единственный способ получить их в своих цветах — не пользоваться системными вовсе. Таблица при этом остаётся обычной: у неё выключаются свои полосы, а прокрутка задаётся свойствами TopRow и LeftCol. По дороге найдены и исправлены три ошибки, две из них — от раскраски окон: - контекстное меню библиотеки перестало открываться: раскраска принудительно создавала системный дескриптор всплывающего меню задолго до показа. Теперь дескриптор только читается; - окно кадрирования падало при открытии: смена режима отрисовки выпадающего списка вызывает его обработчик изменения, а тот обращался к таймеру, который создавался ниже по коду; - полосы не появлялись вовсе: размер содержимого таблицы брался из GridWidth и GridHeight, а с выключенными полосами те возвращают не полный размер. Теперь считается сложением ширин столбцов и высот строк. Многострочные поля в сведениях о проекте и в перепаковке заменены своим журналом: у них оставались системные полосы. Заодно ответ ffprobe стало можно выделить и скопировать. Удалён неиспользуемый uScrollAid: горизонтальная прокрутка колесом теперь внутри журнала и одинакова на обеих системах. Список юнитов в файле проекта приведён в соответствие с тем, что лежит на диске. --- src/uLogView.pas | 21 +++++++++++++ src/uPanCropForm.pas | 19 +++++++++--- src/uProjectInfoForm.lfm | 7 ++--- src/uProjectInfoForm.pas | 14 ++++----- src/uRemuxForm.lfm | 5 +--- src/uRemuxForm.pas | 9 ++---- src/uTheme.pas | 10 ++++--- src/uThemedScroll.pas | 65 ++++++++++++++++++++++++++++++++++------ 8 files changed, 111 insertions(+), 39 deletions(-) diff --git a/src/uLogView.pas b/src/uLogView.pas index dc1734e..f6ca8df 100644 --- a/src/uLogView.pas +++ b/src/uLogView.pas @@ -90,10 +90,14 @@ type procedure Add(const AText: string); procedure AddLine(const AText: string); procedure Clear; + { Заменить всё содержимое разом. Так пользовались многострочным полем + через свойство Text. } + procedure SetText(const AText: string); function SelectedText: string; procedure SelectAll; procedure CopyToClipboard; procedure ScrollToBottom; + procedure ScrollToTop; property Lines: TStringList read FLines; published @@ -388,6 +392,15 @@ begin Invalidate; end; +procedure TLogView.SetText(const AText: string); +begin + Clear; + Add(AText); + { Заменённый разом текст читают с начала, а не с конца: это не журнал + событий, а ответ на вопрос. } + ScrollToTop; +end; + procedure TLogView.Clear; begin FLines.Clear; @@ -399,6 +412,14 @@ begin Invalidate; end; +procedure TLogView.ScrollToTop; +begin + FTopLine := 0; + FLeftPx := 0; + FFollowTail := False; + Invalidate; +end; + procedure TLogView.ScrollToBottom; begin FTopLine := MaxTopLine; diff --git a/src/uPanCropForm.pas b/src/uPanCropForm.pas index 7c08b27..edb2148 100644 --- a/src/uPanCropForm.pas +++ b/src/uPanCropForm.pas @@ -101,6 +101,18 @@ const procedure TPanCropForm.FormCreate(Sender: TObject); begin + { Таймер создаётся первым делом. Всё, что настраивается ниже, способно + вызвать обработчик изменения элемента, а тот обращается к таймеру: без + него получаем «Access violation» ещё до появления окна. + + Раньше это не проявлялось: раскраска переводит выпадающий список в + режим собственной отрисовки, а смена режима заново создаёт элемент и + сообщает об изменении. } + FRefreshTimer := TTimer.Create(Self); + FRefreshTimer.Enabled := False; + FRefreshTimer.Interval := RefreshDelayMs; + FRefreshTimer.OnTimer := @RefreshPreview; + { Цвета задаём сами: системная тема может быть светлой, и тогда тёмный таймлайн оказался бы в белой рамке. } ApplyDarkTheme(Self); @@ -128,10 +140,6 @@ begin tbOffsetY.Min := -OffsetRange; tbOffsetY.Max := OffsetRange; - FRefreshTimer := TTimer.Create(Self); - FRefreshTimer.Enabled := False; - FRefreshTimer.Interval := RefreshDelayMs; - FRefreshTimer.OnTimer := @RefreshPreview; end; procedure TPanCropForm.FormDestroy(Sender: TObject); @@ -238,6 +246,9 @@ end; procedure TPanCropForm.ScheduleRefresh; begin + { Вызов может прийти во время сборки окна, когда таймера ещё нет. } + if FRefreshTimer = nil then + Exit; FRefreshTimer.Enabled := False; FRefreshTimer.Enabled := True; end; diff --git a/src/uProjectInfoForm.lfm b/src/uProjectInfoForm.lfm index f314d10..0427199 100644 --- a/src/uProjectInfoForm.lfm +++ b/src/uProjectInfoForm.lfm @@ -43,7 +43,7 @@ object ProjectInfoForm: TProjectInfoForm RowCount = 1 TabOrder = 1 end - object memoRaw: TMemo + object memoRaw: TLogView Left = 0 Height = 220 Top = 370 @@ -52,10 +52,7 @@ object ProjectInfoForm: TProjectInfoForm Font.Height = -11 Font.Name = 'Monospace' ParentFont = False - ReadOnly = True - ScrollBars = ssAutoBoth TabOrder = 2 - WordWrap = False end object pnlBottom: TPanel Left = 0 @@ -71,7 +68,7 @@ object ProjectInfoForm: TProjectInfoForm Left = 12 Height = 30 Top = 8 - Width = 300 + Width = 360 Caption = 'Полный ответ ffprobe для выбранного файла' OnClick = btnRawClick TabOrder = 0 diff --git a/src/uProjectInfoForm.pas b/src/uProjectInfoForm.pas index beab4c9..1fc4cbe 100644 --- a/src/uProjectInfoForm.pas +++ b/src/uProjectInfoForm.pas @@ -16,7 +16,7 @@ interface uses Classes, SysUtils, Forms, Controls, Graphics, StdCtrls, Grids, ExtCtrls, - ComCtrls, uProject, uMediaProbe, uTheme, uThemedScroll; + ComCtrls, uProject, uMediaProbe, uTheme, uThemedScroll, uLogView; type @@ -27,7 +27,7 @@ type btnRaw: TThemedButton; grid: TStringGrid; lblMaster: TLabel; - memoRaw: TMemo; + memoRaw: TLogView; pnlBottom: TPanel; pnlTop: TPanel; procedure btnCloseClick(Sender: TObject); @@ -182,12 +182,12 @@ begin Row := grid.Row - 1; if (FProject = nil) or (Row < 0) or (Row >= FProject.PoolCount) then begin - memoRaw.Text := 'Выберите файл в таблице.'; + memoRaw.SetText('Выберите файл в таблице.'); Exit; end; Item := FProject.Pool[Row]; - memoRaw.Text := 'Спрашиваю ffprobe...'; + memoRaw.SetText('Спрашиваю ffprobe...'); Application.ProcessMessages; Collector := TRawCollector.Create; @@ -195,11 +195,11 @@ begin Res := RunProcess(FfprobeExe, ArgsProbeJson(Item.EffectivePath), @Collector.Line, nil, nil); if not Res.Started then - memoRaw.Text := Res.ErrorText + memoRaw.SetText(Res.ErrorText) else if Res.ExitCode <> 0 then - memoRaw.Text := 'ffprobe завершился с кодом ' + IntToStr(Res.ExitCode) + memoRaw.SetText('ffprobe завершился с кодом ' + IntToStr(Res.ExitCode)) else - memoRaw.Text := Collector.Text; + memoRaw.SetText(Collector.Text); finally Collector.Free; end; diff --git a/src/uRemuxForm.lfm b/src/uRemuxForm.lfm index 2c2203d..189fbf2 100644 --- a/src/uRemuxForm.lfm +++ b/src/uRemuxForm.lfm @@ -75,7 +75,7 @@ object RemuxForm: TRemuxForm OnSelectEditor = gridSelectEditor OnValidateEntry = gridValidateEntry end - object memoLog: TMemo + object memoLog: TLogView Left = 0 Height = 180 Top = 366 @@ -84,10 +84,7 @@ object RemuxForm: TRemuxForm Font.Height = -12 Font.Name = 'Monospace' ParentFont = False - ReadOnly = True - ScrollBars = ssAutoBoth TabOrder = 2 - WordWrap = False end object pnlBottom: TPanel Left = 0 diff --git a/src/uRemuxForm.pas b/src/uRemuxForm.pas index 4936fd2..0ef82c1 100644 --- a/src/uRemuxForm.pas +++ b/src/uRemuxForm.pas @@ -18,7 +18,7 @@ interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls, Grids, ExtCtrls, - uRemuxQueue, uTheme, uThemedScroll; + uRemuxQueue, uTheme, uThemedScroll, uLogView; type @@ -34,7 +34,7 @@ type grid: TStringGrid; lblHelp: TLabel; lblTarget: TLabel; - memoLog: TMemo; + memoLog: TLogView; OpenDialog: TOpenDialog; pbBar: TProgressBar; pnlBottom: TPanel; @@ -212,10 +212,7 @@ end; procedure TRemuxForm.Log(const AText: string); begin - if memoLog.Lines.Count > 1000 then - memoLog.Lines.Delete(0); - memoLog.Lines.Add(AText); - memoLog.SelStart := Length(memoLog.Text); + memoLog.Add(AText); end; procedure TRemuxForm.FormShow(Sender: TObject); diff --git a/src/uTheme.pas b/src/uTheme.pas index 8d8fc34..562d943 100644 --- a/src/uTheme.pas +++ b/src/uTheme.pas @@ -728,10 +728,12 @@ begin рисует Windows, и до неё событиями не дотянуться. Цвет подложки задаётся кистью через SetMenuInfo — другого способа нет. MIM_APPLYTOSUBMENUS распространяет её на все вложенные списки. } - { Обращение к Handle создаёт дескриптор, если его ещё нет: у - всплывающего списка он появляется только при показе, а покрасить надо - заранее. } - if AMenu.Handle <> 0 then + { Дескриптор здесь только читается, а не создаётся. Обращение к Handle + создаёт его принудительно, и у всплывающего меню, до показа которого + ещё далеко, это ломает само меню: оно перестаёт открываться. + Цена отказа — тонкая рамка вокруг раскрытого списка остаётся системной; + сами пункты рисуются нами и цвет берут. } + if AMenu.HandleAllocated then begin FillChar(Info{%H-}, SizeOf(Info), 0); Info.cbSize := SizeOf(Info); diff --git a/src/uThemedScroll.pas b/src/uThemedScroll.pas index 14d1c93..a85c2af 100644 --- a/src/uThemedScroll.pas +++ b/src/uThemedScroll.pas @@ -93,6 +93,12 @@ type FVBar: TThemedScrollBar; FHBar: TThemedScrollBar; FUpdating: Boolean; + { Сколько места занимает всё содержимое таблицы. Считается сложением + ширин столбцов и высот строк, а не свойствами GridWidth и + GridHeight: с выключенными полосами прокрутки те возвращают не + полный размер содержимого, и полосы никогда не появлялись. } + function ContentWidth: Integer; + function ContentHeight: Integer; procedure Relayout; procedure SyncBars; procedure GridTopLeftChanged(Sender: TObject); @@ -117,6 +123,9 @@ begin FPage := 1; DoubleBuffered := True; ControlStyle := ControlStyle + [csOpaque]; + { Цвет задаём и самому контролу: пока не дошло дело до нашей отрисовки, + виджетсет закрашивает его своим, и на тёмном окне это заметно. } + Color := ThemeWindow; end; procedure TThemedScrollBar.Setup(AVertical: Boolean); @@ -360,6 +369,24 @@ begin Relayout; end; +function TScrolledGrid.ContentWidth: Integer; +var + I: Integer; +begin + Result := 0; + for I := 0 to FGrid.ColCount - 1 do + Inc(Result, FGrid.ColWidths[I]); +end; + +function TScrolledGrid.ContentHeight: Integer; +var + I: Integer; +begin + Result := 0; + for I := 0 to FGrid.RowCount - 1 do + Inc(Result, FGrid.RowHeights[I]); +end; + procedure TScrolledGrid.Paint; begin { Виден только уголок между полосами. } @@ -390,21 +417,26 @@ begin { Считаем в два захода: место, занятое одной полосой, может сделать нужной вторую. } - FGrid.SetBounds(0, 0, W, H); - NeedV := (FGrid.RowCount - FGrid.FixedRows) > FGrid.VisibleRowCount; + { Два захода: место, занятое одной полосой, может сделать нужной + вторую. } + NeedV := ContentHeight > H; + NeedH := ContentWidth > W; if NeedV then Dec(W, BarSize); - NeedH := FGrid.GridWidth > W; if NeedH then Dec(H, BarSize); + if (not NeedV) and (ContentHeight > H) then + begin + NeedV := True; + Dec(W, BarSize); + end; + if (not NeedH) and (ContentWidth > W) then + begin + NeedH := True; + Dec(H, BarSize); + end; FGrid.SetBounds(0, 0, W, H); - NeedV := (FGrid.RowCount - FGrid.FixedRows) > FGrid.VisibleRowCount; - if NeedV and (W = ClientWidth) then - begin - Dec(W, BarSize); - FGrid.SetBounds(0, 0, W, H); - end; FVBar.Visible := NeedV; if NeedV then @@ -413,6 +445,10 @@ begin FHBar.Visible := NeedH; if NeedH then FHBar.SetBounds(0, H, W, BarSize); + + { После перестановки границ перерисовка не назначается сама. } + FVBar.Invalidate; + FHBar.Invalidate; finally FUpdating := False; end; @@ -420,6 +456,8 @@ begin end; procedure TScrolledGrid.SyncBars; +var + NeedRelayout: Boolean; begin if (FGrid = nil) or (FVBar = nil) or (FHBar = nil) or FUpdating then Exit; @@ -429,9 +467,18 @@ begin FVBar.Position := FGrid.TopRow - FGrid.FixedRows; FHBar.SetRange(FGrid.ColCount - FGrid.FixedCols, FGrid.VisibleColCount); FHBar.Position := FGrid.LeftCol - FGrid.FixedCols; + { Строки в таблицу добавляются уже после её создания, и нужность полос + от этого меняется. Без этой проверки они пересчитывались бы только + при изменении размеров окна. } + NeedRelayout := (FVBar.Visible <> FVBar.Needed) or + (FHBar.Visible <> FHBar.Needed); finally FUpdating := False; end; + { Пересчёт размещения сам вызовет согласование ещё раз, но уже без + расхождения — второго круга не будет. } + if NeedRelayout then + Relayout; end; procedure TScrolledGrid.GridTopLeftChanged(Sender: TObject);