问题
Good Day!
I need to change text color of caption of some TabSheet in TPageControl. Something like this on picture
I know how it can be done using OnDrawTab. But if i enabled OwnerDraw, decoration of Windows XP Theme disappears. That's why i try to draw this decoration manually. This is how i tried to do this:
procedure TForm1.PageControl1DrawTab(Control: TCustomTabControl;
TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
FRect: TRect;
Text: string;
begin
FRect := Control.TabRect(TabIndex);
if Active then
ThemeServices.DrawElement(Control.Canvas.Handle, ThemeServices.GetElementDetails(ttTabItemHot), FRect)
else
ThemeServices.DrawElement(Control.Canvas.Handle, ThemeServices.GetElementDetails(ttTabItemNormal), FRect);
Text := PageControl1.Pages[TabIndex].Caption;
Control.Canvas.Brush.Style := bsClear;
if not Active then
FRect.Top := FRect.Top + 4;
DrawText(Control.Canvas.Handle, PChar(Text), Length(Text), FRect, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
end;
And i got this
(left - OwnerDraw version, right - default draw)
As you can see, TabSheets have some borders that's are not overdrawn. And I can't overdraw this borders.
How can i draw background of tab correctly (like PageControl on the right)?
回答1:
A possible solution is override the PaintWindow method of the TPageControl instead of use the ownerdraw , in this way you can control every visual aspect of the tabs.
Check this basic sample.
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;
And this is the result.
来源：https://stackoverflow.com/questions/11866751/how-can-i-change-text-color-of-themed-tabsheet-caption