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;

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