На главную
ПРАВИЛА FAQ Помощь Участники Календарь Избранное DigiMania RSS
msm.ru
Модераторы: Rouse_, jack128, Krid
  
    > Блокирование закладок TPageControl
      Небольшой наследник:
      ExpandedWrap disabled
        unit GSPageControl;
         
        interface
         
        uses
          Windows, Messages, Types, SysUtils, Classes, Controls, ComCtrls, CommCtrl;
         
        type
          TGSPageControl = class(TPageControl)
          private
            FNewPageIndex, FNotifyIndex: Integer;
            FTab:boolean;
          protected
            function GetTabFromCursor: Integer;
            function CanChange: Boolean; override;
            procedure WMKeyDown(var Message: TWMKey); message WM_KEYDOWN;
            procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
          public
            property NewPageIndex: Integer read FNewPageIndex;
            constructor Create(AOwner: TComponent); override;
          end;
         
        procedure Register;
         
        implementation
         
        procedure Register;
        begin
          RegisterComponents('Samples', [TGSPageControl]);
        end;
         
        { TGSPageControl }
         
        function TGSPageControl.CanChange: Boolean;
        begin
          if fTab then FNewPageIndex:=FNotifyIndex else
          FNewPageIndex := GetTabFromCursor;
          if FNewPageIndex = -1 then
            FNewPageIndex := FNotifyIndex;
          Result := inherited CanChange;
          FNewPageIndex := -1;
          fTab:=false;
        end;
         
        procedure TGSPageControl.CMDialogKey(var Message: TCMDialogKey);
        begin
          fTab:=true;
          if (Focused or Windows.IsChild(Handle, Windows.GetFocus)) and
            (Message.CharCode = VK_TAB) and (GetKeyState(VK_CONTROL) < 0) then
            FNotifyIndex := FindNextPage(ActivePage, True, False).TabIndex;
          inherited;
        end;
         
        constructor TGSPageControl.Create(AOwner: TComponent);
        begin
          inherited;
          FNotifyIndex := 0;
          FNewPageIndex := 0;
          FTab:=false;
        end;
         
        function TGSPageControl.GetTabFromCursor: Integer;
        var
          HitTestInfo: TTCHitTestInfo;
          P: TPoint;
        begin
          GetCursorPos(P);
          HitTestInfo.pt := Self.ScreenToClient(P);
          HitTestInfo.flags := TCHT_ONITEM;
          Result := SendMessage(Self.Handle, TCM_HITTEST, 0, Integer(@HitTestInfo));
        end;
         
        procedure TGSPageControl.WMKeyDown(var Message: TWMKey);
        begin
          with Message do
            case Message.CharCode of
              37: FNotifyIndex := FindNextPage(ActivePage, False, False).TabIndex;
              39: FNotifyIndex := FindNextPage(ActivePage, True, False).TabIndex;
            end;
          inherited;
        end;
         
        end.


      Использование:
      ExpandedWrap disabled
        procedure TForm1.GSPageControl1Changing(Sender: TObject;
          var AllowChange: Boolean);
        begin
         AllowChange:=GSPageControl1.Pages[GSPageControl1.NewPageIndex].Enabled
        end;


      Авторы: Rouse_, Krid
        Решение обсуждалось в этой теме:
        TpageControl, чтобы Tab не нажимался
        0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
        0 пользователей:


        Рейтинг@Mail.ru
        [ Script Execution time: 0,0885 ]   [ 18 queries used ]   [ Generated: 21.11.19, 06:46 GMT ]