Любопытный специфический баг

[А.Н.]

Есть форма со стринггридом и парой кнопок: "Ok", "Отмена".
При выборе в гриде строки и нажатии "Ok", в родительской форме устанавливается серия/номер, и всё работает.

Но, при выборе строки двойным щелчком по гриду, в родительской форме перестают работать все SpeedButton'ы.

Код по dblclik:

Код: Выделить всё

procedure TfrmBlankContracts.strgridPolisesDblClick(Sender: TObject);
begin
  sbtnOk.Click();
end;


Покликав по вкладкам pagecontrol в родительской форме, функциональность Speedbutton'ов возможно восстановить.

Это странно. Может, кто знает как это лечится?

[Brainenjii]

Привести к виду

Код: Выделить всё

    procedure TfrmBlankContracts.strgridPolisesDblClick(Sender: TObject);
    begin
      sbtnOkClick(sbtnOk);
    end;


?

[А.Н.]

Не работает. Всё также.

[Odyssey]

А если вынести содержимое sbtnOkClick в отдельную процедуру и вызывать её и из sbtnOkClick, и из strgridPolisesDblClick? И если используется принудительное закрытие формы, может быть заменить его на установку ModalResult?

[А.Н.]

Весь код этой процедуры:

Код: Выделить всё

//---------------------------------------------------------------------------
procedure TfrmBlankContracts.sbtnPanelClick(Sender: TObject);
begin
  if (Sender = sbtnOk) then
    begin
      with strgridPolises do
        FPolis := Rows[Row].Objects[0] as TBlankEntity;
      ModalResult := mrOK;
    end
  else if (Sender = sbtnCancel) then
    begin
      ModalResult := mrCancel;
    end;
end;
//---------------------------------------------------------------------------


Т.е., просто нечего выносить. Но, что интересно, проявляется эта ошибка всегда, при двойном клике и ни разу не проявлялась, при просто нажатии на кнопку.

Добавлено спустя 51 секунду:
Ну, и принудительного закрытия, как следует, не используется.

[Odyssey]

Хм, тогда предлагаю попробовать скопипастить код в обработчик грида, и посмотреть проявится ошибка или нет. И тогда, возможно, в багтрекер с примером

[А.Н.]

Хм, тогда предлагаю попробовать скопипастить код в обработчик грида, и посмотреть проявится ошибка или нет.

В смысле, "в обработчик грида"?
Вся форма выглядит так:

Код: Выделить всё

unit blank_contracts;

{$mode objfpc}{$H+}

//
// Окно выбора пустого бланка.
//

interface

uses
  Classes, SysUtils, variants, FileUtil, LResources, Forms, Controls, Graphics,
  Dialogs, ExtCtrls, Buttons, ComCtrls, Grids, StdCtrls, strings_l10n,
  common_functions, data_unit, orm_infos_inscompany;

type

  { TfrmBlankContracts }

  TfrmBlankContracts = class(TForm)
    gbInsCompanyBlanks: TGroupBox;
    pnBottom: TPanel;
    pnHead: TPanel;
    sbarMain: TStatusBar;
    sbtnCancel: TSpeedButton;
    sbtnOk: TSpeedButton;
    strgridPolises: TStringGrid;
    procedure FormShow(Sender: TObject);
    procedure sbtnPanelClick(Sender: TObject);
    procedure strgridPolisesDblClick(Sender: TObject);
    procedure strgridPolisesHeaderClick(Sender: TObject; IsColumn: Boolean;
      Index: Integer);
  private
    FInsCompany: TInfInsCompany;
    FPolis: TBlankEntity;
  public
    property InsCompany: TInfInsCompany read FInsCompany write FInsCompany;
    property Blank: TBlankEntity read FPolis;
  end;

var
  frmBlankContracts: TfrmBlankContracts;

implementation
//---------------------------------------------------------------------------
procedure TfrmBlankContracts.FormShow(Sender: TObject);
var i: integer;
begin
  if (InsCompany = nil) then
    begin
      ModalResult := mrAbort;
      Visible     := false;
      exit;
    end;
  FPolis                      := nil;
  gbInsCompanyBlanks.Caption  := AnsiToUtf8(blank_sel_inscmp_hdr) + '`' +
    VarToStr(FInsCompany.InsCompanyName) + '`';

  with (strgridPolises) do
    begin
      Clean(0, 1, 1, RowCount - 1, [gzNormal, gzInvalid]);
      // Один ряд фиксирован.
      RowCount := InsCompany.Blanks.Count + 1;
    end;

  for i := 0 to InsCompany.Blanks.Count - 1 do
    begin
      with (strgridPolises) do
        begin
          Rows[i + 1].AddObject((InsCompany.Blanks[i] as TBlankEntity).DogSer,
            InsCompany.Blanks[i]);
          Cells[1, i + 1] :=
            VartoStr((InsCompany.Blanks[i] as TBlankEntity).DogNum);
        end;
    end;
end;
//---------------------------------------------------------------------------
procedure TfrmBlankContracts.sbtnPanelClick(Sender: TObject);
begin
  if (Sender = sbtnOk) then
    begin
      with strgridPolises do
        FPolis := Rows[Row].Objects[0] as TBlankEntity;
      ModalResult := mrOK;
    end
  else if (Sender = sbtnCancel) then
    begin
      ModalResult := mrCancel;
    end;
end;
//---------------------------------------------------------------------------
procedure TfrmBlankContracts.strgridPolisesDblClick(Sender: TObject);
begin
  sbtnOk.OnClick(sbtnOk);
end;
//---------------------------------------------------------------------------
procedure TfrmBlankContracts.strgridPolisesHeaderClick(Sender: TObject;
  IsColumn: Boolean; Index: Integer);
begin
  GridSort(strgridPolises, Index);
end;
//---------------------------------------------------------------------------
initialization
  {$I blank_contracts.lrs}

end.


Это код вызова:

Код: Выделить всё

  else if (Sender = sbtnPolisSelect) then
  // Пустой бланк полиса.
    begin
      with (cbInsCompany) do
        begin
          if (Items.Objects[ItemIndex] = nil) then exit;
          (Target as TContractEntity).IDInsuranceCompany :=
            (Items.Objects[ItemIndex] as TInfInsCompany).IDInsCompany;
          frmBlankContracts.InsCompany :=
            Items.Objects[ItemIndex] as TInfInsCompany;
        end;

      if (frmBlankContracts.ShowModal() = mrOK) then
        begin
          if (frmBlankContracts.Blank = nil) then exit;
          with (frmBlankContracts.Blank) do
            begin
              if (not BlankReserve()) then
                begin
                  MessageDlg(AnsiToUTF8(cls_error),
                    AnsiToUTF8(contract_mgr_msg_blank_err), mtError, [mbOK], '');
                  exit;
                end;
              edPolisSer.Text                     := VarToStr(DogSer);
              edPolisNum.Text                     := VarToStr(DogNum);
              (Target as TContractEntity).DogSer  := edPolisSer.Text;
              (Target as TContractEntity).DogNum  := edPolisNum.Text;
            end;
        end; // if (mrOk)
    end // if (Sender = sbtnPolisSelect)


[Odyssey]

Так:

Код: Выделить всё

procedure TfrmBlankContracts.strgridPolisesDblClick(Sender: TObject);
begin
  with strgridPolises do
    FPolis := Rows[Row].Objects[0] as TBlankEntity;
  ModalResult := mrOK;
end;

Если баг сохранится (что довольно вероятно) было бы здорово воспроизвести его на простейшем примере с формой и гридом и зарепортить всё это.

[А.Н.]

Не работает.
Кстати:
1. Наведение на кнопки работает. Т.е., они подсвечиваются и всё-такое.
2. Не нажимаются, вообще. Т.е., даже эффекта нажатия нет.
3. Однократная смена вкладок не спасает. Но после многократной смены, кнопки начинают работать.

Попробую чуть позже воспроизвести. Но у меня есть сомнения.
Структура вызывающей (главной) формы достаточно сложная. Может зависеть от этого.
3-4 уровня иерархии контролов. Ещё там неправильно работает компонент TZVDatetimePicker.
Не показывает время. Переместил на уровень выше - стал показывать. Хотя это и неправильно. К тому же, проблемы с taborder, но работает, с грехом пополам.