Свои полосы прокрутки у таблиц и три исправления к ним

Полосы прокрутки рисует система, и цвет им задать нечем. Единственный
способ получить их в своих цветах — не пользоваться системными вовсе.
Таблица при этом остаётся обычной: у неё выключаются свои полосы, а
прокрутка задаётся свойствами TopRow и LeftCol.

По дороге найдены и исправлены три ошибки, две из них — от раскраски окон:

- контекстное меню библиотеки перестало открываться: раскраска
  принудительно создавала системный дескриптор всплывающего меню
  задолго до показа. Теперь дескриптор только читается;
- окно кадрирования падало при открытии: смена режима отрисовки
  выпадающего списка вызывает его обработчик изменения, а тот обращался
  к таймеру, который создавался ниже по коду;
- полосы не появлялись вовсе: размер содержимого таблицы брался из
  GridWidth и GridHeight, а с выключенными полосами те возвращают не
  полный размер. Теперь считается сложением ширин столбцов и высот строк.

Многострочные поля в сведениях о проекте и в перепаковке заменены своим
журналом: у них оставались системные полосы. Заодно ответ ffprobe стало
можно выделить и скопировать.

Удалён неиспользуемый uScrollAid: горизонтальная прокрутка колесом теперь
внутри журнала и одинакова на обеих системах. Список юнитов в файле
проекта приведён в соответствие с тем, что лежит на диске.

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;

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;

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

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;

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

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

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

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