问题
I have used the code provided in this example How to implement a close button for a TTabsheet of a TPageControl to draw a close button to each tabsheet of a pagecontrol and I have replaced ThemeServices with Style Services inside the code and when applying styles the close button doesn`t show and react in no way. Could anyone point me to a different path o solving this issue. thank you! this is the code of the OnDrawTab event:
procedure TFormMain.PageControlCloseButtonDrawTab(Control: TCustomTabControl;
TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
CloseBtnSize: Integer;
PageControl: TPageControl;
TabCaption: TPoint;
CloseBtnRect: TRect;
CloseBtnDrawState: Cardinal;
CloseBtnDrawDetails: TThemedElementDetails;
begin
PageControl := Control as TPageControl;
if InRange(TabIndex, 0, Length(FCloseButtonsRect) - 1) then
begin
CloseBtnSize := 14;
TabCaption.Y := Rect.Top + 3;
if Active then
begin
CloseBtnRect.Top := Rect.Top + 4;
CloseBtnRect.Right := Rect.Right - 5;
TabCaption.X := Rect.Left + 6;
end
else
begin
CloseBtnRect.Top := Rect.Top + 3;
CloseBtnRect.Right := Rect.Right - 5;
TabCaption.X := Rect.Left + 3;
end;
CloseBtnRect.Bottom := CloseBtnRect.Top + CloseBtnSize;
CloseBtnRect.Left := CloseBtnRect.Right - CloseBtnSize;
FCloseButtonsRect[TabIndex] := CloseBtnRect;
PageControl.Canvas.FillRect(Rect);
PageControl.Canvas.TextOut(TabCaption.X, TabCaption.Y, PageControl.Pages[TabIndex].Caption);
if not UseThemes then
begin
if (FCloseButtonMouseDownIndex = TabIndex) and FCloseButtonShowPushed then
CloseBtnDrawState := DFCS_CAPTIONCLOSE + DFCS_PUSHED
else
CloseBtnDrawState := DFCS_CAPTIONCLOSE;
Winapi.Windows.DrawFrameControl(PageControl.Canvas.Handle,
FCloseButtonsRect[TabIndex], DFC_CAPTION, CloseBtnDrawState);
end
else
begin
Dec(FCloseButtonsRect[TabIndex].Left);
if (FCloseButtonMouseDownIndex = TabIndex) and FCloseButtonShowPushed then
CloseBtnDrawDetails := StyleServices.GetElementDetails(twCloseButtonPushed)
else
CloseBtnDrawDetails := StyleServices.GetElementDetails(twCloseButtonNormal);
StyleServices.DrawElement(PageControl.Canvas.Handle, CloseBtnDrawDetails,
FCloseButtonsRect[TabIndex]);
end;
end;
end;
回答1:
If you are using the vcl styles, you must write a vcl style hook to draw a close button in the tab controls, take a look to the Vcl.Styles.ColorTabs unit (introduced in these articles Creating colorful tabsheets with the VCL Styles, Added border to TTabColorControlStyleHook) to have an idea of what you need to write a style hook like this. Additional to the code to draw the button in the tabs you must handle the WM_MOUSEMOVE and WM_LBUTTONUP messages (in the style hook) to change the state of the button (normal, hot) and detect a click in the close button.
If you have problems implementing the style hook let me know to post a full solution here.
UPDATE
I just wrote this simple style hook to add suport for a close button in the tabsheets.
uses
Vcl.Styles,
Vcl.Themes;
type
TTabControlStyleHookBtnClose = class(TTabControlStyleHook)
private
FHotIndex : Integer;
FWidthModified : Boolean;
procedure WMMouseMove(var Message: TMessage); message WM_MOUSEMOVE;
procedure WMLButtonUp(var Message: TWMMouse); message WM_LBUTTONUP;
function GetButtonCloseRect(Index: Integer):TRect;
strict protected
procedure DrawTab(Canvas: TCanvas; Index: Integer); override;
procedure MouseEnter; override;
procedure MouseLeave; override;
public
constructor Create(AControl: TWinControl); override;
end;
constructor TTabControlStyleHookBtnClose.Create(AControl: TWinControl);
begin
inherited;
FHotIndex:=-1;
FWidthModified:=False;
end;
procedure TTabControlStyleHookBtnClose.DrawTab(Canvas: TCanvas; Index: Integer);
var
Details : TThemedElementDetails;
ButtonR : TRect;
FButtonState: TThemedWindow;
begin
inherited;
if (FHotIndex>=0) and (Index=FHotIndex) then
FButtonState := twSmallCloseButtonHot
else
if Index = TabIndex then
FButtonState := twSmallCloseButtonNormal
else
FButtonState := twSmallCloseButtonDisabled;
Details := StyleServices.GetElementDetails(FButtonState);
ButtonR:= GetButtonCloseRect(Index);
if ButtonR.Bottom - ButtonR.Top > 0 then
StyleServices.DrawElement(Canvas.Handle, Details, ButtonR);
end;
procedure TTabControlStyleHookBtnClose.WMLButtonUp(var Message: TWMMouse);
Var
LPoint : TPoint;
LIndex : Integer;
begin
LPoint:=Message.Pos;
for LIndex := 0 to TabCount-1 do
if PtInRect(GetButtonCloseRect(LIndex), LPoint) then
begin
if Control is TPageControl then
begin
TPageControl(Control).Pages[LIndex].Parent:=nil;
TPageControl(Control).Pages[LIndex].Free;
end;
break;
end;
end;
procedure TTabControlStyleHookBtnClose.WMMouseMove(var Message: TMessage);
Var
LPoint : TPoint;
LIndex : Integer;
LHotIndex : Integer;
begin
inherited;
LHotIndex:=-1;
LPoint:=TWMMouseMove(Message).Pos;
for LIndex := 0 to TabCount-1 do
if PtInRect(GetButtonCloseRect(LIndex), LPoint) then
begin
LHotIndex:=LIndex;
break;
end;
if (FHotIndex<>LHotIndex) then
begin
FHotIndex:=LHotIndex;
Invalidate;
end;
end;
function TTabControlStyleHookBtnClose.GetButtonCloseRect(Index: Integer): TRect;
var
FButtonState: TThemedWindow;
Details : TThemedElementDetails;
R, ButtonR : TRect;
begin
R := TabRect[Index];
if R.Left < 0 then Exit;
if TabPosition in [tpTop, tpBottom] then
begin
if Index = TabIndex then
InflateRect(R, 0, 2);
end
else
if Index = TabIndex then
Dec(R.Left, 2)
else
Dec(R.Right, 2);
Result := R;
FButtonState := twSmallCloseButtonNormal;
Details := StyleServices.GetElementDetails(FButtonState);
if not StyleServices.GetElementContentRect(0, Details, Result, ButtonR) then
ButtonR := Rect(0, 0, 0, 0);
Result.Left :=Result.Right - (ButtonR.Width) - 5;
Result.Width:=ButtonR.Width;
end;
procedure TTabControlStyleHookBtnClose.MouseEnter;
begin
inherited;
FHotIndex := -1;
end;
procedure TTabControlStyleHookBtnClose.MouseLeave;
begin
inherited;
if FHotIndex >= 0 then
begin
FHotIndex := -1;
Invalidate;
end;
end;
Register in this way
TStyleManager.Engine.RegisterStyleHook(TCustomTabControl, TTabControlStyleHookBtnClose);
TStyleManager.Engine.RegisterStyleHook(TTabControl, TTabControlStyleHookBtnClose);
And this is a demo
回答2:
Ive been working on this example, and i got it working on the Metro UI on delphi XE6.
My workaround for getting the correct distance between the Tab name and the button was to modify this line
Result.Left := Result.Right - (ButtonR.Width);
//it was Result.Left := Result.Right - (ButtonR.Width) -5;
And setting a bigger TabWith on the PageController properties.
Also ,remind that the "Register" lines, goes on the Initialization class right before the end of the unit.
//...all the code of the unit
Initialization
TStyleManager.Engine.RegisterStyleHook(TCustomTabControl,
TTabControlStyleHookBtnClose);
TStyleManager.Engine.RegisterStyleHook(TTabControl,
TTabControlStyleHookBtnClose);
end.//final unit "end" =D
来源：https://stackoverflow.com/questions/10531153/close-button-of-a-tabsheet-not-supporting-vcl-styles