delphi – 不支持vcl样式的标签页的关闭按钮
发布时间:2020-12-15 09:40:20 所属栏目:大数据 来源:网络整理
导读:我已经使用了这个例子 How to implement a close button for a TTabsheet of a TPageControl中提供的代码来为一个pagecontrol的每个tabheet绘制一个关闭按钮,我已经在代码中用Style Services替换了ThemeServices,并且在应用样式时,关闭按钮没有显示和反应.任
我已经使用了这个例子
How to implement a close button for a TTabsheet of a TPageControl中提供的代码来为一个pagecontrol的每个tabheet绘制一个关闭按钮,我已经在代码中用Style Services替换了ThemeServices,并且在应用样式时,关闭按钮没有显示和反应.任何人都可以指出我解决这个问题的另一条道路.谢谢!这是OnDrawTab事件的代码:
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,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; 解决方法
如果您使用的是vcl样式,则必须编写一个vcl样式钩子以在选项卡控件中绘制一个关闭按钮,查看
Vcl.Styles.ColorTabs单元(在这些文章
Creating colorful tabsheets with the VCL Styles,Added border to TTabColorControlStyleHook中介绍)以了解您需要什么写一个这样的样式钩子.除了在选项卡中绘制按钮的代码之外,您必须处理WM_MOUSEMOVE和WM_LBUTTONUP消息(在样式挂钩中)以更改按钮的状态(正常,热)并检测关闭按钮中的单击.
如果你在实现样式钩子时遇到问题,请告诉我在这里发布一个完整的解决方案. UPDATE 我刚刚写了这个简单的样式钩子来为标签页中的关闭按钮添加suport. 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,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,Result,ButtonR) then ButtonR := Rect(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; 以这种方式注册 TStyleManager.Engine.RegisterStyleHook(TCustomTabControl,TTabControlStyleHookBtnClose); TStyleManager.Engine.RegisterStyleHook(TTabControl,TTabControlStyleHookBtnClose); 这是一个演示 (编辑:李大同) 【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容! |