7 replies to this topic

[AIM]

Boki,

I had to enhance the NxPageControl for my needs and want to share my code. Concretely I made the following changes:

1. Fix bugs with scroll-by-tab setting
2. Show scroll buttons only when needed
3. Limit tab width if tab width is larger than page control width

Details see the next postings. Maybe you want to add some of these changes...
If you want I can also send you my PAS file...

[AIM]

Fix bugs with scroll-by-tab setting

CODE

procedure TNxPageControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

.....

    // add the following 4 lines <-------------------------------
    if (pgConstantScroll in Options) and (ScrollMethod = smTab) then
       FScrollTimer.Interval := 250 // Slower Scrolling with smTab mode, default scolling speed 100 was annyoing
    else
       FScrollTimer.Interval := intScrollTimer;

    if pgConstantScroll in FOptions then FScrollTimer.Enabled := True;
  end;
end;

The following procedure enhances the smTab part

CODE

procedure TNxPageControl.InternalScroll(Delta: Integer);

  function CalcAbsoluteScrollPos(iPageIndex:integer):integer;
  var
   i:integer;
  begin
    result:=0;
    for i:=0 to iPageIndex do
      result:=result+  GetTabClientWidth(Pages[i]);
  end;

var
  FOldPos: Integer;
  nNewScrollPos:integer;

begin
  FOldPos := FScrollPos;
  case FScrollMethod of
    smPixels: ScrollTabs(Delta * 10);
    smTab:
      begin
          nNewScrollPos:=FScrollPos;
          if Delta < 0 then
          begin
            if GetFirstVisible = 0 then
              nNewScrollPos := 0
            else if GetFirstVisible > 0 then
            begin
               if GetTabsSpacing < 1 then
                  nNewScrollPos := CalcAbsoluteScrollPos(GetFirstVisible - 2)
               else
                  nNewScrollPos := CalcAbsoluteScrollPos(GetFirstVisible - 1);
            end;
          end
          else if Delta > 0 then
          begin
            if FScrollPos = 0 then
              nNewScrollPos := CalcAbsoluteScrollPos(GetFirstVisible)
            else if CalcAbsoluteScrollPos(PageCount-1) - FScrollPos >= GetTabsEdge then
            begin
               if GetTabsSpacing < 1 then
                 nNewScrollPos := CalcAbsoluteScrollPos(GetFirstVisible)
               else
                 nNewScrollPos := CalcAbsoluteScrollPos(GetFirstVisible + 1);
            end;
          end;
          if nNewScrollPos<>FScrollPos then
            ScrollTabs(nNewScrollPos-FOldPos);
      end;

    smSelect: ActivePageIndex := ActivePageIndex + Delta;
  end;
  if FOldPos <> FScrollPos then
  begin
    RefreshButton(pbScrollLeft);
    RefreshButton(pbScrollRight);
  end;
end;

Separate smTab handling in the following function.

CODE

function TNxPageControl.IsEndPos: Boolean;

   function IsLastTabVisible: boolean;
   var
     w, i:integer;
   begin
     w := Indent + GetTabsSpacing - FScrollPos;
     for i:=0 to PageCount-1 do
      inc(w, GetTabClientWidth(Pages[i]));
      result := w <= GetTabsClientRect.Right;
   end;

begin
  case FScrollMethod of
    smPixels{, smTab}: Result := FScrollPos >= GetScrollMax;
    smTab: Result := IsLastTabVisible;
    else Result := ActivePageIndex >= Pred(PageCount);
  end;
end;

[AIM]

Show scroll buttons only when needed

CODE

procedure TNxPageControl.Paint;
....

  // if pgScrollButtons in Options then
  if (pgScrollButtons in Options) and not (not (csDesigning in ComponentState) and IsStartPos and IsEndPos) then // Display scroll buttons only when needed
  begin
    DrawButton(GetButtonRect(pbScrollLeft), pbScrollLeft);
    DrawButton(GetButtonRect(pbScrollRight), pbScrollRight);
  end;

end;

[AIM]

Limit tab width if tab width is larger than page control width

CODE

function TNxPageControl.GetTabWidth(APage: TNxTabSheet): Integer;

  ......

  // add the following lines
  btnw:=10;
  if pgCloseButton in Options then inc(btnw, 16);
  if pgTabsPopup in Options then inc(btnw, 16);
  if pgScrollButtons in Options then inc(btnw, 32);
  if Result > Width-btnw then
     Result :=  Width - btnw;
end;

[Boki (Berg)]

Hello Aim,

Thank you, I hope that I will be able to include this changes into official release.

Best regards

[Boki (Berg)]

Hello,

smTab scrolling mode is not fixed. Thank you AIM.

[AIM]

smTab scrolling mode is not fixed.

What does not work? I have applied that code here, but I see no problem.

[Boki (Berg)]

Hello AIM,

Oops, I have want to say NOW , not NOT

Thank you again AIM.