Окно «О программе»: свой показ текста с переносом и живыми ссылками
Текст переносится сам, по ширине окна, и переливается заново при изменении размера. Считать переносы заранее нельзя: текст когда-нибудь поедет в переводы, а там длина строки другая. Появился uArticleView — страница текста со ссылками. Журнал для этого не годился: он показывает сообщения программы, где перенос сбил бы выравнивание, и строк не переносит принципиально. Разметка нарочно бедная: «# » — заголовок, пустая строка — отступ, два пробела — отступ списка, http:// и https:// — ссылка. Больше ничего не нужно: это окно «О программе», а не браузер. Ссылки нажимаются: под указателем меняются цвет и курсор, по нажатию открывается браузер. Ссылка никогда не переносится — из двух половин её не собрать. Вкладки названы «Ресурсы» и «Возможности». Тексты переписаны короче: строка — одна мысль, без рассуждений.
This commit is contained in:
parent
58d7748d51
commit
83c56d334f
3 changed files with 532 additions and 231 deletions
|
|
@ -1,22 +1,15 @@
|
|||
{
|
||||
uAboutForm — окно «О программе».
|
||||
|
||||
Две вкладки. Первая обязательна: значки взяты у Icons8, а их бесплатная
|
||||
лицензия требует указать авторство со ссылкой на каждый значок. Заодно
|
||||
там же перечислено всё, на чём программа держится, и под какой лицензией
|
||||
оно раздаётся — под Windows и под Linux наборы разные.
|
||||
Две вкладки. «Ресурсы» — на чём программа держится и чьи значки
|
||||
использует: бесплатная лицензия Icons8 требует ссылку на каждый значок.
|
||||
«Возможности» — что программа умеет.
|
||||
|
||||
Вторая вкладка отвечает на вопрос «что эта штука умеет», который иначе
|
||||
задают каждому новому человеку голосом.
|
||||
Вкладки свои, а не TPageControl: системные под Windows остались бы
|
||||
светлой полосой поверх тёмного окна.
|
||||
|
||||
Вкладки свои, а не TPageControl: системные вкладки рисует система, и под
|
||||
Windows они остались бы светлой полосой поверх тёмного окна — ровно то,
|
||||
из-за чего здесь уже переписаны кнопки, полосы прокрутки, журнал и меню.
|
||||
Две кнопки-переключателя и две панели делают то же самое и выглядят как
|
||||
остальная программа.
|
||||
|
||||
Текст показывается нашим журналом: он умеет прокрутку, выделение и
|
||||
копирование в буфер — ссылку из списка можно взять и открыть в браузере.
|
||||
Текст показывает uArticleView: он сам переносит строки по ширине окна и
|
||||
делает ссылки нажимаемыми.
|
||||
}
|
||||
unit uAboutForm;
|
||||
|
||||
|
|
@ -26,94 +19,35 @@ interface
|
|||
|
||||
uses
|
||||
Classes, SysUtils, Controls, Forms, Graphics, StdCtrls, Dialogs,
|
||||
uTheme, uLogView;
|
||||
uTheme, uArticleView;
|
||||
|
||||
{ Показывает окно. Возвращается, когда его закрыли. }
|
||||
procedure ShowAboutForm;
|
||||
|
||||
implementation
|
||||
|
||||
{ Перенос по словам.
|
||||
|
||||
Журнал строки не переносит: он показывает сообщения программы, где
|
||||
перенос сбил бы выравнивание. Здесь же текст сплошной, и без переноса
|
||||
абзац уезжает за правый край.
|
||||
|
||||
Ссылки не трогаются вовсе: разорванную пополам ссылку не собрать
|
||||
обратно. Отступ строки переносится на её продолжения — иначе список
|
||||
рассыпается.
|
||||
|
||||
Ширина считается в знаках, а шрифт у нас пропорциональный, поэтому
|
||||
строка выходит короче обещанного. Это лучше, чем длиннее: за правый край
|
||||
не уедет ничего. }
|
||||
function Wrap(const AText: string; AWidth: Integer): string;
|
||||
var
|
||||
Src: TStringList;
|
||||
I, Space, Indent: Integer;
|
||||
Line, Rest: string;
|
||||
begin
|
||||
Result := '';
|
||||
Src := TStringList.Create;
|
||||
try
|
||||
Src.Text := AText;
|
||||
for I := 0 to Src.Count - 1 do
|
||||
begin
|
||||
Rest := Src[I];
|
||||
|
||||
if (Rest = '') or (Length(Rest) <= AWidth) or (Pos('http', Rest) > 0) then
|
||||
begin
|
||||
Result := Result + Rest + LineEnding;
|
||||
Continue;
|
||||
end;
|
||||
|
||||
{ Отступ запоминается и повторяется на всех продолжениях. }
|
||||
Indent := 0;
|
||||
while (Indent < Length(Rest)) and (Rest[Indent + 1] = ' ') do
|
||||
Inc(Indent);
|
||||
|
||||
while Length(Rest) > AWidth do
|
||||
begin
|
||||
{ Ищем последний пробел в пределах ширины; не нашли — рвём по
|
||||
ширине, иначе одно длинное слово повесило бы разбор. }
|
||||
Space := AWidth;
|
||||
while (Space > Indent + 1) and (Rest[Space] <> ' ') do
|
||||
Dec(Space);
|
||||
if Space <= Indent + 1 then
|
||||
Space := AWidth;
|
||||
Line := Copy(Rest, 1, Space);
|
||||
Rest := StringOfChar(' ', Indent) + Copy(Rest, Space + 1, Length(Rest));
|
||||
Result := Result + TrimRight(Line) + LineEnding;
|
||||
end;
|
||||
Result := Result + Rest + LineEnding;
|
||||
end;
|
||||
finally
|
||||
Src.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
type
|
||||
{ Обработчики живут в объекте: событиям нужны методы. }
|
||||
TAboutDialog = class(TComponent)
|
||||
public
|
||||
Form: TForm;
|
||||
BtnCredits: TThemedButton;
|
||||
BtnResources: TThemedButton;
|
||||
BtnFeatures: TThemedButton;
|
||||
ViewCredits: TLogView;
|
||||
ViewFeatures: TLogView;
|
||||
procedure ShowCredits(Sender: TObject);
|
||||
ViewResources: TArticleView;
|
||||
ViewFeatures: TArticleView;
|
||||
procedure ShowResources(Sender: TObject);
|
||||
procedure ShowFeatures(Sender: TObject);
|
||||
procedure Select(ACredits: Boolean);
|
||||
procedure Select(AResources: Boolean);
|
||||
end;
|
||||
|
||||
procedure TAboutDialog.Select(ACredits: Boolean);
|
||||
procedure TAboutDialog.Select(AResources: Boolean);
|
||||
begin
|
||||
BtnCredits.Down := ACredits;
|
||||
BtnFeatures.Down := not ACredits;
|
||||
ViewCredits.Visible := ACredits;
|
||||
ViewFeatures.Visible := not ACredits;
|
||||
BtnResources.Down := AResources;
|
||||
BtnFeatures.Down := not AResources;
|
||||
ViewResources.Visible := AResources;
|
||||
ViewFeatures.Visible := not AResources;
|
||||
end;
|
||||
|
||||
procedure TAboutDialog.ShowCredits(Sender: TObject);
|
||||
procedure TAboutDialog.ShowResources(Sender: TObject);
|
||||
begin
|
||||
Select(True);
|
||||
end;
|
||||
|
|
@ -123,163 +57,114 @@ begin
|
|||
Select(False);
|
||||
end;
|
||||
|
||||
{ Кто это написал и на чём оно держится.
|
||||
|
||||
Списки разные по системам не для красоты: под Linux ffmpeg и libmpv
|
||||
ставит пакетный менеджер, под Windows их скачивает сама программа из
|
||||
окна «Зависимости», и это разные сборки с разными лицензиями. Указывать
|
||||
надо то, что стоит у человека, а не то, что бывает вообще. }
|
||||
function CreditsText: string;
|
||||
{ Списки под Windows и под Linux разные: там сборки скачивает сама
|
||||
программа, здесь их ставит пакетный менеджер. }
|
||||
function ResourcesText: string;
|
||||
begin
|
||||
Result :=
|
||||
'nlve — монтаж без перекодирования' + LineEnding +
|
||||
LineEnding +
|
||||
'# nlve' + LineEnding +
|
||||
'Монтаж без перекодирования: куски вырезаются и склеиваются ' +
|
||||
'копированием потока.' + LineEnding +
|
||||
'Автор: 4aiman' + LineEnding +
|
||||
LineEnding +
|
||||
'Замысел в одном: куски видео вырезаются и склеиваются копированием ' +
|
||||
'потока, без пересчёта картинки. То, что обычный монтажный редактор ' +
|
||||
'считает часами, здесь собирается за время копирования файла. ' +
|
||||
'Пересобирается только то, что иначе никак: переходы, прозрачность, ' +
|
||||
'точные резы и куски файлов с чужими параметрами.' + LineEnding +
|
||||
LineEnding +
|
||||
'── Значки ──' + LineEnding +
|
||||
LineEnding +
|
||||
'Значки взяты у Icons8 и требуют указания авторства.' + LineEnding +
|
||||
LineEnding +
|
||||
'Прилипание — значок «Magnet» от Icons8:' + LineEnding +
|
||||
' https://icons8.com/icon/79942/magnet' + LineEnding +
|
||||
'Схлопывание — значок «Merge Vertical» от Icons8:' + LineEnding +
|
||||
' https://icons8.com/icon/2EQegp8tbR6Q/merge-vertical' + LineEnding +
|
||||
'Журнал — значок «Property» от Icons8:' + LineEnding +
|
||||
' https://icons8.com/icon/79872/property' + LineEnding +
|
||||
'Значок программы — «Showing Video Frames» от Icons8:' + LineEnding +
|
||||
' https://icons8.com/icon/69093/showing-video-frames' + LineEnding +
|
||||
LineEnding +
|
||||
'Сам Icons8: https://icons8.com' + LineEnding +
|
||||
LineEnding +
|
||||
'── Чем режется и что показывает ──' + LineEnding +
|
||||
'# Значки' + LineEnding +
|
||||
'Icons8. Нужна ссылка на каждый значок.' + LineEnding +
|
||||
'Прилипание — Magnet' + LineEnding +
|
||||
' https://icons8.com/icon/79942/magnet' + LineEnding +
|
||||
'Схлопывание — Merge Vertical' + LineEnding +
|
||||
' https://icons8.com/icon/2EQegp8tbR6Q/merge-vertical' + LineEnding +
|
||||
'Журнал — Property' + LineEnding +
|
||||
' https://icons8.com/icon/79872/property' + LineEnding +
|
||||
'Значок программы — Showing Video Frames' + LineEnding +
|
||||
' https://icons8.com/icon/69093/showing-video-frames' + LineEnding +
|
||||
'Сам Icons8' + LineEnding +
|
||||
' https://icons8.com' + LineEnding +
|
||||
LineEnding +
|
||||
'# Видео и звук' + LineEnding +
|
||||
{$IFDEF WINDOWS}
|
||||
'ffmpeg и ffprobe — вся работа с видео и звуком: нарезка, склейка, ' +
|
||||
'перекодирование, разбор файлов.' + LineEnding +
|
||||
' Сборка BtbN, вариант gpl:' + LineEnding +
|
||||
' https://github.com/BtbN/FFmpeg-Builds' + LineEnding +
|
||||
' Лицензия сборки: GPL-3.0' + LineEnding +
|
||||
' Сам ffmpeg: https://ffmpeg.org' + LineEnding +
|
||||
'ffmpeg — нарезка, склейка, перекодирование. Сборка BtbN, GPL.' +
|
||||
LineEnding +
|
||||
'libmpv — предпросмотр монтажа. Играет виртуальный список кусков, ' +
|
||||
'не собирая при этом ни одного файла.' + LineEnding +
|
||||
' Сборка shinchiro/mpv-winbuild-cmake:' + LineEnding +
|
||||
' https://github.com/shinchiro/mpv-winbuild-cmake' + LineEnding +
|
||||
' Лицензия сборки: GPL' + LineEnding +
|
||||
' Сам mpv: https://mpv.io' + LineEnding +
|
||||
LineEnding +
|
||||
'7-Zip (7zr.exe) — распаковка сборок libmpv, они раздаются в .7z.' +
|
||||
LineEnding +
|
||||
' https://www.7-zip.org' + LineEnding +
|
||||
' Лицензия: LGPL-2.1' + LineEnding +
|
||||
' https://github.com/BtbN/FFmpeg-Builds' + LineEnding +
|
||||
' https://ffmpeg.org' + LineEnding +
|
||||
'libmpv — предпросмотр. Сборка shinchiro, GPL.' + LineEnding +
|
||||
' https://github.com/shinchiro/mpv-winbuild-cmake' + LineEnding +
|
||||
' https://mpv.io' + LineEnding +
|
||||
'7-Zip — распаковка сборок libmpv. LGPL-2.1.' + LineEnding +
|
||||
' https://www.7-zip.org' + LineEnding +
|
||||
{$ELSE}
|
||||
'ffmpeg и ffprobe — вся работа с видео и звуком: нарезка, склейка, ' +
|
||||
'перекодирование, разбор файлов.' + LineEnding +
|
||||
' Ставится пакетным менеджером: sudo apt install ffmpeg' + LineEnding +
|
||||
' https://ffmpeg.org' + LineEnding +
|
||||
' Лицензия сборок в Ubuntu: GPL-2 и новее' + LineEnding +
|
||||
'ffmpeg — нарезка, склейка, перекодирование. GPL-2 и новее.' +
|
||||
LineEnding +
|
||||
'libmpv — предпросмотр монтажа. Играет виртуальный список кусков, ' +
|
||||
'не собирая при этом ни одного файла.' + LineEnding +
|
||||
' Ставится пакетным менеджером: sudo apt install mpv' + LineEnding +
|
||||
' https://mpv.io' + LineEnding +
|
||||
' Лицензия сборок в Ubuntu: GPL-3 и новее' + LineEnding +
|
||||
' sudo apt install ffmpeg' + LineEnding +
|
||||
' https://ffmpeg.org' + LineEnding +
|
||||
'libmpv — предпросмотр. GPL-3 и новее.' + LineEnding +
|
||||
' sudo apt install mpv' + LineEnding +
|
||||
' https://mpv.io' + LineEnding +
|
||||
{$ENDIF}
|
||||
LineEnding +
|
||||
'── На чём написано ──' + LineEnding +
|
||||
'# Инструменты' + LineEnding +
|
||||
'Free Pascal' + LineEnding +
|
||||
' https://www.freepascal.org' + LineEnding +
|
||||
'Lazarus LCL' + LineEnding +
|
||||
' https://www.lazarus-ide.org' + LineEnding +
|
||||
LineEnding +
|
||||
'Free Pascal — компилятор.' + LineEnding +
|
||||
' https://www.freepascal.org' + LineEnding +
|
||||
' Лицензия: GPL с оговоркой о компоновке для библиотеки времени ' +
|
||||
'выполнения' + LineEnding +
|
||||
LineEnding +
|
||||
'Lazarus LCL — библиотека окон и элементов управления.' + LineEnding +
|
||||
' https://www.lazarus-ide.org' + LineEnding +
|
||||
' Лицензия: LGPL-2 с оговоркой о компоновке' + LineEnding +
|
||||
LineEnding +
|
||||
'Ни ffmpeg, ни libmpv в состав программы не входят и вместе с ней не ' +
|
||||
'раздаются: ffmpeg запускается отдельной программой, libmpv ' +
|
||||
'подключается на ходу и ставится отдельно.';
|
||||
'ffmpeg и libmpv в состав программы не входят: ffmpeg запускается ' +
|
||||
'отдельной программой, libmpv ставится отдельно.';
|
||||
end;
|
||||
|
||||
{ Что программа умеет. Не список кнопок, а список того, ради чего её
|
||||
открывают. }
|
||||
function FeaturesText: string;
|
||||
begin
|
||||
Result :=
|
||||
'Монтаж' + LineEnding +
|
||||
'# Монтаж' + LineEnding +
|
||||
'Дорожки для картинки и для звука.' + LineEnding +
|
||||
'При перекрытии картинку даёт верхняя дорожка, звук всех дорожек ' +
|
||||
'смешивается.' + LineEnding +
|
||||
'Перенос, растягивание за края, рез по курсору (S), удаление.' +
|
||||
LineEnding +
|
||||
' Дорожки для картинки и для звука, сколько нужно. При перекрытии ' +
|
||||
'картинку даёт верхняя дорожка целиком, а звук всех дорожек ' +
|
||||
'смешивается: под голос кладётся музыка.' + LineEnding +
|
||||
' Клипы переносятся, растягиваются за края, режутся по курсору ' +
|
||||
'(S) и удаляются. Прилипание к краям соседей и к курсору; Shift во ' +
|
||||
'время перетаскивания отменяет его.' + LineEnding +
|
||||
' Связки: видео и его звук ходят вместе, Ctrl+G связывает и ' +
|
||||
'развязывает. Развязанный звук двигается отдельно от своей картинки.' +
|
||||
'Прилипание к соседям и к курсору. Shift отменяет его.' + LineEnding +
|
||||
'Связки: видео и его звук ходят вместе. Ctrl+G связывает и ' +
|
||||
'развязывает.' + LineEnding +
|
||||
'Схлопывание дыр: Ctrl+Shift+R или само при перетаскивании.' +
|
||||
LineEnding +
|
||||
' Схлопывание дыр: вручную (Ctrl+Shift+R) или само при ' +
|
||||
'перетаскивании, на текущей дорожке или на всех сразу.' + LineEnding +
|
||||
' Отмена и повтор любого действия.' + LineEnding +
|
||||
'Отмена и повтор: Ctrl+Z, Ctrl+Y.' + LineEnding +
|
||||
LineEnding +
|
||||
'Что видно на дорожках' + LineEnding +
|
||||
'# На дорожках' + LineEnding +
|
||||
'Форма звука. Shift со стрелками усиливает её на тихих записях.' +
|
||||
LineEnding +
|
||||
' Форма звука на звуковых клипах; Shift со стрелками вверх и вниз ' +
|
||||
'усиливает её, когда запись тихая.' + LineEnding +
|
||||
' Громкость клипа — ручкой прямо на нём, прозрачность — так же на ' +
|
||||
'видеоклипе.' + LineEnding +
|
||||
' Появление и уход — за верхние углы клипа. Перекрытие двух клипов ' +
|
||||
'одной дорожки помечено косым крестом: там сам собой выходит переход.' +
|
||||
'Громкость и прозрачность — ручкой на клипе.' + LineEnding +
|
||||
'Появление и уход — за верхние углы клипа.' + LineEnding +
|
||||
'Перекрытие на одной дорожке помечено крестом: там переход.' +
|
||||
LineEnding +
|
||||
' Цвет краёв показывает, притянут рез к опорному кадру или потребует ' +
|
||||
'перекодирования.' + LineEnding +
|
||||
'Цвет краёв показывает, потребует ли рез перекодирования.' + LineEnding +
|
||||
LineEnding +
|
||||
'Предпросмотр' + LineEnding +
|
||||
'# Предпросмотр' + LineEnding +
|
||||
'Играет монтаж целиком, не собирая файлов.' + LineEnding +
|
||||
'Показывает кадр проекта, а не кадр исходника.' + LineEnding +
|
||||
'Прозрачность и переходы видны.' + LineEnding +
|
||||
LineEnding +
|
||||
' Играет монтаж целиком, не собирая ни одного файла: плееру ' +
|
||||
'скармливается виртуальный список кусков.' + LineEnding +
|
||||
' Показывает кадр проекта, а не кадр очередного исходника — что ' +
|
||||
'видно здесь, то и получится в ролике.' + LineEnding +
|
||||
' Участки с прозрачностью и переходами заранее сводятся в отдельные ' +
|
||||
'файлы, поэтому видны и они.' + LineEnding +
|
||||
'# Кадрирование' + LineEnding +
|
||||
'Вписать, заполнить или растянуть. Увеличение, смещение, поворот, ' +
|
||||
'отражение.' + LineEnding +
|
||||
'Рамку можно тянуть мышью.' + LineEnding +
|
||||
'У каждого клипа своё.' + LineEnding +
|
||||
LineEnding +
|
||||
'Кадрирование' + LineEnding +
|
||||
'# Сборка' + LineEnding +
|
||||
'Обычная — копированием потоков, за время копирования файла.' +
|
||||
LineEnding +
|
||||
' У каждого клипа своё: вписать целиком, заполнить кадр с обрезкой ' +
|
||||
'или растянуть. Плюс увеличение, смещение, поворот и отражение.' +
|
||||
'Заранее сказано, сколько секунд придётся пересобрать и почему.' +
|
||||
LineEnding +
|
||||
' Рамку в окне кадрирования можно тянуть мышью, а не только задавать ' +
|
||||
'числами.' + LineEnding +
|
||||
'Точный рез перекодирует только огрызок до опорного кадра.' +
|
||||
LineEnding +
|
||||
'Сборка ролика' + LineEnding +
|
||||
'С перекодированием: от 720p до 4K, свой поток, HEVC или H.264, ' +
|
||||
'на видеокарте.' + LineEnding +
|
||||
'Перепаковка в другой контейнер без пересчёта.' + LineEnding +
|
||||
LineEnding +
|
||||
' Обычная — копированием потоков. Час материала собирается за время ' +
|
||||
'копирования файла.' + LineEnding +
|
||||
' Перед сборкой программа говорит, сколько секунд придётся ' +
|
||||
'пересобрать и почему.' + LineEnding +
|
||||
' Точный рез перекодирует только огрызок до ближайшего опорного ' +
|
||||
'кадра, остальное копируется.' + LineEnding +
|
||||
' Отдельно — сборка с перекодированием: размер кадра от 720p до 4K, ' +
|
||||
'поток в килобитах, кодек HEVC или H.264. Считает видеокарта.' +
|
||||
'# Прочее' + LineEnding +
|
||||
'Индекс опорных кадров читается из заголовка: 20 мс вместо 12 секунд.' +
|
||||
LineEnding +
|
||||
' Перепаковка готовых файлов в другой контейнер, без пересчёта.' +
|
||||
'Фоновая работа видна полоской внизу и штриховкой на монтаже.' +
|
||||
LineEnding +
|
||||
LineEnding +
|
||||
'Мелочи, которые важны' + LineEnding +
|
||||
LineEnding +
|
||||
' Индекс опорных кадров читается из заголовка файла, а не ' +
|
||||
'перебором: на шестигигабайтном файле это двадцать миллисекунд ' +
|
||||
'вместо двенадцати секунд.' + LineEnding +
|
||||
' Фоновая работа видна внизу полоской и отмечена на монтаже ' +
|
||||
'штриховкой.' + LineEnding +
|
||||
' Все окна в своих цветах, а не в системных.' + LineEnding +
|
||||
' Настройки, недавние проекты и размеры окна переживают перезапуск.';
|
||||
'Свои цвета во всех окнах.' + LineEnding +
|
||||
'Настройки и недавние проекты переживают перезапуск.';
|
||||
end;
|
||||
|
||||
procedure ShowAboutForm;
|
||||
|
|
@ -294,36 +179,32 @@ begin
|
|||
Dlg.Form.Position := poScreenCenter;
|
||||
Dlg.Form.ClientWidth := 720;
|
||||
Dlg.Form.ClientHeight := 560;
|
||||
Dlg.Form.Constraints.MinWidth := 480;
|
||||
Dlg.Form.Constraints.MinHeight := 320;
|
||||
Dlg.Form.Constraints.MinWidth := 420;
|
||||
Dlg.Form.Constraints.MinHeight := 300;
|
||||
|
||||
Dlg.BtnCredits := TThemedButton.Create(Dlg.Form);
|
||||
Dlg.BtnCredits.Parent := Dlg.Form;
|
||||
Dlg.BtnCredits.SetBounds(12, 12, 240, 28);
|
||||
Dlg.BtnCredits.Caption := 'Библиотеки и авторство';
|
||||
Dlg.BtnCredits.TabStop := False;
|
||||
Dlg.BtnCredits.OnClick := @Dlg.ShowCredits;
|
||||
Dlg.BtnResources := TThemedButton.Create(Dlg.Form);
|
||||
Dlg.BtnResources.Parent := Dlg.Form;
|
||||
Dlg.BtnResources.SetBounds(12, 12, 140, 28);
|
||||
Dlg.BtnResources.Caption := 'Ресурсы';
|
||||
Dlg.BtnResources.TabStop := False;
|
||||
Dlg.BtnResources.OnClick := @Dlg.ShowResources;
|
||||
|
||||
Dlg.BtnFeatures := TThemedButton.Create(Dlg.Form);
|
||||
Dlg.BtnFeatures.Parent := Dlg.Form;
|
||||
Dlg.BtnFeatures.SetBounds(258, 12, 180, 28);
|
||||
Dlg.BtnFeatures.Caption := 'Что умеет';
|
||||
Dlg.BtnFeatures.SetBounds(158, 12, 140, 28);
|
||||
Dlg.BtnFeatures.Caption := 'Возможности';
|
||||
Dlg.BtnFeatures.TabStop := False;
|
||||
Dlg.BtnFeatures.OnClick := @Dlg.ShowFeatures;
|
||||
|
||||
Dlg.ViewCredits := TLogView.Create(Dlg.Form);
|
||||
Dlg.ViewCredits.Parent := Dlg.Form;
|
||||
Dlg.ViewCredits.SetBounds(12, 48, 696, 460);
|
||||
Dlg.ViewCredits.Anchors := [akTop, akLeft, akRight, akBottom];
|
||||
{ Ширина подобрана замером: при 720 точках окна в строку входит около
|
||||
ста шестидесяти знаков, берём с запасом. }
|
||||
Dlg.ViewCredits.SetText(Wrap(CreditsText, 150));
|
||||
Dlg.ViewResources := TArticleView.Create(Dlg.Form);
|
||||
Dlg.ViewResources.Parent := Dlg.Form;
|
||||
Dlg.ViewResources.SetBounds(12, 48, 696, 460);
|
||||
Dlg.ViewResources.Anchors := [akTop, akLeft, akRight, akBottom];
|
||||
|
||||
Dlg.ViewFeatures := TLogView.Create(Dlg.Form);
|
||||
Dlg.ViewFeatures := TArticleView.Create(Dlg.Form);
|
||||
Dlg.ViewFeatures.Parent := Dlg.Form;
|
||||
Dlg.ViewFeatures.SetBounds(12, 48, 696, 460);
|
||||
Dlg.ViewFeatures.Anchors := [akTop, akLeft, akRight, akBottom];
|
||||
Dlg.ViewFeatures.SetText(Wrap(FeaturesText, 150));
|
||||
|
||||
BtnClose := TThemedButton.Create(Dlg.Form);
|
||||
BtnClose.Parent := Dlg.Form;
|
||||
|
|
@ -335,8 +216,13 @@ begin
|
|||
BtnClose.Cancel := True;
|
||||
|
||||
ApplyDarkTheme(Dlg.Form);
|
||||
{ Значок окна берётся у главного окна: своего у диалога нет. }
|
||||
|
||||
{ Текст задаётся после раскраски: раскладка считается по тому шрифту,
|
||||
которым он будет нарисован. }
|
||||
Dlg.ViewResources.SetText(ResourcesText);
|
||||
Dlg.ViewFeatures.SetText(FeaturesText);
|
||||
Dlg.Select(True);
|
||||
|
||||
Dlg.Form.ShowModal;
|
||||
finally
|
||||
Dlg.Form.Free;
|
||||
|
|
|
|||
414
src/uArticleView.pas
Normal file
414
src/uArticleView.pas
Normal file
|
|
@ -0,0 +1,414 @@
|
|||
{
|
||||
uArticleView — страница текста со ссылками.
|
||||
|
||||
Журнал (uLogView) для этого не годится: он показывает сообщения
|
||||
программы, где перенос сбил бы выравнивание, и строки там не
|
||||
переносятся принципиально. Здесь наоборот — сплошной текст, который
|
||||
должен сам ложиться по ширине окна и переливаться заново при его
|
||||
изменении. Считать переносы заранее нельзя ещё и потому, что текст
|
||||
когда-нибудь поедет в переводы: длина строки в другом языке будет иной.
|
||||
|
||||
Разметка нарочно бедная, вся в одну строку:
|
||||
|
||||
«# заголовок» — заголовок раздела
|
||||
пустая строка — отступ между абзацами
|
||||
ведущие пробелы — отступ, сохраняется при переносе
|
||||
http:// и https:// — ссылка, её можно нажать
|
||||
|
||||
Больше ничего не нужно: это окно «О программе», а не браузер.
|
||||
}
|
||||
unit uArticleView;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Math, Controls, Graphics, LCLType, LCLIntf, Types,
|
||||
uTheme, uThemedScroll;
|
||||
|
||||
type
|
||||
{ Кусок строки: либо обычный текст, либо ссылка. }
|
||||
TRun = record
|
||||
Text: string;
|
||||
Url: string;
|
||||
Left: Integer;
|
||||
Width: Integer;
|
||||
end;
|
||||
|
||||
TVisualLine = record
|
||||
Runs: array of TRun;
|
||||
Top: Integer;
|
||||
Height: Integer;
|
||||
Heading: Boolean;
|
||||
end;
|
||||
|
||||
TArticleView = class(TCustomControl)
|
||||
private
|
||||
FLines: TStringList;
|
||||
FVisual: array of TVisualLine;
|
||||
FContentHeight: Integer;
|
||||
FScroll: Integer;
|
||||
FBar: TThemedScrollBar;
|
||||
FHotLine: Integer;
|
||||
FHotRun: Integer;
|
||||
procedure BarChange(Sender: TObject);
|
||||
procedure Relayout;
|
||||
procedure SyncBar;
|
||||
{ Ссылка под указателем. Возвращает пустую строку, если её там нет. }
|
||||
function UrlAt(X, Y: Integer; out ALine, ARun: Integer): string;
|
||||
function LineHeight(AHeading: Boolean): Integer;
|
||||
protected
|
||||
procedure Paint; override;
|
||||
procedure Resize; override;
|
||||
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
||||
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
|
||||
X, Y: Integer); override;
|
||||
procedure MouseLeave; override;
|
||||
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
|
||||
MousePos: TPoint): Boolean; override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure SetText(const AText: string);
|
||||
published
|
||||
property Align;
|
||||
property Anchors;
|
||||
property Font;
|
||||
property ParentFont;
|
||||
property Visible;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
PadLeft = 10;
|
||||
PadTop = 8;
|
||||
BarWidth = 12;
|
||||
{ Отступ между абзацами и после заголовка — доли высоты строки. }
|
||||
ParaGap = 6;
|
||||
|
||||
constructor TArticleView.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
DoubleBuffered := True;
|
||||
Color := ThemeSurface;
|
||||
ParentColor := False;
|
||||
FLines := TStringList.Create;
|
||||
FHotLine := -1;
|
||||
FHotRun := -1;
|
||||
|
||||
FBar := TThemedScrollBar.Create(Self);
|
||||
FBar.Parent := Self;
|
||||
FBar.Setup(True);
|
||||
FBar.OnChange := @BarChange;
|
||||
FBar.Visible := False;
|
||||
end;
|
||||
|
||||
destructor TArticleView.Destroy;
|
||||
begin
|
||||
FLines.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TArticleView.LineHeight(AHeading: Boolean): Integer;
|
||||
begin
|
||||
Canvas.Font.Assign(Font);
|
||||
if AHeading then
|
||||
Canvas.Font.Style := [fsBold];
|
||||
Result := Canvas.TextHeight('Wg') + 3;
|
||||
Canvas.Font.Style := [];
|
||||
end;
|
||||
|
||||
procedure TArticleView.SetText(const AText: string);
|
||||
begin
|
||||
FLines.Text := AText;
|
||||
FScroll := 0;
|
||||
Relayout;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
{ Раскладка: каждая строка исходника режется на слова и укладывается по
|
||||
ширине. Ссылка не режется никогда — из двух половин её не собрать. }
|
||||
procedure TArticleView.Relayout;
|
||||
var
|
||||
I, N, Indent, X, MaxX, W, Start: Integer;
|
||||
Src, Word, Rest: string;
|
||||
Heading: Boolean;
|
||||
Line: TVisualLine;
|
||||
Y: Integer;
|
||||
|
||||
procedure PushLine;
|
||||
begin
|
||||
if Length(Line.Runs) = 0 then
|
||||
Exit;
|
||||
Line.Top := Y;
|
||||
Line.Height := LineHeight(Line.Heading);
|
||||
Inc(Y, Line.Height);
|
||||
SetLength(FVisual, Length(FVisual) + 1);
|
||||
FVisual[High(FVisual)] := Line;
|
||||
Line.Runs := nil;
|
||||
X := Indent;
|
||||
end;
|
||||
|
||||
procedure PushWord(const AWord: string; const AUrl: string);
|
||||
var
|
||||
Wid: Integer;
|
||||
begin
|
||||
Canvas.Font.Assign(Font);
|
||||
if Line.Heading then
|
||||
Canvas.Font.Style := [fsBold];
|
||||
Wid := Canvas.TextWidth(AWord);
|
||||
Canvas.Font.Style := [];
|
||||
|
||||
{ Не влезло — переносим, но только если на строке уже что-то есть:
|
||||
иначе слово шире окна ушло бы в бесконечный перенос. }
|
||||
if (X + Wid > MaxX) and (Length(Line.Runs) > 0) then
|
||||
PushLine;
|
||||
|
||||
N := Length(Line.Runs);
|
||||
SetLength(Line.Runs, N + 1);
|
||||
Line.Runs[N].Text := AWord;
|
||||
Line.Runs[N].Url := AUrl;
|
||||
Line.Runs[N].Left := X;
|
||||
Line.Runs[N].Width := Wid;
|
||||
Inc(X, Wid);
|
||||
end;
|
||||
|
||||
begin
|
||||
FVisual := nil;
|
||||
FContentHeight := 0;
|
||||
if FLines = nil then
|
||||
Exit;
|
||||
|
||||
MaxX := ClientWidth - PadLeft - BarWidth - 6;
|
||||
if MaxX < 80 then
|
||||
MaxX := 80;
|
||||
|
||||
Y := PadTop;
|
||||
Line.Runs := nil;
|
||||
Line.Heading := False;
|
||||
|
||||
for I := 0 to FLines.Count - 1 do
|
||||
begin
|
||||
Src := FLines[I];
|
||||
|
||||
if Trim(Src) = '' then
|
||||
begin
|
||||
Inc(Y, ParaGap + LineHeight(False) div 2);
|
||||
Continue;
|
||||
end;
|
||||
|
||||
Heading := Copy(Src, 1, 2) = '# ';
|
||||
if Heading then
|
||||
begin
|
||||
Src := Copy(Src, 3, Length(Src));
|
||||
Inc(Y, ParaGap);
|
||||
end;
|
||||
|
||||
Indent := PadLeft;
|
||||
while (Length(Src) > 0) and (Src[1] = ' ') do
|
||||
begin
|
||||
Inc(Indent, 12);
|
||||
Delete(Src, 1, 1);
|
||||
end;
|
||||
|
||||
Line.Heading := Heading;
|
||||
X := Indent;
|
||||
Rest := Src;
|
||||
|
||||
while Rest <> '' do
|
||||
begin
|
||||
Start := Pos(' ', Rest);
|
||||
if Start = 0 then
|
||||
begin
|
||||
Word := Rest;
|
||||
Rest := '';
|
||||
end
|
||||
else
|
||||
begin
|
||||
Word := Copy(Rest, 1, Start);
|
||||
Rest := Copy(Rest, Start + 1, Length(Rest));
|
||||
end;
|
||||
|
||||
if (Pos('http://', Word) = 1) or (Pos('https://', Word) = 1) then
|
||||
PushWord(Word, TrimRight(Word))
|
||||
else
|
||||
PushWord(Word, '');
|
||||
end;
|
||||
PushLine;
|
||||
|
||||
if Heading then
|
||||
Inc(Y, 2);
|
||||
end;
|
||||
|
||||
FContentHeight := Y + PadTop;
|
||||
SyncBar;
|
||||
end;
|
||||
|
||||
procedure TArticleView.SyncBar;
|
||||
var
|
||||
Page: Integer;
|
||||
begin
|
||||
if FBar = nil then
|
||||
Exit;
|
||||
Page := ClientHeight;
|
||||
FBar.SetBounds(ClientWidth - BarWidth, 0, BarWidth, ClientHeight);
|
||||
FBar.SetRange(FContentHeight, Page);
|
||||
FBar.Visible := FBar.Needed;
|
||||
if FScroll > FContentHeight - Page then
|
||||
FScroll := Max(0, FContentHeight - Page);
|
||||
FBar.Position := FScroll;
|
||||
end;
|
||||
|
||||
procedure TArticleView.BarChange(Sender: TObject);
|
||||
begin
|
||||
if FScroll = FBar.Position then
|
||||
Exit;
|
||||
FScroll := FBar.Position;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TArticleView.Resize;
|
||||
begin
|
||||
inherited Resize;
|
||||
Relayout;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
function TArticleView.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
|
||||
MousePos: TPoint): Boolean;
|
||||
var
|
||||
Step: Integer;
|
||||
begin
|
||||
Step := LineHeight(False) * 3;
|
||||
if WheelDelta > 0 then
|
||||
FScroll := Max(0, FScroll - Step)
|
||||
else
|
||||
FScroll := Min(Max(0, FContentHeight - ClientHeight), FScroll + Step);
|
||||
if FBar <> nil then
|
||||
FBar.Position := FScroll;
|
||||
Invalidate;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function TArticleView.UrlAt(X, Y: Integer; out ALine, ARun: Integer): string;
|
||||
var
|
||||
{ Не Top: так называется свойство самого элемента. }
|
||||
I, J, LineTop: Integer;
|
||||
begin
|
||||
Result := '';
|
||||
ALine := -1;
|
||||
ARun := -1;
|
||||
for I := 0 to High(FVisual) do
|
||||
begin
|
||||
LineTop := FVisual[I].Top - FScroll;
|
||||
if (Y < LineTop) or (Y >= LineTop + FVisual[I].Height) then
|
||||
Continue;
|
||||
for J := 0 to High(FVisual[I].Runs) do
|
||||
if (FVisual[I].Runs[J].Url <> '') and
|
||||
(X >= FVisual[I].Runs[J].Left) and
|
||||
(X < FVisual[I].Runs[J].Left + FVisual[I].Runs[J].Width) then
|
||||
begin
|
||||
ALine := I;
|
||||
ARun := J;
|
||||
Exit(FVisual[I].Runs[J].Url);
|
||||
end;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TArticleView.MouseMove(Shift: TShiftState; X, Y: Integer);
|
||||
var
|
||||
L, R: Integer;
|
||||
begin
|
||||
inherited MouseMove(Shift, X, Y);
|
||||
UrlAt(X, Y, L, R);
|
||||
if (L <> FHotLine) or (R <> FHotRun) then
|
||||
begin
|
||||
FHotLine := L;
|
||||
FHotRun := R;
|
||||
if L >= 0 then
|
||||
Cursor := crHandPoint
|
||||
else
|
||||
Cursor := crDefault;
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TArticleView.MouseLeave;
|
||||
begin
|
||||
inherited MouseLeave;
|
||||
if FHotLine >= 0 then
|
||||
begin
|
||||
FHotLine := -1;
|
||||
FHotRun := -1;
|
||||
Cursor := crDefault;
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TArticleView.MouseUp(Button: TMouseButton; Shift: TShiftState;
|
||||
X, Y: Integer);
|
||||
var
|
||||
Url: string;
|
||||
L, R: Integer;
|
||||
begin
|
||||
inherited MouseUp(Button, Shift, X, Y);
|
||||
if Button <> mbLeft then
|
||||
Exit;
|
||||
Url := UrlAt(X, Y, L, R);
|
||||
if Url <> '' then
|
||||
OpenURL(Url);
|
||||
end;
|
||||
|
||||
procedure TArticleView.Paint;
|
||||
var
|
||||
I, J, LineTop: Integer;
|
||||
Run: TRun;
|
||||
Hot: Boolean;
|
||||
begin
|
||||
Canvas.Brush.Color := ThemeSurface;
|
||||
Canvas.Brush.Style := bsSolid;
|
||||
Canvas.FillRect(ClientRect);
|
||||
|
||||
Canvas.Brush.Style := bsClear;
|
||||
for I := 0 to High(FVisual) do
|
||||
begin
|
||||
LineTop := FVisual[I].Top - FScroll;
|
||||
if LineTop + FVisual[I].Height < 0 then
|
||||
Continue;
|
||||
if LineTop > ClientHeight then
|
||||
Break;
|
||||
|
||||
Canvas.Font.Assign(Font);
|
||||
if FVisual[I].Heading then
|
||||
Canvas.Font.Style := [fsBold];
|
||||
|
||||
for J := 0 to High(FVisual[I].Runs) do
|
||||
begin
|
||||
Run := FVisual[I].Runs[J];
|
||||
Hot := (I = FHotLine) and (J = FHotRun);
|
||||
|
||||
if Run.Url <> '' then
|
||||
begin
|
||||
if Hot then
|
||||
Canvas.Font.Color := ThemeAccent
|
||||
else
|
||||
Canvas.Font.Color := ThemeLink;
|
||||
Canvas.Font.Style := Canvas.Font.Style + [fsUnderline];
|
||||
end
|
||||
else if FVisual[I].Heading then
|
||||
Canvas.Font.Color := ThemeText
|
||||
else
|
||||
Canvas.Font.Color := ThemeText;
|
||||
|
||||
Canvas.TextOut(Run.Left, LineTop, Run.Text);
|
||||
|
||||
Canvas.Font.Style := Canvas.Font.Style - [fsUnderline];
|
||||
end;
|
||||
Canvas.Font.Style := [];
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
|
@ -52,6 +52,7 @@ const
|
|||
ThemeSelection = TColor($785434); // приглушённый синий: выделение
|
||||
ThemeSelText = TColor($FFFFFF);
|
||||
ThemeGridLine = TColor($3A3A3A);
|
||||
ThemeLink = TColor($E0A060); // голубой: ссылка
|
||||
|
||||
type
|
||||
{ Значок на кнопке.
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue