如何在tpagecontrol 上的tabsheet 右上角画个叉(50分)

  • 主题发起人 sefeng1982
  • 开始时间
S

sefeng1982

Unregistered / Unconfirmed
GUEST, unregistred user!
如何在tpagecontrol 上的tabsheet 右上角画个叉,然后又能相应按钮的事件?
 
放个IMAGE
如果被挡住,可以把所有标签隐藏,用TabControl控制,边上可以放
 
第三方控件有带叉的。
 
把PageControl的OwnerDraw设为TRUE
然后处理PageControl的OnDrawTab和OnMouseDown事件如下
procedure TForm1.PageControl1DrawTab(Control: TCustomTabControl;
TabIndex: Integer;
const Rect: TRect;
Active: Boolean);
var
TextRect, BtnRect : TRect;
l : Integer;
Text :string;
begin

BtnRect := Rect;
l := (BtnRect.Bottom - BtnRect.Top) div 4;
Inc(btnRect.Top, l);
Dec(btnRect.Bottom, l);
Dec(BtnRect.Right,l);
BtnRect.Left := BtnRect.Right - (BtnRect.Bottom - BtnRect.Top);
TextRect := Rect;
TextRect.Right := BtnRect.Left;
InflateRect(TextRect, -2, 0);
Text := TPageControl(Control).Pages[TabIndex].Caption;
DrawText(Control.Canvas.Handle, PChar(Text), -1, TextRect, DT_LEFT or DT_VCENTER or DT_SINGLELINE);
DrawFrameControl(Control.Canvas.Handle, BtnRect, DFC_CAPTION, DFCS_CAPTIONCLOSE);
end;

procedure TForm1.PageControl1MouseDown(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
var
TabRect,BtnRect : TRect;
l : Integer;
pg : TPageControl;
begin
pg := TPageControl(Sender);
TabRect := pg.TabRect(pg.ActivePageIndex);
BtnRect := TabRect;
l := (BtnRect.Bottom - BtnRect.Top) div 4;
Inc(btnRect.Top, l);
Dec(btnRect.Bottom, l);
Dec(BtnRect.Right,l);
BtnRect.Left := BtnRect.Right - (BtnRect.Bottom - BtnRect.Top);
if PtInRect(BtnRect, Point(X, Y))and
(Application.MessageBox(PChar(Format('你真的决定关闭标签"%s"吗',[pg.ActivePage.Caption])),'', MB_OKCANCEL) = MROK) then
begin
pg.ActivePage.Free();
end;

//
end;
 
wr出手,果然 不同。
 
顶部