Delphi. Запрет перехода на определенный TabSheet в PageControl по неизвестному заранее условию...

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

  PageControl содержит события OnChanging и OnChange, которые возникают до и после перехода. Часто советуют запомнить индекс активной страницы в OnChanging, в OnChange проверить условие и если не удовлетворяет, вернуться к сохраненному индексу. Но этот совет иногда неприемлем, если например при активации TabSheet начинает работать код, который при определенных условиях приводит к краху программы. Чтобы заранее проверить данные на валидность необходимо в OnChanging знать индекс следующего TabSheet. При этом следует учитывать, что переход по вкладкам в PageControl может происходить несколькими способами:

  • из кода;
  • через щелчок мышки;
  • через комбинации Ctrl+Tab и Ctrl+Shift+Tab;
  • клавишами <- и ->;
  • комбинацией клавиш Alt+буква, если на корешке вкладки есть акселератор;

Привожу наследника TPageControl, который решает подобные проблемы.

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, StdCtrls, ComCtrls;

type
  TPageDirect = (pdProg, pdMouse, pdKey, pdAltTab, pdAccel);
  TPageChangingEvent = procedure(Sender: TObject; 
    NewIndex: LongInt; Direct: TPageDirect; var AllowChange: Boolean) of object;

  TArhPageControl = class(TPageControl)
  private
    FMouseIdx, FKeyIdx: LongInt;
    FOnPageChanging: TPageChangingEvent;
    procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  protected
    function DoPageChanging(NewIndex: LongInt; Direct: TPageDirect): Boolean; dynamic;
    procedure SetTabIndex(Value: Integer); override;
    function CanChange: Boolean; override;
  public
  published
    property OnPageChanging: TPageChangingEvent read FOnPageChanging write FOnPageChanging;
  end;

implementation

function TArhPageControl.DoPageChanging(NewIndex: LongInt; Direct: TPageDirect): Boolean;
begin
  if [csLoading, csReading] * ComponentState <> [] then Exit;
  Result := True;
  if Assigned(FOnPageChanging) then FOnPageChanging(Self, NewIndex, Direct, Result);
end;

function TArhPageControl.CanChange: Boolean;
var 
  Pt: TPoint;
begin
  GetCursorPos(Pt);
  Pt := ScreenToClient(Pt);
  FMouseIdx := IndexOfTabAt(Pt.x, Pt.y);
  if FMouseIdx < 0 then begin
    Result := True;
    FMouseIdx := SendMessage(Handle, TCM_GETCURSEL, 0, 0);
  end else Result := DoPageChanging(FMouseIdx, pdMouse);
  Result := Result and inherited CanChange;
end;

procedure TArhPageControl.CMDialogKey(var Message: TCMDialogKey);
var
  Index: LongInt;
begin
  if (Focused or Windows.IsChild(Handle, Windows.GetFocus)) and
    (Message.CharCode = VK_TAB) and (GetKeyState(VK_CONTROL) < 0) then
  begin
    Index := ActivePageIndex;
    if (GetKeyState(VK_SHIFT) >= 0) then Inc(Index) else Dec(Index);
    if Index < 0 then Index := 0
    else 
      if Index >= PageCount then Index := Pred(PageCount);
    if DoPageChanging(Index, pdAltTab) then ActivePageIndex := Index;
    Message.Result := 1;
  end else Broadcast(Message);  // TWinControl
end;

procedure TArhPageControl.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  FKeyIdx := SendMessage(Handle, TCM_GETCURSEL, 0, 0);
  inherited;
end;

procedure TArhPageControl.CMDialogChar(var Message: TCMDialogChar);
var
  I: LongInt;
begin
  for I := 0 to Pred(Tabs.Count) do
    if IsAccel(Message.CharCode, Tabs[I]) and CanShowTab(I) and CanFocus then
    begin
      Message.Result := 1;
      if DoPageChanging(I, pdAccel) and inherited CanChange then
      begin
        SendMessage(Handle, TCM_SETCURSEL, I, 0) // установка акселератором
        Change;
      end;
      Exit;
    end;
  Broadcast(Message);  // TWinControl
end;

procedure TArhPageControl.SetTabIndex(Value: Integer);
var
  Index: LongInt;
begin
  Index := SendMessage(Handle, TCM_GETCURSEL, 0, 0);
  if Value <> Index then begin
    if FKeyIdx < 0 then begin
      if DoPageChanging(Value, pdProg) then inherited SetTabIndex(Value); // програмная установка
    end else  inherited SetTabIndex(Value); // установка через Alt+Tab
  end else begin
    if FMouseIdx <> FKeyIdx then
      inherited SetTabIndex(Value) // установка через щелчок мышки
    else 
    if DoPageChanging(Value, pdKey) then inherited SetTabIndex(Value)// установка кнопками <- и ->
    else inherited SetTabIndex(FMouseIdx); 
  end;
  FKeyIdx := -1;
end;
 

  Событие OnPageChanging вызывается перед переходом любым способом на следующую страницу (и перед событием OnChanging), в параметре NewIndex передается индекс следующей страницы, Direct — способ перехода.

  Есть один баг, который у меня ни на что не влиял, я не стал дорабатывать.
При нажатии любой клавиши процедура WMGetDlgCode запоминает в переменной FKeyIdx индекс текущей страницы. Если после нажатия произойдет программный переход, DoPageChanging не вызовется.

P.S. Принцип решения подойдет и для С++ Builder, компилятор у них один.

P.P.S. Обнаружил, что при программной смене страниц (из кода) события OnChanging и OnChange не вызываются вообще. А мой предикат OnPageChanging вызывается. Программа разрастается, некоторым страницам PageControl соответствует свой TFrame с инструментами управлением просмотром (не у всех). Самым логичным мне представлялось убить соответствующий TFrame (если он есть) перед переходом на следующую страницу (OnChanging), и создать новый (OnChange) если требуется. Но в Delphi7 при програмном переходе эти события не вызываются, пришлось доработать свой код для устранения этого недостатка.
Т.к. OnPageChanging перед сменой страницы вызывается стабильно, необходимо было решить проблему с невызовом OnChange после смены страницы из кода. Это оказалось несложно:

procedure TArhPageControl.SetTabIndex(Value: Integer);
var
  Index: LongInt;
begin
  Index := SendMessage(Handle, TCM_GETCURSEL, 0, 0);
  if Value <> Index then begin
    if FKeyIdx < 0 then // програмная установка
      if DoPageChanging(Value, pdProg) then begin
        inherited SetTabIndex(Value);
        InheritedChange; // вызов OnChange
      end
    else  inherited SetTabIndex(Value); // установка через Alt+Tab
  end else begin
    if FMouseIdx <> FKeyIdx then
      inherited SetTabIndex(Value) // установка через щелчок мышки
    else
    if DoPageChanging(Value, pdKey) then inherited SetTabIndex(Value)
    else inherited SetTabIndex(FMouseIdx); // установка кнопками <- и ->
  end;
  FKeyIdx := -1;
end;

Вместо самописной проседуры

procedure TArhPageControl.InheritedChange;
type
  PClass = ^TClass;
var
  ClassOld: TClass;
begin
  ClassOld := PClass(Self)^;
  PClass(Self)^ := Self.ClassParent.ClassParent; // TabControl
  Change;
  PClass(Self)^ := ClassOld;
end;

вполне можно использовать доступный PageControl.Change. Я не стал этого делать по причине перегруженности метода PageControl.Change посторонними действиями. Мне показалось более логичным вызвать метод «дедушки» TabControl.Change.
  • +1
  • 28 марта 2016, 19:19
  • anakost

Комментарии (9)

RSS свернуть / развернуть
Специально залез узнать как запрограммировать «неизвестное заранее условие»… Облом-с…
0
Условие заранее неизвестно в Design-time, валидность должна проверяться в Run-time до перехода на следующую страницу, соответственно и программируется, как то так…
0
Про дизайнтайм уже ответил коллега anakost .

Если Вас интересует изменение условий в рантайме — то можно это сделать через указатель на функцию предикат (честно говоря, не знаю как это правильно в Делфи называется).

Клас хранит указатель на функцию, и вызывает ее для проверки возможности перехода. А сама функция задается в рантайме.
0
Предикатом и является событие OnPageChanging, в Design-time пишется его код, вызывается оно в Run-time и проверяет возможность перехода. Обработчик для OnPageChanging можно назначить/переназначить и в Run-time. Если назначить ему nil, оно не пройдет проверку
if Assigned(FOnPageChanging)
и не вызовется.
0
Тогда прошу прощения, я неправильно понял Ваш код (очень плохо знаю Делфи). Мне показалось, что предикат в рантайме изменить нельзя.
0
Само событие уже описано в коде и изменить его код нельзя, но можно отключить одно и подключить другое, главное чтобы они соответствовали описанию TPageChangingEvent. И так сколько угодно.
Но я имел в виду несколько другую ситуацию. Чтобы было понятнее опишу более подробно. На одной странице TabSheet у меня расположен DBGrid, который отображает данные архива регулятора-регистратора ТРИМ. На другом TabSheet расположен DBChart, отображающий те же данные в графическом виде. И к сожалению ТРИМ грешит ошибками при создании архивных файлов (он их пишет на флешку).
И если DBGrid в месте ошибки пишет NAN — «Not a number», попытка открыть вкладку с DBChart приводит к краху программы.
Поэтому и возникла необходимость еще до активации вкладки проверить данные на валидность, и если необходимо, запретить переход на нее:
0
Нашел глюк, дополнил.
0
В концепции?
Разрешение перехода на определенный TabSheet в PageControl по известному заранее условию…
всё что не разрешено = запрещено :)
0
Не смог понять ход мысли.
Стандартному PageControl до фонаря ваши условия, они заданы MS изначально. Мой код лишь враппер над стандартным компонентом.
Я против такого хакинга, но иногда без него не обойтись…
0
Только зарегистрированные и авторизованные пользователи могут оставлять комментарии.