एक संभावित समाधान PaintWindow को TPageControl के मालिक के उपयोग के बजाय 0rविधि को ओवरराइड करता है, इस तरह आप टैब के प्रत्येक दृश्य पहलू को नियंत्रित कर सकते हैं।
इस मूल नमूना को जांचें।
type
TPageControl = class(Vcl.ComCtrls.TPageControl)
private
FColorTextTab: TColor;
procedure DrawTab(LCanvas: TCanvas; Index: Integer);
procedure DoDraw(DC: HDC; DrawTabs: Boolean);
procedure SetColorTextTab(const Value: TColor);
protected
procedure PaintWindow(DC: HDC); override;
published
property ColorTextTab : TColor read FColorTextTab write SetColorTextTab;
end;
TForm1 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
CheckBox1: TCheckBox;
Button2: TButton;
Button3: TButton;
Button4: TButton;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
TabSheet5: TTabSheet;
TabSheet6: TTabSheet;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
Math,
Themes,
Types;
type
TCustomTabControlClass = class(TCustomTabControl);
procedure AngleTextOut2(Canvas: TCanvas; Angle: Integer; X, Y: Integer; const Text: string);
var
NewFontHandle, OldFontHandle: hFont;
LogRec: TLogFont;
begin
GetObject(Canvas.Font.Handle, SizeOf(LogRec), Addr(LogRec));
LogRec.lfEscapement := Angle * 10;
LogRec.lfOrientation := LogRec.lfEscapement;
NewFontHandle := CreateFontIndirect(LogRec);
OldFontHandle := SelectObject(Canvas.Handle, NewFontHandle);
SetBkMode(Canvas.Handle, TRANSPARENT);
Canvas.TextOut(X, Y, Text);
NewFontHandle := SelectObject(Canvas.Handle, OldFontHandle);
DeleteObject(NewFontHandle);
end;
{ TPageControl }
procedure TPageControl.DrawTab(LCanvas: TCanvas; Index: Integer);
var
LDetails : TThemedElementDetails;
LImageIndex : Integer;
LThemedTab : TThemedTab;
LIconRect : TRect;
R, LayoutR : TRect;
LImageW, LImageH, DxImage : Integer;
LTextX, LTextY: Integer;
LTextColor : TColor;
//draw the text in the tab
procedure DrawControlText(const S: string; var R: TRect; Flags: Cardinal);
var
TextFormat: TTextFormatFlags;
begin
LCanvas.Font := Font;
TextFormat := TTextFormatFlags(Flags);
LCanvas.Font.Color := LTextColor;
StyleServices.DrawText(LCanvas.Handle, LDetails, S, R, TextFormat, LCanvas.Font.Color);
end;
begin
//get the size of tab image (icon)
if (Images <> nil) and (Index < Images.Count) then
begin
LImageW := Images.Width;
LImageH := Images.Height;
DxImage := 3;
end
else
begin
LImageW := 0;
LImageH := 0;
DxImage := 0;
end;
R := TabRect(Index);
//check the left position of the tab.
if R.Left < 0 then Exit;
//adjust the size of the tab to draw
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);
LCanvas.Font.Assign(Font);
LayoutR := R;
LThemedTab := ttTabDontCare;
//Get the type of the active tab to draw
case TabPosition of
tpTop:
begin
if Index = TabIndex then
LThemedTab := ttTabItemSelected
else
{
if (Index = HotTabIndex) and MouseInControl then
LThemedTab := ttTabItemHot
else
}
LThemedTab := ttTabItemNormal;
end;
tpLeft:
begin
if Index = TabIndex then
LThemedTab := ttTabItemLeftEdgeSelected
else
{
if (Index = HotTabIndex) and MouseInControl then
LThemedTab := ttTabItemLeftEdgeHot
else
}
LThemedTab := ttTabItemLeftEdgeNormal;
end;
tpBottom:
begin
if Index = TabIndex then
LThemedTab := ttTabItemBothEdgeSelected
else
{
if (Index = HotTabIndex) and MouseInControl then
LThemedTab := ttTabItemBothEdgeHot
else
}
LThemedTab := ttTabItemBothEdgeNormal;
end;
tpRight:
begin
if Index = TabIndex then
LThemedTab := ttTabItemRightEdgeSelected
else
{
if (Index = HotTabIndex) and MouseInControl then
LThemedTab := ttTabItemRightEdgeHot
else
}
LThemedTab := ttTabItemRightEdgeNormal;
end;
end;
//draw the tab
if StyleServices.Available then
begin
LDetails := StyleServices.GetElementDetails(LThemedTab);//necesary for DrawControlText and draw the icon
StyleServices.DrawElement(LCanvas.Handle, LDetails, R);
end;
//get the index of the image (icon)
if Self is TCustomTabControl then
LImageIndex := TCustomTabControlClass(Self).GetImageIndex(Index)
else
LImageIndex := Index;
//draw the image
if (Images <> nil) and (LImageIndex >= 0) and (LImageIndex < Images.Count) then
begin
LIconRect := LayoutR;
case TabPosition of
tpTop, tpBottom:
begin
LIconRect.Left := LIconRect.Left + DxImage;
LIconRect.Right := LIconRect.Left + LImageW;
LayoutR.Left := LIconRect.Right;
LIconRect.Top := LIconRect.Top + (LIconRect.Bottom - LIconRect.Top) div 2 - LImageH div 2;
if (TabPosition = tpTop) and (Index = TabIndex) then
OffsetRect(LIconRect, 0, -1)
else
if (TabPosition = tpBottom) and (Index = TabIndex) then
OffsetRect(LIconRect, 0, 1);
end;
tpLeft:
begin
LIconRect.Bottom := LIconRect.Bottom - DxImage;
LIconRect.Top := LIconRect.Bottom - LImageH;
LayoutR.Bottom := LIconRect.Top;
LIconRect.Left := LIconRect.Left + (LIconRect.Right - LIconRect.Left) div 2 - LImageW div 2;
end;
tpRight:
begin
LIconRect.Top := LIconRect.Top + DxImage;
LIconRect.Bottom := LIconRect.Top + LImageH;
LayoutR.Top := LIconRect.Bottom;
LIconRect.Left := LIconRect.Left + (LIconRect.Right - LIconRect.Left) div 2 - LImageW div 2;
end;
end;
if StyleServices.Available then
StyleServices.DrawIcon(LCanvas.Handle, LDetails, LIconRect, Images.Handle, LImageIndex);
end;
//draw the text of the tab
if StyleServices.Available then
begin
//StyleServices.GetElementColor(LDetails, ecTextColor, LTextColor);
LTextColor:=FColorTextTab;
if (TabPosition = tpTop) and (Index = TabIndex) then
OffsetRect(LayoutR, 0, -1)
else
if (TabPosition = tpBottom) and (Index = TabIndex) then
OffsetRect(LayoutR, 0, 1);
if TabPosition = tpLeft then
begin
LTextX := LayoutR.Left + (LayoutR.Right - LayoutR.Left) div 2 - LCanvas.TextHeight(Tabs[Index]) div 2;
LTextY := LayoutR.Top + (LayoutR.Bottom - LayoutR.Top) div 2 + LCanvas.TextWidth(Tabs[Index]) div 2;
LCanvas.Font.Color:=LTextColor;
AngleTextOut2(LCanvas, 90, LTextX, LTextY, Tabs[Index]);
end
else
if TabPosition = tpRight then
begin
LTextX := LayoutR.Left + (LayoutR.Right - LayoutR.Left) div 2 + LCanvas.TextHeight(Tabs[Index]) div 2;
LTextY := LayoutR.Top + (LayoutR.Bottom - LayoutR.Top) div 2 - LCanvas.TextWidth(Tabs[Index]) div 2;
LCanvas.Font.Color:=LTextColor;
AngleTextOut2(LCanvas, -90, LTextX, LTextY, Tabs[Index]);
end
else
DrawControlText(Tabs[Index], LayoutR, DT_VCENTER or DT_CENTER or DT_SINGLELINE or DT_NOCLIP);
end;
end;
procedure TPageControl.DoDraw(DC: HDC; DrawTabs: Boolean);
var
Details: TThemedElementDetails;
R: TRect;
LIndex, SelIndex: Integer;
begin
Details := StyleServices.GetElementDetails(ttTabItemNormal);
SelIndex := TabIndex;
try
Canvas.Handle := DC;
if DrawTabs then
for LIndex := 0 to Tabs.Count - 1 do
if LIndex <> SelIndex then
DrawTab(Canvas, LIndex);
if SelIndex < 0 then
R := Rect(0, 0, Width, Height)
else
begin
R := TabRect(SelIndex);
R.Left := 0;
R.Top := R.Bottom;
R.Right := Width;
R.Bottom := Height;
end;
StyleServices.DrawElement(DC, StyleServices.GetElementDetails(ttPane), R);
if (SelIndex >= 0) and DrawTabs then
DrawTab(Canvas, SelIndex);
finally
Canvas.Handle := 0;
end;
end;
procedure TPageControl.PaintWindow(DC: HDC);
begin
DoDraw(DC, True);
//inherited;
end;
procedure TPageControl.SetColorTextTab(const Value: TColor);
begin
FColorTextTab := Value;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
PageControl1.ColorTextTab:=clGreen;
end;
और यह परिणाम है।
मुझे लगता है कि किसी भी इस समस्या के लिए 'समाधान' कमजोर हो जाएगा। –