Как интегрировать календарь в TValueListEditor

Бес в ребро мне сунул TValueListEditor: смотри, говорит, как мало места всё будет занимать, как стройненько всё смотрится и это всё простыми штатными средствами! Накидал я тестовый проект - показалось это мне действительно мило.

БЫЛО и СТАЛО:

Да только вот беда - после использования TDateTimePicker редактировать дату в отдельном диалоге - ну, как-то не comme il faut. А что делать?

Погуглил я - люди советуют показывать свой редактор в нужном месте в нужный момент, подменяя встроенный InplaceEditor. При этом поведение такого контрола надо очень сильно обрезать, чтобы клавиатурные реакции у него согласовывались с TValueListEditor. Но тогда уж не проще ли вообще свой компонент писать? Или поискать готовый?

Сторонних компонентов искать я не захотел (с обоснованием причин), а попробовал TMonthCalendar высунуть, как примерно это с TCustomListBox сделано в TInplaceEditList. Но TMonthCalendar категорически не захотел клавиатуру перехватывать. У него вообще с фокусом беда: он его получает только по Tab, когда свойство TabStop включено. А мышкой - хоть дырку в экране протыкай - никак. Поэтому, наверно, по дефолту TabStop и выключено.

Стало быть, напрашивается компромиссный вариант: положить TMonthCalendar на отдельную форму (я даже FormStyle=fsStayOnTop поставил) без заголовка и без рамочки и светить её в нужном месте. У формы на деактивацию (это когда мышкой мимо щёлкнули) и ESC (KeyPreview=True, OnKeyPress=FormKeyPress) вешаем закрытие Close.

Штатно после броска на форму календарь имеет серые поля по бокам. Я поджал его до квадратного состояния и при создании формы обжимаю её вокруг календаря (BoundsRect := MonthCalendar1.BoundsRect;). Теперь стало похоже на  TDateTimePicker. Замечу, что создатели Object Inspector поступают иначе - рисуют окно по ширине поля редактирования и раскрывают календарь в середине насколько возможно широко, т.е. видны серые поля по бокам, но зато могут появится дополнительные месяцы:

Ещё одно отличие между TDateTimePicker и Object Inspector в том, что у первого календарик выпадает слева, т.е. "в начале поля", а у второго - справа, ближе к кнопке. Я попробовал и так и так, и выбрал второй вариант выравнивая, оставив простой одномесячный размер календаря.

type
  //Access ToInplaceEditor
  TVLE = class(Vcl.ValEdit.TValueListEditor)  end;
 
procedure PopUp( AVLE: TValueListEditor; ACalBack: TProc<Boolean,TDateTime> );
var
  H: Integer;
  R: TRect;
begin
  with TfrmCalendar.Create( Application ) do begin
    FVLE := AVLE; //Save for FormClose
    FCallBack := ACalBack;
    Date := StrToDateDef( FVLE.Cells[ 1, FVLE.Row ], System.SysUtils.Date );
    BoundsRect := MonthCalendar1.BoundsRect; //No space around Calendar
    TVLE( FVLE ).InplaceEditor.Enabled := False; //No click on edit button
    R := AVLE.CellRect( AVLE.Col, AVLE.Row ); //Locstion of current editor
    H := R.Height;
    R.TopLeft := FVLE.{We are in other form}ClientToScreen( R.BottomRight );
    if R.Top + Height > Screen.Height
    then
      R.Top := R.Top - Height - H;
    Top := R.Top;
    Left := R.Left - Width;
    Show;
  end;
end;

Мне, правда, понадобился "хитрый хакерский залом", чтобы при деактивации окна мышкой, тыкающей на гриде снова в кнопку открытия календаря, календарь просто закрывался и не появлялся бы снова. Для избежания повторного открытия календаря я дизаблю TValueListEditor.InplaceEditor вместе с его кнопкой редактирования. А поскольку InplaceEditor - не публичное свойство, я TValueListEditor оборачиваю в наследника, который даёт мне пользоваться в текущем модуле своими protected свойствами. Ну, а что делать?

Ещё момент немножко скользкий такой есть: когда по ESC закрываем форму, то сначала срабатывает FormClose, а потом FormDeactivate, который снова готов вызвать FormClose. Так-то ничего страшного, но ситуация подозрительная. Поэтому в FormClose я поднимаю флаг, установив Tag := 1, а в FormDeactivate я этот флаг проверяю.

procedure TfrmCalendar.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Tag := 1; //InClose
  Action := caFree;
  TVLE( FVLE ).InplaceEditor.Enabled := True;
  if FOK then
    FVLE.Cells[ 1, FVLE.Row ] := DateToStr( Date );
  if Assigned( FCallBack ) then
    FCallBack( FOK, Date );
end;
 
procedure TfrmCalendar.FormDeactivate(Sender: TObject);
begin
  if Tag = 0 then
    Close;
end;
 

И всё? А вот и нет! А как поймать выбор даты? Как узнать, что пользователь бегал-бегал по календарю, выбирал-выбирал и вот - выбрал? Простой OnClick срабатывает на всё, что ни попадя, включая смену режима отображения. Где же событие OnSelect? Нету! Забыли сделать!

Снова не обойтись без "хакерства":

type
  TMonthCalendar = class( Vcl.ComCtrls.TMonthCalendar )
    procedure CNNotify(var Message: TWMNotifyMC); message CN_NOTIFY;
  end;
 
  TfrmCalendar = class(TForm)
    MonthCalendar1: TMonthCalendar;
    procedure FormKeyPress(Sender: TObject; var Key: Char);
...
procedure TfrmCalendar.WMClose(var Message: TMessage);
begin
  FOK := Message.WParam <> 0;
  inherited;
end;
 
function IsBlankSysTime(const ST: TSystemTime): Boolean;
type
  TFast = array [0..3] of DWORD;
begin
  Result := (TFast(ST)[0] or TFast(ST)[1] or TFast(ST)[2] or TFast(ST)[3]) = 0;
end;
 
{ TMonthCalendar }
 
procedure TMonthCalendar.CNNotify(var Message: TWMNotifyMC);
begin
  inherited;
  if ( Message.NMHdr^.code =  MCN_SELECT )
  and not IsBlankSysTime( Message.NMSelChange^.stSelStart )
  and Assigned( Parent )
  then
    PostMessage( Parent.Handle, WM_CLOSE, 1, 0 );
end;
 

Ф-ю IsBlankSysTime я честно выпилил из исходников TMonthCalendar.

Добавим теперь в TValueListEditor (он у меня называется vle) инициализацию кнопки и обработчик события.

procedure Tgsm2gd_main.FormCreate(Sender: TObject);
var
  K: uSettings.TKey;
begin
  laVersion.Caption :=  'Версия: ' + GetVersionInfoText;
  for K := Low( TKey ) to High( TKey ) do begin
...
    with vle.ItemProps[ Integer( K ) ] do begin
...
      case K of
        uSettings.WildCards, uSettings.Date:
          EditStyle := esEllipsis;
...
        else
          EditStyle := esSimple;
      end;
    end;
  end;
end;
 
{ TValueListEditor }
 
procedure Tgsm2gd_main.vleEditButtonClick(Sender: TObject);
...
begin
  case uSettings.TKey( vle.Row ) of
    uSettings.Date: uCalendar.PopUp( vle );
    uSettings.WildCards: WildCardsEdit;
  end;
end;

И получаем вполне приемлемый вариант ввода даты в TValueListEditor.

Конечно, валидация у TValueListEditor не слишком надёжная. Но это уже другая песня.

ЗЫ: Исходники здесь: https://github.com/alhymov/VleMonCal.git