jvcllaz: Fix LCL scaling of TJvTabBarXPPainter.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7419 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-04-29 12:54:39 +00:00
parent 9f6e9183d3
commit 44b4df5df2
4 changed files with 241 additions and 40 deletions

View File

@ -153,7 +153,8 @@ type
function GetTabBar(ATab: TJvTabBarItem): TJvCustomTabBar;
function GetTabSize(Canvas: TCanvas; Tab: TJvTabBarItem): TSize; virtual; abstract;
function Options: TJvTabBarPainterOptions; virtual; abstract;
public
function Scale(ABar: TJvCustomTabBar; n: Integer): Integer;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
@ -314,12 +315,6 @@ type
procedure SetOrientation(const Value: TJvTabBarOrientation);
procedure TimerExpired(Sender: TObject);
procedure SetHeight(AValue: Integer);
{$IF LCL_FullVersion >= 1090000}
private
procedure SetImagesWidth(const AValue: Integer);
protected
property ImagesWidth: Integer read FImagesWidth write SetImagesWidth default 0;
{$ENDIF}
protected
procedure CalcTabsRects;
procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;
@ -371,6 +366,9 @@ type
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); override;
{$IFEND}
{$IF LCL_FullVersion >= 1090000}
procedure SetImagesWidth(const AValue: Integer);
{$ENDIF}
public
constructor Create(AOwner: TComponent); override;
@ -389,6 +387,9 @@ type
property PageList: TCustomControl read FPageList write SetPageList;
property Painter: TJvTabBarPainter read FPainter write SetPainter;
property Images: TCustomImageList read FImages write SetImages;
{$IF LCL_FullVersion >= 1090000}
property ImagesWidth: Integer read FImagesWidth write SetImagesWidth default 0;
{$ENDIF}
property Tabs: TJvTabBarItems read FTabs write SetTabs;
// Status
@ -2226,11 +2227,27 @@ begin
end;
{$ELSE}
begin
Result.CX := ATab.GetImages.Width;
Result.CY := ATab.GetImages.Height;
if Assigned(ATab.GetImages) then
begin
Result.CX := ATab.GetImages.Width;
Result.CY := ATab.GetImages.Height;
end else
begin
Result.CX := 0;
Result.CY := 0;
end;
end;
{$ENDIF}
function TJvTabBarPainter.Scale(ABar: TJvCustomTabBar; n: Integer): Integer;
begin
{$IF LCL_FullVersion >= 1080000}
Result := ABar.Scale96ToFont(n);
{$ELSE}
Result := MulDiv(n, Screen.PixelsPerInch, 96);
{$IFEND}
end;
procedure TJvTabBarPainter.GetScrollButtons(TabBar: TJvCustomTabBar; var LeftButton, RightButton: TRect);
begin
{ reserved for future use }
@ -2366,18 +2383,21 @@ begin
end;
procedure TJvModernTabBarPainter.DrawDivider(Canvas: TCanvas; LeftTab: TJvTabBarItem; R: TRect);
var
delta: Integer;
begin
if not LeftTab.Selected then
begin
if (LeftTab.TabBar.SelectedTab = nil) or
(LeftTab.GetNextVisible <> LeftTab.TabBar.SelectedTab) then
begin
delta := Scale(LeftTab.TabBar, 3);
with Canvas do
begin
Pen.Color := DividerColor;
Pen.Width := 1;
MoveTo(R.Right - 1, R.Top + 3);
LineTo(R.Right - 1, R.Bottom - 3);
MoveTo(R.Right - 1, R.Top + delta);
LineTo(R.Right - 1, R.Bottom - delta);
end;
end;
end;
@ -2386,21 +2406,23 @@ end;
procedure TJvModernTabBarPainter.DrawMoveDivider(Canvas: TCanvas; Tab: TJvTabBarItem; MoveLeft: Boolean);
var
R: TRect;
delta: integer;
begin
delta := Scale(Tab.TabBar, 4);
with Canvas do
begin
R := Tab.DisplayRect;
Inc(R.Top, 4);
Dec(R.Bottom, 2);
Inc(R.Top, delta);
Dec(R.Bottom, delta div 2);
if MoveLeft then
begin
Dec(R.Left);
R.Right := R.Left + 4
R.Right := R.Left + delta
end
else
begin
Dec(R.Right, 1);
R.Left := R.Right - 4;
R.Left := R.Right - delta;
end;
Brush.Color := MoveDividerColor;
FillRect(R);

View File

@ -53,7 +53,7 @@ type
implementation
uses
Math, Themes;
LCLVersion, Math, Themes, imgList;
{ TJvTabBarXPPainter }
@ -87,36 +87,55 @@ end;
procedure TJvTabBarXPPainter.DrawTab(Canvas: TCanvas; Tab: TJvTabBarItem;
R: TRect);
var
TabDetails, ButtonDetails: TThemedElementDetails;
tabBar: TJvCustomTabBar;
tabDetails, buttonDetails: TThemedElementDetails;
CloseRect, TextRect: TRect;
imgsize: TSize;
x, y: Integer;
{$IF LCL_FullVersion >= 1090000}
imageRes: TScaledImageListResolution;
f: Double;
ppi: Integer;
{$IFEND}
begin
tabBar := GetTabBar(Tab);
if ThemeServices.ThemesEnabled then
begin
if Tab.Selected then
begin
ButtonDetails := ThemeServices.GetElementDetails(twSmallCloseButtonNormal);
TabDetails := ThemeServices.GetElementDetails(ttTabItemSelected);
buttonDetails := ThemeServices.GetElementDetails(twSmallCloseButtonNormal);
tabDetails := ThemeServices.GetElementDetails(ttTabItemSelected);
end
else if Tab.Hot then
begin
ButtonDetails := ThemeServices.GetElementDetails(twSmallCloseButtonHot);
TabDetails := ThemeServices.GetElementDetails(ttTabItemHot);
buttonDetails := ThemeServices.GetElementDetails(twSmallCloseButtonHot);
tabDetails := ThemeServices.GetElementDetails(ttTabItemHot);
end
else
begin
ButtonDetails := ThemeServices.GetElementDetails(twSmallCloseButtonNormal);
TabDetails := ThemeServices.GetElementDetails(ttTabItemNormal);
buttonDetails := ThemeServices.GetElementDetails(twSmallCloseButtonNormal);
tabDetails := ThemeServices.GetElementDetails(ttTabItemNormal);
end;
if Tab.Closing then
ButtonDetails := ThemeServices.GetElementDetails(twSmallCloseButtonPushed);
ThemeServices.DrawElement(Canvas.Handle, TabDetails, R);
buttonDetails := ThemeServices.GetElementDetails(twSmallCloseButtonPushed);
ThemeServices.DrawElement(Canvas.Handle, tabDetails, R);
if (Tab.ImageIndex <> -1) and (Tab.GetImages <> nil) then
begin
Tab.GetImages.Draw(Canvas, R.Left + 4, R.Top + (R.Bottom - R.Top - Tab.GetImages.Height) div 2,
Tab.ImageIndex, Tab.Enabled);
Inc(R.Left, Tab.GetImages.Width + 2);
imgSize := GetRealImageSize(Tab);
x := R.Left + Scale(tabBar, 4);
y := (R.Top + R.Bottom - imgSize.CY) div 2;
{$IF LCL_FullVersion >= 1090000}
f := tabBar.GetCanvasScaleFactor;
ppi := GetPixelsPerInch;
imageRes := Tab.GetImages.ResolutionForPPI[tabBar.ImagesWidth, ppi, f];
imageRes.Draw(Canvas, x, y, Tab.ImageIndex, Tab.Enabled);
{$ELSE}
Tab.GetImages.Draw(Canvas, x, y, Tab.ImageIndex, Tab.Enabled);
{$IFEND}
Inc(R.Left, imgSize.CX + Scale(tabBar, 2));
end;
TextRect := R;
@ -124,10 +143,10 @@ begin
if Tab.TabBar.CloseButton then
begin
CloseRect := GetCloseRect(Canvas, Tab, R);
TextRect.Right := CloseRect.Left - 3;
TextRect.Right := CloseRect.Left - Scale(tabBar, 3);
end
else
Dec(TextRect.Right, 3);
Dec(TextRect.Right, Scale(tabBar, 3));
Canvas.Brush.Style := bsClear;
ThemeServices.DrawText(Canvas.Handle, TabDetails, Tab.Caption, TextRect, DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS, 0);
@ -140,13 +159,19 @@ end;
function TJvTabBarXPPainter.GetCloseRect(Canvas: TCanvas; Tab: TJvTabBarItem;
R: TRect): TRect;
var
tabBar: TJvCustomTabBar;
p15: Integer;
begin
if ThemeServices.ThemesEnabled then
begin
Result.Right := R.Right - 5;
Result.Top := R.Top + ((R.Bottom div 2) - 8);
Result.Left := Result.Right - 15;
Result.Bottom := Result.Top + 15;
tabBar := GetTabBar(Tab);
p15 := Scale(tabBar, 15);
// Result.Top := R.Top + R.Bottom div 2 - Scale(tabBar, 8);
Result.Top := (R.Top + R.Bottom - p15) div 2;
Result.Bottom := Result.Top + p15;
Result.Right := R.Right - Scale(tabBar, 5);
Result.Left := Result.Right - p15;
end
else
Result := inherited GetCloseRect(Canvas, Tab, R);
@ -161,28 +186,31 @@ begin
end;
function TJvTabBarXPPainter.GetTabSize(Canvas: TCanvas; Tab: TJvTabBarItem): TSize;
var
tabBar: TJvCustomTabBar;
begin
tabBar := GetTabBar(Tab);
if FixedTabSize > 0 then
begin
if ThemeServices.ThemesEnabled then
Result.cx := FixedTabSize
else
Result.cx := Min(FixedTabSize + 40, Canvas.TextWidth(Tab.Caption) + 26);
Result.cx := Min(FixedTabSize + Scale(tabBar, 40), Canvas.TextWidth(Tab.Caption) + Scale(tabBar, 26));
end
else
begin
if ThemeServices.ThemesEnabled then
begin
Result.cx := Canvas.TextWidth(Tab.Caption) + 16;
Result.cx := Canvas.TextWidth(Tab.Caption) + Scale(tabBar, 16);
if (Tab.ImageIndex <> -1) and (Tab.GetImages <> nil) then
Inc(Result.cx, Tab.GetImages.Width + 2);
Inc(Result.cx, GetRealImageSize(Tab).CX + Scale(tabBar, 2));
if Tab.TabBar.CloseButton then
Inc(Result.cx, 18);
Inc(Result.cx, Scale(tabBar, 18));
end
else
Result := inherited GetTabSize(Canvas, Tab);
end;
Result.cy := Tab.TabBar.Height - 3;
Result.cy := Tab.TabBar.Height - Scale(tabBar, 3);
end;
procedure TJvTabBarXPPainter.SetFixedTabSize(const Value: Integer);