:: 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;
|
При использовании материала - ссылка на сайт обязательна
|
|