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

JvclLaz: Fix hints in TJvTabBar. Forum discussion https://forum.lazarus.freepascal.org/index.php/topic,59064.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8251 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-04-15 21:05:14 +00:00
parent 31ff1f2530
commit 3a13c399a1
1 changed files with 34 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

41
components/jvcllaz/run/JvPageComps/jvtabbar.pas
View File

@ -269,6 +269,7 @@ public
FAllowUnselected: Boolean; FAllowUnselected: Boolean;
FSelectBeforeClose: Boolean; FSelectBeforeClose: Boolean;
FPageList: TCustomControl; FPageList: TCustomControl;
FHintLocked: Integer;
FOnTabClosing: TJvTabBarClosingEvent; FOnTabClosing: TJvTabBarClosingEvent;
FOnTabSelected: TJvTabBarItemEvent; FOnTabSelected: TJvTabBarItemEvent;
@ -434,8 +435,9 @@ public
property BorderSpacing; property BorderSpacing;
property Constraints; property Constraints;
property Cursor; property Cursor;
property ParentShowHint default true;
property PopupMenu; property PopupMenu;
property ShowHint default False; property ShowHint;
property Height; property Height;
property Hint; property Hint;
property Visible; property Visible;
@ -611,6 +613,7 @@ begin
SetInitialBounds(0, 0, CX, CY); SetInitialBounds(0, 0, CX, CY);
AutoSize := true; AutoSize := true;
ParentShowHint := true;
end; end;
destructor TJvCustomTabBar.Destroy; destructor TJvCustomTabBar.Destroy;
@ -1154,6 +1157,7 @@ procedure TJvCustomTabBar.MouseMove(Shift: TShiftState; X, Y: Integer);
var var
Tab: TJvTabBarItem; Tab: TJvTabBarItem;
NewHint: TCaption; NewHint: TCaption;
P: TPoint;
begin begin
CalcTabsRects; // maybe inefficent CalcTabsRects; // maybe inefficent
if ScrollButtonsMouseMove(Shift, X, Y) then if ScrollButtonsMouseMove(Shift, X, Y) then
@ -1172,17 +1176,29 @@ begin
SetClosingTab(nil) SetClosingTab(nil)
end; end;
if (Tab <> nil) and Tab.ShowHint then if ShowHint then
NewHint := Tab.Hint
else
NewHint := FHint;
if NewHint <> inherited Hint then
begin begin
// Use either the TabBar's hint and the hints of the individual tabs.
if (Tab <> nil) and Tab.ShowHint then
newHint := Tab.Hint
else
newHint := FHint;
if newHint <> inherited Hint then
begin
// Without the next instruction the currently shown hint will not be replaced.
Application.CancelHint; Application.CancelHint;
ShowHint := False;
ShowHint := True; // Move the new hint text to the control, but do not overwrite the
inherited Hint := NewHint; // own hint of the TabBar.
inc(FHintLocked);
inherited Hint := newHint;
dec(FHintLocked);
// Display the new hint
P := ClientToScreen(Point(X, Y));
Application.ActivateHint(P, true);
end;
end; end;
inherited MouseMove(Shift, X, Y); inherited MouseMove(Shift, X, Y);
@ -1762,10 +1778,15 @@ begin
end; end;
procedure TJvCustomTabBar.SetHint(const Value: TCaption); procedure TJvCustomTabBar.SetHint(const Value: TCaption);
begin
inherited;
if FHintLocked = 0 then
begin begin
if Value <> FHint then if Value <> FHint then
FHint := Value; FHint := Value;
end; end;
end;
procedure TJvCustomTabBar.SetFlatScrollButtons(const Value: Boolean); procedure TJvCustomTabBar.SetFlatScrollButtons(const Value: Boolean);
begin begin