FAQ VCL
Компоненты\PageControl

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как реализовать редактирование заголовка страницы TPageControl в runtime по двойнову клику?

uses
  {...,} Vcl.ComCtrls, Vcl.StdCtrls;

type
  TPageControl = class(Vcl.ComCtrls.TPageControl)
  private
    FEdit: TEdit;
    procedure WMLButtonDblClk(var Msg: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure DoKeyPress(Sender: TObject; var Key: Char);
    procedure DoExit(Sender: TObject);
    procedure ChangeCaption;
  protected
    procedure Change; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

implementation

{ TPageControl }

constructor TPageControl.Create(AOwner: TComponent);
begin
   inherited;
   FEdit := TEdit.Create(Self);
   FEdit.Parent := Self;
   FEdit.OnKeyPress := DoKeyPress;
   FEdit.OnExit := DoExit;
   FEdit.Hide;
end;

destructor TPageControl.Destroy;
begin
   FreeAndNil(FEdit);
   inherited;
end;

procedure TPageControl.Change;
begin
   inherited;
   FEdit.Hide;
end;

procedure TPageControl.ChangeCaption;
begin
   FEdit.BoundsRect := TabRect(TabIndex);
   FEdit.Text := ActivePage.Caption;
   FEdit.Show;
   FEdit.SetFocus;
end;

procedure TPageControl.DoExit(Sender: TObject);
begin
   FEdit.Hide;
end;

procedure TPageControl.DoKeyPress(Sender: TObject; var Key: Char);
begin
   case Key of
      #27: begin
         FEdit.Hide;
         Key := #0;
      end;
      #13: begin
         ActivePage.Caption := FEdit.Text;
         FEdit.Hide;
         Key := #0;
      end;
   end;
end;

procedure TPageControl.WMLButtonDblClk(var Msg: TWMLButtonDblClk);
var
  r: TRect;
begin
   r := TabRect(ActivePageIndex);
   if r.Contains(Point(Msg.XPos, Msg.YPos)) then
      ChangeCaption
   else
      inherited;
end;


Как избавиться от тела страниц в TPageControl, оставив только заголовки?

uses
  {...,} Vcl.ComCtrls;

type
  TPageControl = class(Vcl.ComCtrls.TPageControl)
  protected
    procedure ConstrainedResize(var MinWidth, MinHeight, MaxWidth,
      MaxHeight: Integer); override;
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
  public
    constructor Create(AOwner: TComponent); override;
  end;

implementation

{ TPageControl }

constructor TPageControl.Create(AOwner: TComponent);
begin
   inherited;
   // Выравнивание можно выставить в дизайнере,
   // тогда перегружать конструктор не нужно
   Align := alTop;
end;

procedure TPageControl.WMPaint(var Msg: TWMPaint);
const
{$J+}
  f: Boolean = False;
{$J-}
begin
   inherited;
   // При первом показе PageControl его необходимо обновить, чтобы
   // изменения вступили в силу. Лучшего способа найти не удалось
   if not f then
   begin
      Perform(WM_SYSCOMMAND, SC_MINIMIZE, 0);
      Perform(WM_SYSCOMMAND, SC_RESTORE, 0);
      f := True;
   end;
end;

procedure TPageControl.ConstrainedResize(var MinWidth, MinHeight, MaxWidth,
  MaxHeight: Integer);
begin
   inherited;
   MinHeight := TabRect(0).Height * RowCount + 2;
   MaxHeight := TabRect(0).Height * RowCount + 2;
end;


Как узнать какую страницу в TPageControl собирается активировать пользователь?

uses
  {...,} Vcl.ComCtrls, Winapi.CommCtrl;

type
  TPageControl = class(Vcl.ComCtrls.TPageControl)
  private
    FNewPageIndex, FNotifyIndex: Integer;
  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
    procedure AfterConstruction; override;
    property NewPageIndex: Integer read FNewPageIndex;
  end;

  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    TabSheet5: TTabSheet;
    procedure FormShow(Sender: TObject);
    procedure PageControl1Changing(Sender: TObject; var AllowChange: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

implementation

{ TPageControl }

procedure TPageControl.AfterConstruction;
begin
   inherited;
   FNotifyIndex := 0;
   FNewPageIndex := 0;
end;

function TPageControl.CanChange: Boolean;
begin
   if (GetAsyncKeyState(VK_CONTROL) shr 16) and 1 = 0 then
      FNewPageIndex := GetTabFromCursor
   else
      if (GetAsyncKeyState(VK_LBUTTON) shr 16) and 1 = 1 then
         FNewPageIndex := GetTabFromCursor
      else
         FNewPageIndex := FNotifyIndex;
   Result := inherited CanChange;
end;

procedure TPageControl.CMDialogKey(var Message: TCMDialogKey);
begin
   if (Focused or Winapi.Windows.IsChild(Handle, Winapi.Windows.GetFocus)) then
      if (Message.CharCode = VK_TAB) and ((GetAsyncKeyState(VK_CONTROL) shr 16) and 1 = 1) then
         if ((GetAsyncKeyState(VK_SHIFT) shr 16) and 1 = 1) then
            FNotifyIndex := FindNextPage(ActivePage, False, False).TabIndex
         else
            FNotifyIndex := FindNextPage(ActivePage, True, False).TabIndex;
   inherited;
end;

function TPageControl.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 TPageControl.WMKeyDown(var Message: TWMKey);
begin
   with Message do
   case Message.CharCode of
      VK_LEFT: FNotifyIndex := FindNextPage(ActivePage, False, False).TabIndex;
      VK_RIGHT: FNotifyIndex := FindNextPage(ActivePage, True, False).TabIndex;
   end;
   inherited;
end;

{ TForm1 }

procedure TForm1.FormShow(Sender: TObject);
begin
   Caption := 'Активна страница №' + IntToStr(PageControl1.TabIndex);
end;

procedure TForm1.PageControl1Changing(Sender: TObject;
  var AllowChange: Boolean);
begin
   with Sender as TPageControl do
      Form1.Caption := 'Переход со страницы ' + IntToStr(ActivePageIndex) +
                       ' на страницу ' + IntToStr(NewPageIndex);
end;


Как скрыть вкладку в TPageControl?

// Способ первый
type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    {...}
  end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   TabSheet1.TabVisible := False;
end;

// Способ второй
procedure TForm1.Button1Click(Sender: TObject);
begin
   PageControl1.Pages[0].TabVisible := False;
end;

При использовании материала - ссылка на сайт обязательна