diff --git a/.gitignore b/.gitignore index 77cd272..5cf5375 100644 --- a/.gitignore +++ b/.gitignore @@ -43,6 +43,10 @@ shot*.png # Журнал последнего запуска /nlve.log +# Проверка свойств из файлов форм. +/tests/lfmcheck/lfmcheck +/tests/lfmcheck/units/ + # Проверка хода полоски: двоичный файл и промежуточные модули. /tests/progress/progtest /tests/progress/*.o diff --git a/build.sh b/build.sh index 6b2082d..6a03f16 100755 --- a/build.sh +++ b/build.sh @@ -123,6 +123,22 @@ run_tests() { status=1 fi + # Свойства, записанные в файлах форм, проверяются по сведениям о типах. + # Файл формы разбирается при запуске, а не при сборке: опечатка в имени + # свойства даёт не ошибку компиляции, а падение окна на старте. + note "Проверка свойств из файлов форм" + if "$LAZBUILD" --primary-config-path="$LAZCONF" \ + "$HERE/tests/lfmcheck/lfmcheck.lpi" >/dev/null 2>&1; then + if "$HERE/tests/lfmcheck/lfmcheck"; then + : + else + status=1 + fi + else + echo "не собралось" >&2 + status=1 + fi + # Ход полоски выполнения проверяется отдельной программой: расчёт вынесен # в uAppTypes именно затем, чтобы его можно было прогнать числами. note "Проверка хода полоски выполнения" diff --git a/icons/log.png b/icons/log.png new file mode 100644 index 0000000..00c89e0 Binary files /dev/null and b/icons/log.png differ diff --git a/icons/log.svg b/icons/log.svg new file mode 100644 index 0000000..2ee43c8 --- /dev/null +++ b/icons/log.svg @@ -0,0 +1,11 @@ + + + + + + + + + diff --git a/icons/ripple.png b/icons/ripple.png new file mode 100644 index 0000000..de2c28c Binary files /dev/null and b/icons/ripple.png differ diff --git a/icons/ripple.svg b/icons/ripple.svg new file mode 100644 index 0000000..b1ea32e --- /dev/null +++ b/icons/ripple.svg @@ -0,0 +1,9 @@ + + + + + + + diff --git a/icons/snap.png b/icons/snap.png new file mode 100644 index 0000000..150c247 Binary files /dev/null and b/icons/snap.png differ diff --git a/icons/snap.svg b/icons/snap.svg new file mode 100644 index 0000000..51604bc --- /dev/null +++ b/icons/snap.svg @@ -0,0 +1,14 @@ + + + + + + + + + + + + diff --git a/src/uMainForm.lfm b/src/uMainForm.lfm index 857c099..2f29898 100644 --- a/src/uMainForm.lfm +++ b/src/uMainForm.lfm @@ -16,7 +16,7 @@ object MainForm: TMainForm object memoLog: TLogView Left = 0 Height = 130 - Top = 770 + Top = 730 Width = 1600 Align = alBottom Font.Height = -11 @@ -27,7 +27,7 @@ object MainForm: TMainForm object pnlBottom: TPanel Left = 0 Height = 40 - Top = 730 + Top = 860 Width = 1600 Align = alBottom BevelOuter = bvNone @@ -56,24 +56,24 @@ object MainForm: TMainForm ShowHint = True end object btnRipple: TThemedButton - Left = 470 + Left = 326 Height = 28 Top = 6 - Width = 280 - Caption = 'Схлопывание: текущая дорожка' + Width = 28 + Icon = tiRipple OnClick = btnRippleClick ShowHint = True end object btnRippleMenu: TThemedButton - Left = 752 + Left = 356 Height = 28 Top = 6 - Width = 26 + Width = 22 Arrow = True OnClick = btnRippleMenuClick end object lblStatus: TLabel - Left = 790 + Left = 428 Height = 20 Top = 10 Width = 840 diff --git a/src/uMainForm.pas b/src/uMainForm.pas index 4489ac8..9aa2e99 100644 --- a/src/uMainForm.pas +++ b/src/uMainForm.pas @@ -568,6 +568,13 @@ procedure TMainForm.BuildMenu; var MFile, MEdit, MView, MProject: TMenuItem; begin + { Подсказки всплывают почти сразу: на кнопке со значком они не + украшение, а единственный способ узнать, что она делает. Держатся + долго — читать там больше, чем одно слово. } + Application.ShowHint := True; + Application.HintPause := 100; + Application.HintHidePause := 15000; + BuildJobIndicator; FMenu := TMainMenu.Create(Self); @@ -650,7 +657,8 @@ end; procedure TMainForm.BuildJobIndicator; const JobWidth = 330; - LogButtonWidth = 100; + LogButtonWidth = 28; + LogButtonLeft = 388; begin FJobLabel := TLabel.Create(Self); FJobLabel.Parent := pnlBottom; @@ -674,19 +682,18 @@ begin рассказала. } FLogButton := TThemedButton.Create(Self); FLogButton.Parent := pnlBottom; - FLogButton.Anchors := [akTop, akRight]; - FLogButton.SetBounds(pnlBottom.ClientWidth - JobWidth - LogButtonWidth - 20, - 6, LogButtonWidth, 28); - FLogButton.Caption := 'Журнал'; + { Рядом с прилипанием и схлопыванием: три переключателя читаются как + один набор, а не как случайно разбросанные значки. } + FLogButton.SetBounds(LogButtonLeft, 6, LogButtonWidth, 28); + FLogButton.Icon := tiLog; FLogButton.Down := True; FLogButton.OnClick := @LogButtonClick; FLogButton.ShowHint := True; - FLogButton.Hint := 'Спрятать или показать нижнюю полосу с сообщениями'; + FLogButton.Hint := 'Журнал: спрятать или показать полосу с сообщениями'; { Строка состояния ужимается, чтобы её длинные сообщения не залезали под показатель и под кнопку. } - lblStatus.Width := pnlBottom.ClientWidth - lblStatus.Left - JobWidth - - LogButtonWidth - 32; + lblStatus.Width := pnlBottom.ClientWidth - lblStatus.Left - JobWidth - 24; { Сто миллисекунд, а не триста: полоска должна ползти, а не дёргаться ступеньками. } @@ -715,8 +722,13 @@ end; procedure TMainForm.ApplyLogVisible(AVisible: Boolean); begin memoLog.Visible := AVisible; - if Assigned(FLogButton) then - FLogButton.Down := AVisible; + if not Assigned(FLogButton) then + Exit; + FLogButton.Down := AVisible; + if AVisible then + FLogButton.Hint := 'Журнал виден. Нажмите, чтобы спрятать.' + else + FLogButton.Hint := 'Журнал спрятан. Нажмите, чтобы показать.'; end; { Как растёт полоска. @@ -1815,10 +1827,15 @@ begin ModeText := 'все дорожки' else ModeText := 'текущая дорожка'; - btnRipple.Caption := 'Схлопывание: ' + ModeText; btnRipple.Down := FProject.RippleEnabled; - btnRipple.Hint := 'Ctrl+K — включить или выключить. ' + - 'Режим действует и при выключенном автосхлопывании: по нему работает Ctrl+Shift+R.'; + if FProject.RippleEnabled then + btnRipple.Hint := 'Автосхлопывание включено, режим: ' + ModeText + '.' + else + btnRipple.Hint := 'Автосхлопывание выключено, режим: ' + ModeText + '.'; + btnRipple.Hint := btnRipple.Hint + LineEnding + + 'Ctrl+K — включить или выключить. Режим действует и при выключенном ' + + 'автосхлопывании: по нему работает Ctrl+Shift+R.'; + btnRippleMenu.Hint := 'Выбрать режим схлопывания'; end; { Прилипание краёв клипов друг к другу. @@ -1826,14 +1843,20 @@ end; Shift работает как переключатель наоборот: при включённом прилипании временно отключает его, при выключенном — временно включает. Так одна клавиша полезна в обоих режимах, и не нужно помнить, какой сейчас. } +{ Кнопка со значком не может сказать словами, что она делает и в каком + она состоянии. Слова переезжают в подсказку — целиком, вместе с + состоянием: иначе о состоянии пришлось бы догадываться по цвету. } procedure TMainForm.UpdateSnapButton; +var + State: string; begin btnSnap.Down := FTimeline.SnapEnabled; if FTimeline.SnapEnabled then - btnSnap.Caption := 'Прилипание: вкл' + State := 'включено' else - btnSnap.Caption := 'Прилипание: выкл'; - btnSnap.Hint := 'Shift во время перетаскивания меняет решение на противоположное.'; + State := 'выключено'; + btnSnap.Hint := 'Прилипание: ' + State + '.' + LineEnding + + 'Shift во время перетаскивания меняет решение на противоположное.'; end; procedure TMainForm.btnSnapClick(Sender: TObject); diff --git a/src/uTheme.pas b/src/uTheme.pas index d4176dd..e68a12e 100644 --- a/src/uTheme.pas +++ b/src/uTheme.pas @@ -31,7 +31,7 @@ interface uses Classes, SysUtils, Types, Controls, Graphics, Forms, StdCtrls, ExtCtrls, - ComCtrls, Grids, Menus, Dialogs, LCLType, LCLIntf, LCLProc; + ComCtrls, Grids, Menus, Dialogs, Math, LCLType, LCLIntf, LCLProc; const { Порядок байт в TColor — $00BBGGRR, а не привычный RGB. У серых цветов @@ -53,6 +53,18 @@ const ThemeGridLine = TColor($3A3A3A); type + { Значок на кнопке. + + Рисуется кодом, а не берётся из файла: программа не должна зависеть + от того, лежит ли рядом с ней картинка. Рисунки повторяют icons/*.svg + — там они и придуманы, оттуда их можно перегнать в png для чего + угодно ещё. } + TThemedIcon = ( + tiNone, + tiSnap, // прилипание: края притягиваются к общей линии + tiRipple, // схлопывание: дыра между кусками закрывается + tiLog // журнал: полоса с сообщениями + ); { Полоска выполнения, которая рисует себя сама. @@ -82,6 +94,7 @@ type TThemedButton = class(TCustomControl) private FArrow: Boolean; + FIcon: TThemedIcon; FFlat: Boolean; FDown: Boolean; FHover: Boolean; @@ -90,6 +103,8 @@ type FCancel: Boolean; FModalResult: TModalResult; procedure SetArrow(AValue: Boolean); + procedure SetIcon(AValue: TThemedIcon); + procedure DrawIcon(const ARect: TRect; AColor: TColor); procedure SetFlat(AValue: Boolean); procedure SetDown(AValue: Boolean); procedure SetDefault(AValue: Boolean); @@ -122,6 +137,9 @@ type property Arrow: Boolean read FArrow write SetArrow default False; property Cancel: Boolean read FCancel write SetCancel default False; property Caption; + { Значок вместо надписи. Надпись при этом не пропадает зря: её место — + подсказка, которая всплывает по наведению. } + property Icon: TThemedIcon read FIcon write SetIcon default tiNone; property Default: Boolean read FDefault write SetDefault default False; property Down: Boolean read FDown write SetDown default False; property Enabled; @@ -357,6 +375,101 @@ begin Result.cy := 28; end; +procedure TThemedButton.SetIcon(AValue: TThemedIcon); +begin + if FIcon = AValue then + Exit; + FIcon := AValue; + Invalidate; +end; + +{ Значки рисуются по клетке 24 на 24 — той же, что в icons/*.svg, — и + переносятся в заданный прямоугольник. Так рисунок один и тот же при + любом размере кнопки, и правится он в одном месте. } +procedure TThemedButton.DrawIcon(const ARect: TRect; AColor: TColor); +var + Side, X0, Y0: Integer; + + function PX(AValue: Integer): Integer; + begin + Result := X0 + Round(AValue * Side / 24); + end; + + function PY(AValue: Integer): Integer; + begin + Result := Y0 + Round(AValue * Side / 24); + end; + + procedure Line(X1, Y1, X2, Y2: Integer); + begin + Canvas.Line(PX(X1), PY(Y1), PX(X2), PY(Y2)); + end; + + procedure Box(X1, Y1, X2, Y2: Integer; AFilled: Boolean); + begin + if AFilled then + Canvas.Brush.Style := bsSolid + else + Canvas.Brush.Style := bsClear; + Canvas.Rectangle(PX(X1), PY(Y1), PX(X2), PY(Y2)); + end; + + { Треугольник остриём влево или вправо. Не Arrow: так называется + свойство самой кнопки. } + procedure Tri(ATipX, ABaseX, ACenterY, AHalf: Integer); + begin + Canvas.Brush.Style := bsSolid; + Canvas.Polygon([Types.Point(PX(ATipX), PY(ACenterY)), + Types.Point(PX(ABaseX), PY(ACenterY - AHalf)), + Types.Point(PX(ABaseX), PY(ACenterY + AHalf))]); + end; + +begin + if FIcon = tiNone then + Exit; + + Side := Min(ARect.Right - ARect.Left, ARect.Bottom - ARect.Top) - 6; + if Side < 8 then + Exit; + X0 := (ARect.Left + ARect.Right - Side) div 2; + Y0 := (ARect.Top + ARect.Bottom - Side) div 2; + + Canvas.Pen.Color := AColor; + Canvas.Pen.Width := Max(1, Side div 12); + Canvas.Brush.Color := AColor; + + case FIcon of + tiSnap: + begin + { Средняя линия — граница, к которой прилипает край; по бокам + края, притягивающиеся к ней. } + Line(12, 2, 12, 22); + Line(2, 6, 2, 18); + Line(22, 6, 22, 18); + Tri(9, 5, 12, 4); + Tri(15, 19, 12, 4); + end; + tiRipple: + begin + { Два куска и дыра между ними; стрелка показывает, что правый + переедет влево. } + Box(1, 7, 8, 17, True); + Box(16, 7, 23, 17, True); + Tri(10, 15, 12, 4); + end; + tiLog: + begin + Box(2, 3, 22, 21, False); + Line(6, 8, 18, 8); + Line(6, 12, 18, 12); + Line(6, 16, 13, 16); + end; + end; + + Canvas.Pen.Width := 1; + Canvas.Brush.Style := bsClear; +end; + procedure TThemedButton.Paint; var R: TRect; @@ -422,6 +535,8 @@ begin Canvas.Polygon([Point(CX - 5, CY - 2), Point(CX + 5, CY - 2), Point(CX, CY + 4)]); end + else if FIcon <> tiNone then + DrawIcon(R, Fore) else begin Canvas.Font.Assign(Font); diff --git a/tests/lfmcheck/lfmcheck.lpi b/tests/lfmcheck/lfmcheck.lpi new file mode 100644 index 0000000..705b2ff --- /dev/null +++ b/tests/lfmcheck/lfmcheck.lpi @@ -0,0 +1,37 @@ + + + + + + + + + + + </General> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="LCL"/> + </Item1> + </RequiredPackages> + <Units Count="1"> + <Unit0> + <Filename Value="lfmcheck.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="lfmcheck"/> + </Target> + <SearchPaths> + <OtherUnitFiles Value="../../src"/> + <UnitOutputDirectory Value="units"/> + </SearchPaths> + </CompilerOptions> +</CONFIG> diff --git a/tests/lfmcheck/lfmcheck.lpr b/tests/lfmcheck/lfmcheck.lpr new file mode 100644 index 0000000..f9bb203 --- /dev/null +++ b/tests/lfmcheck/lfmcheck.lpr @@ -0,0 +1,67 @@ +{ + Проверка того, что свойства, записанные в файле формы, у наших + элементов действительно есть. + + Зачем отдельно. Файл формы разбирается при запуске, а не при сборке: + опечатка в имени свойства или в значении перечисления даёт не ошибку + компиляции, а падение окна на старте. Здесь то же самое проверяется без + окна — по сведениям о типах. +} +program lfmcheck; + +{$mode objfpc}{$H+} + +uses + { Interfaces нужен только для сборки: без него не связывается вся LCL. + Окно при этом не создаётся — Application.Initialize мы не зовём. } + Interfaces, SysUtils, TypInfo, uTheme; + +var + Failed: Integer = 0; + +procedure CheckProp(AClass: TClass; const AName: string); +begin + if GetPropInfo(AClass, AName) <> nil then + WriteLn(' ok ', AClass.ClassName, '.', AName) + else + begin + WriteLn(' ПЛОХО ', AClass.ClassName, '.', AName, ' — свойства нет'); + Inc(Failed); + end; +end; + +procedure CheckEnum(ATypeInfo: PTypeInfo; const AName: string); +begin + if GetEnumValue(ATypeInfo, AName) >= 0 then + WriteLn(' ok значение ', AName) + else + begin + WriteLn(' ПЛОХО значение ', AName, ' — такого нет'); + Inc(Failed); + end; +end; + +begin + WriteLn('Свойства из файлов форм'); + WriteLn; + + CheckProp(TThemedButton, 'Icon'); + CheckProp(TThemedButton, 'Down'); + CheckProp(TThemedButton, 'Arrow'); + CheckProp(TThemedButton, 'Caption'); + CheckProp(TThemedButton, 'ShowHint'); + + CheckEnum(TypeInfo(TThemedIcon), 'tiSnap'); + CheckEnum(TypeInfo(TThemedIcon), 'tiRipple'); + CheckEnum(TypeInfo(TThemedIcon), 'tiLog'); + CheckEnum(TypeInfo(TThemedIcon), 'tiNone'); + + WriteLn; + if Failed = 0 then + WriteLn('ВЕРДИКТ: все проверки пройдены') + else + begin + WriteLn('ВЕРДИКТ: не пройдено проверок: ', Failed); + Halt(1); + end; +end.