Устранение бага в InputQuery: различия в цветах TForm и TPanel в Delphi/Pascal и методы их исправления.

Delphi , Компоненты и Классы , TGroupBox

В Lazarus, особенно при использовании GTK2, может возникнуть визуальный артефакт в InputQuery: прямоугольная область другого цвета слева от кнопок "OK" и "Cancel". Это происходит, когда цвет фона TForm и TPanel, на котором расположены кнопки, отличаются, несмотря на то, что оба установлены в clDefault. Проблема проявляется из-за того, что clDefault интерпретируется по-разному для TForm и TPanel.

Проблема:

Функция DefaultInputDialog, используемая InputQuery, создает кнопки на панели TButtonPanel. По умолчанию, цвет фона TPanel может отличаться от цвета фона TForm, особенно в Linux с использованием GTK2 и различных тем оформления.

Решение (предложенное):

Добавить строку кода, явно устанавливающую цвет фона TButtonPanel равным цвету родительского TForm.

with TButtonPanel.Create(Form) do
begin
  Top := Edit.Top + Edit.Height;
  Parent := Form;
  ShowBevel := False;
  ShowButtons := [pbOK, pbCancel];
  Color:=Parent.GetDefaultColor(dctBrush);   // fix for wrong background colour
  Align := alTop;
end;

Эта строка получает "разрешенный" цвет фона родительского TForm (с учетом темы оформления) и присваивает его панели.

Альтернативные решения и обсуждение:

1. ParentColor := True: Изначально предполагалось, что установка ParentColor в True должна решить проблему, автоматически наследуя цвет родителя. Однако, как показало тестирование, в данном случае это не работает, так как оба компонента имеют clDefault, но интерпретируют его по-разному.

2. Более глубокий анализ GetDefaultColor: Проблема может лежать в реализации функции GetDefaultColor, которая возвращает разные значения для clDefault в зависимости от типа компонента и виджетсета. Предлагается изучить и, возможно, исправить логику GetDefaultColor в lcl/include/control.inc, чтобы она корректно разрешала цвет родителя.

   function TControl.GetDefaultColor(const DefaultColorType: TDefaultColorType): TColor;
begin
Result := TWSControlClass(WidgetSetClass).GetDefaultColor(Self, DefaultColorType);
if (Self.Color = clDefault) and ParentColor and Assigned(Parent) then
Result := Parent.GetDefaultColor(DefaultColorType) // recursion
else if Result = clDefault then
Result := DefColors[DefaultColorType] // backstop
end;

   Эта версия GetDefaultColor рекурсивно поднимается по иерархии компонентов, пока не найдет компонент с явно заданным цветом, или пока не достигнет корневого компонента. Добавлен "backstop" для обработки ситуаций, когда TWSControlClass(WidgetSetClass).GetDefaultColor возвращает clDefault.

3. Влияние тем оформления: Важно учитывать, что проблема может быть связана с конкретной темой оформления рабочего стола. В некоторых темах разница в цветах TForm и TPanel может быть незаметной, а в других - очень выраженной.

4. Специфика виджетсетов: Разные виджетсеты (GTK, Qt, Win32) могут по-разному обрабатывать цвета по умолчанию. Необходимо учитывать эту специфику при разработке универсального решения.

Пример кода для демонстрации проблемы и решения:

unit Unit1;

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Panel1: TPanel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDblClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  ButtonPanel: TPanel; // Was TButtonPanel
begin
  ButtonPanel := TPanel.Create(Form1); // Was TButtonPanel
  with ButtonPanel do
  begin
    Top := Button1.Top + Button1.Height;
    Parent := Form1;
    ShowBevel := False;
    //ShowButtons := [pbOK, pbCancel]; // Was specific to TButtonPanel
    Align := alTop;
    //Color:=Parent.GetDefaultColor(dctBrush);   // fix for wrong background colour - REMOVED to show problem
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  ButtonPanel: TPanel; // Was TButtonPanel
begin
  ButtonPanel := TPanel.Create(Form1); // Was TButtonPanel
  with ButtonPanel do
  begin
    Top := Button2.Top + Button2.Height;
    Parent := Form1;
    ShowBevel := False;
    //ShowButtons := [pbOK, pbCancel]; // Was specific to TButtonPanel
    Align := alTop;
    Color:=Parent.GetDefaultColor(dctBrush);   // fix for wrong background colour - ADDED to fix
  end;
end;

procedure TForm1.FormDblClick(Sender: TObject);
begin
  if Color = clDefault then
    Color := clMoneyGreen
  else
    Color := clDefault;
end;

end.

Рекомендации:

• Протестируйте предложенные решения на разных платформах и виджетсетах.
• Учитывайте влияние тем оформления.
• Если проблема сохраняется, рассмотрите возможность подачи отчета об ошибке в Lazarus.
• Применяйте исправление на уровне TButtonPanel или в DefaultInputDialog для минимизации влияния на другие компоненты.
• Проверьте, как исправление влияет на визуальное отображение Lazarus IDE.

Заключение:

Различия в цветах TForm и TPanel в InputQuery - это неприятный визуальный баг, который может возникнуть в Lazarus при определенных условиях. Предложенное решение с явным заданием цвета фона TButtonPanel может устранить проблему. Однако, для более надежного и универсального решения требуется более глубокий анализ и, возможно, исправление логики GetDefaultColor в LCL. Также, предложенные альтернативные решения и пример кода должны помочь в диагностике и устранении проблемы.

Создано по материалам из источника по ссылке.

В Lazarus, при использовании GTK2, возникает визуальный артефакт в `InputQuery` из-за различий в интерпретации цвета `clDefault` для `TForm` и `TPanel`, что приводит к отображению прямоугольной области другого цвета слева от кнопок "OK" и "Cancel".

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: TGroupBox ::