pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

jvcllaz: Support fixed tab height in JvTabBar.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6367 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-05-01 22:55:16 +00:00
parent a4e69c5dbf
commit 06000dcd6c
1 changed files with 32 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

34
components/jvcllaz/run/JvCustomControls/JvTabBar.pas
View File

@ -148,6 +148,7 @@ type
private
FOnChangeList: TList;
protected
procedure AutoSize; virtual;
procedure Changed; virtual;
procedure DrawBackground(Canvas: TCanvas; TabBar: TJvCustomTabBar; R: TRect); virtual; abstract;
procedure DrawDivider(Canvas: TCanvas; LeftTab: TJvTabBarItem; R: TRect); virtual; abstract;
@ -188,6 +189,7 @@ type
FCloseColorSelected: TColor;
FDividerColor: TColor;
FMoveDividerColor: TColor;
FTabHeight: Integer;
FTabWidth: Integer;
procedure SetCloseRectColorDisabled(const Value: TColor);
procedure SetCloseColor(const Value: TColor);
@ -206,8 +208,10 @@ type
procedure FontChanged(Sender: TObject);
procedure SetDividerColor(const Value: TColor);
procedure SetCloseCrossColorSelected(const Value: TColor);
procedure SetTabHeight(Value: Integer);
procedure SetTabWidth(Value: Integer);
protected
procedure AutoSize; override;
procedure DrawBackground(Canvas: TCanvas; TabBar: TJvCustomTabBar; R: TRect); override;
procedure DrawDivider(Canvas: TCanvas; LeftTab: TJvTabBarItem; R: TRect); override;
procedure DrawMoveDivider(Canvas: TCanvas; Tab: TJvTabBarItem; MoveLeft: Boolean); override;
@ -235,6 +239,7 @@ type
property CloseRectColorDisabled: TColor read FCloseRectColorDisabled write SetCloseRectColorDisabled default $D6D6D6;
property DividerColor: TColor read FDividerColor write SetDividerColor default $99A8AC;
property MoveDividerColor: TColor read FMoveDividerColor write FMoveDividerColor default clBlack;
property TabHeight: Integer read FTabHeight write SetTabHeight default 0;
property TabWidth: Integer read FTabWidth write SetTabWidth default 0;
property Font: TFont read FFont write SetFont;
property DisabledFont: TFont read FDisabledFont write SetDisabledFont;
@ -1424,6 +1429,8 @@ var
imgRes: TScaledImageListResolution;
{$ENDIF}
begin
CurrentPainter.AutoSize;
// Text height
Canvas.Font.Assign(Font);
PreferredHeight := Canvas.TextHeight('Tg');
@ -2161,6 +2168,10 @@ begin
FOnChangeList.Free;
end;
procedure TJvTabBarPainter.AutoSize;
begin
end;
procedure TJvTabBarPainter.Changed;
var
i: Integer;
@ -2280,6 +2291,12 @@ begin
inherited Destroy;
end;
procedure TJvModernTabBarPainter.AutoSize;
begin
FTabHeight := 0;
FTabWidth := 0;
end;
procedure TJvModernTabBarPainter.DrawBackground(Canvas: TCanvas; TabBar: TJvCustomTabBar; R: TRect);
begin
with Canvas do
@ -2557,9 +2574,11 @@ begin
end;
inc(Result.CY, Scale96(TOP_MARGIN) + Scale96(BOTTOM_MARGIN));
// Override width if TabWidth is fixed.
// Override width if TabWidth/TabHeight is fixed.
if TabWidth > 0 then
Result.cx := TabWidth;
Result.CX := TabWidth;
if TabHeight > 0 then
Result.CY := TabHeight;
end;
function TJvModernTabBarPainter.Options: TJvTabBarPainterOptions;
@ -2689,6 +2708,17 @@ begin
end;
end;
procedure TJvModernTabBarPainter.SetTabHeight(Value: Integer);
begin
if Value < 0 then
Value := 0;
if Value <> FTabHeight then
begin
FTabHeight := Value;
Changed;
end;
end;
procedure TJvModernTabBarPainter.SetTabWidth(Value: Integer);
begin
if Value < 0 then