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;
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.
Использование:
Code:
procedure TForm1.GSPageControl1Changing(Sender: TObject;
var AllowChange: Boolean);
begin
AllowChange:=GSPageControl1.Pages[GSPageControl1.NewPageIndex].Enabled
end;
Статья Блокирование закладок TPageControl раздела Компоненты и Классы Вкладки и Страницы может быть полезна для разработчиков на Delphi и FreePascal.
Комментарии и вопросы
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.