jvtabbar.pas

East make Tray Icon in delphi

var
  I: Integer;
  Bmp: TBitmap;
  R: TRect;
begin
  CalcTabsRects;
  Bmp := TBitmap.Create;
  try
    Bmp.Width := ClientWidth;
    Bmp.Height := ClientHeight;
    CurrentPainter.DrawBackground(Bmp.Canvas, Self, ClientRect);
    if Assigned(FBtnLeftScroll) and Assigned(FBtnRightScroll) then
    begin
      // paint scroll button's background and the buttons
      R := Rect(FBarWidth, 0, Bmp.Width, Bmp.Height);
      Canvas.CopyRect(R, Bmp.Canvas, R);
      TSpeedButtonAccess(FBtnLeftScroll).Paint;
      TSpeedButtonAccess(FBtnRightScroll).Paint;
      if FBarWidth > 0 then
        Bmp.Width := FBarWidth;
    end;

    if FBarWidth > 0 then
      for I := 0 to Tabs.Count - 1 do
        if Tabs[I].Visible then
          PaintTab(Bmp.Canvas, Tabs[I]);
    Canvas.Draw(0, 0, Bmp);
  finally
    Bmp.Free;
  end;
end;

procedure TJvCustomTabBar.PaintTab(Canvas: TCanvas; Tab: TJvTabBarItem);
var
  R: TRect;
begin
  if csDestroying in ComponentState then
    Exit;

  if Tab.Visible then
  begin
    R := Tab.DisplayRect;
    if (R.Right >= 0) and (R.Left < FBarWidth) then
    begin
      CurrentPainter.DrawTab(Canvas, Tab, R);
      R.Left := R.Right;
      R.Right := R.Left + CurrentPainter.GetDividerWidth(Canvas, Tab) - 1;
      CurrentPainter.DrawDivider(Canvas, Tab, R);
    end;
  end;
end;

function TJvCustomTabBar.GetTabHeight(Tab: TJvTabBarItem): Integer;
begin
  Result := CurrentPainter.GetTabSize(Canvas, Tab).cy;
end;

function TJvCustomTabBar.GetTabWidth(Tab: TJvTabBarItem): Integer;
begin
  Result := CurrentPainter.GetTabSize(Canvas, Tab).cx;
end;

function TJvCustomTabBar.TabAt(X, Y: Integer): TJvTabBarItem;
var
  I: Integer;
  Pt: TPoint;
begin
  if not Assigned(FBtnLeftScroll) or (X < FBarWidth) then
  begin
    CalcTabsRects;
    Pt := Point(X, Y);
    for I := 0 to Tabs.Count - 1 do
      if PtInRect(Tabs[I].DisplayRect, Pt) then
      begin
        Result := Tabs[I];
        Exit;
      end;
  end;
  Result := nil;
end;

procedure TJvCustomTabBar.SetClosingTab(Tab: TJvTabBarItem);
begin
  if Tab <> FClosingTab then
  begin
    FClosingTab := Tab; // this tab should be TabClosed
    Paint;
  end;
end;

function TJvCustomTabBar.GetLeftTab: TJvTabBarItem;
begin
  if FLeftIndex < Tabs.Count then
  begin
    Result := Tabs[FLeftIndex];
    if not Result.Visible then
      Result := Result.GetNextVisible;
  end
  else
    Result := nil;
end;

procedure TJvCustomTabBar.SetLeftTab(Value: TJvTabBarItem);
var
  Index: Integer;
  Tab: TJvTabBarItem;
begin
  Index := 0;
  if Assigned(Value) then
  begin
    // find first visible before or at Value.Index
    Index := 0;
    if (Tabs.Count > 0) and (Value <> Tabs[0]) then
    begin
      while Index < Tabs.Count do
      begin
        Tab := Tabs[Index].GetNextVisible;
        if Tab = nil then
        begin
          Index := FLeftIndex; // do not change
          Break;
        end
        else
        begin
          Index := Tab.Index;
          if Tab.Index >= Value.Index then
            Break;
        end;
      end;
      if Index >= Tabs.Count then
        Index := FLeftIndex; // do not change
    end;
  end;
  if Index <> FLeftIndex then
  begin
    FLeftIndex := Index;
    Invalidate;
  end;
end;

procedure TJvCustomTabBar.UpdateScrollButtons;
const
  BtnSize = 12;
begin
  CalcTabsRects;
  if (FRequiredWidth < ClientWidth) or ((FLeftIndex = 0) and
    (FLastTabRight <= ClientWidth)) then
  begin
    FreeAndNil(FBtnLeftScroll);
    FreeAndNil(FBtnRightScroll);
    FLeftIndex := 0;
    FBarWidth := ClientWidth;
    Invalidate;
  end
  else
  begin
    if not Assigned(FBtnLeftScroll) then
    begin
      FBtnLeftScroll := TSpeedButton.Create(Self);
      FBtnLeftScroll.Caption := '';
      FBtnLeftScroll.Flat := FlatScrollButtons;
      FBtnLeftScroll.Parent := Self;
      FBtnLeftScroll.OnClick := ScrollButtonClicked;
      FBtnLeftScroll.Glyph := GetScrollBarGlyph(True);
    end;
    if not Assigned(FBtnRightScroll) then
    begin
      FBtnRightScroll := TSpeedButton.Create(Self);
      FBtnRightScroll.Caption := '';
      FBtnRightScroll.Flat := FlatScrollButtons;
      FBtnRightScroll.Parent := Self;
      FBtnRightScroll.OnClick := ScrollButtonClicked;
      FBtnRightScroll.Glyph := GetScrollBarGlyph(False);
    end;

    FBtnLeftScroll.SetBounds(ClientWidth - BtnSize * 2 - 1 - 1,
      ClientHeight - BtnSize - 2, BtnSize, BtnSize);
    FBtnRightScroll.SetBounds(ClientWidth - BtnSize - 1 - 1,
      ClientHeight - BtnSize - 2, BtnSize, BtnSize);

    FBarWidth := FBtnLeftScroll.Left - 2;

    FBtnLeftScroll.Enabled := FLeftIndex > 0;
    FBtnRightScroll.Enabled := FLastTabRight > ClientWidth;
  end;
end;

procedure TJvCustomTabBar.Resize;
begin
  UpdateScrollButtons;
  inherited Resize;
end;

procedure TJvCustomTabBar.ScrollButtonClicked(Sender: TObject);
begin
  if Sender = FBtnLeftScroll then
    Dec(FLeftIndex)
  else
  if Sender = FBtnRightScroll then
    Inc(FLeftIndex);
  UpdateScrollButtons;
  Invalidate;
end;

function TJvCustomTabBar.MakeVisible(Tab: TJvTabBarItem): Boolean;
var
  R: TRect;
  LastLeftIndex: Integer;
begin
  Result := False;
  if not Assigned(Tab) or not Tab.Visible then
    Exit;

  LastLeftIndex := FLeftIndex;
  if FBarWidth > 0 then
  begin
    repeat
      CalcTabsRects;
      R := Tab.DisplayRect;
      if R.Right > FBarWidth then
        Inc(FLeftIndex)
      else
        Break;
    until FLeftIndex = Tabs.Count - 1;
  end
  else
    FLeftIndex := 0;
  if (R.Left < 0) and (FLeftIndex > 0) then
    Dec(FLeftIndex); // bar is too small
  if FLeftIndex <> LastLeftIndex then
  begin
    UpdateScrollButtons;
    Invalidate;
  end;
end;

function TJvCustomTabBar.FindData(Data: TObject): TJvTabBarItem;
var
  I: Integer;
begin
  for I := 0 to Tabs.Count - 1 do
    if Tabs[I].Data = Data then
    begin
      Result := Tabs[I];
      Exit;
    end;
  Result := nil;
end;

procedure TJvCustomTabBar.SetHint(const Value: TCaption);
begin
  if Value <> FHint then
    FHint := Value;
end;

procedure TJvCustomTabBar.SetFlatScrollButtons(const Value: Boolean);
begin
  if Value <> FFlatScrollButtons then
  begin
    FFlatScrollButtons := Value;
    FreeAndNil(FBtnLeftScroll);
    FreeAndNil(FBtnRightScroll);
    UpdateScrollButtons;
  end;
end;

//=== { TJvTabBarItem } ======================================================

constructor TJvTabBarItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FImageIndex := -1;
  FEnabled := True;
  FVisible := True;
  FShowHint := True;
end;

destructor TJvTabBarItem.Destroy;
begin
  PopupMenu := nil;
  Visible := False; // CanSelect returns false 
  {$IFDEF COMPILER5}
  TOwnedCollection(GetOwner).Notify(Self, cnDeleting);
  {$ENDIF COMPILER5}
  inherited Destroy;
end;

procedure TJvTabBarItem.Assign(Source: TPersistent);
begin
  if Source is TJvTabBarItem then
  begin
    with TJvTabBarItem(Source) do
    begin
      // (rom) possible bug. Better assign properties not property implementors.
      Self.FImageIndex := FImageIndex;
      Self.FEnabled := FEnabled;
      Self.FVisible := FVisible;
      Self.FTag := FTag;
      Self.FData := FData;
      Self.FHint := FHint;
      Self.FShowHint := FShowHint;
      Self.FName := FName;
      Self.FCaption := FCaption;
      Self.FModified := FModified;
      Self.FImages := FImages;
    end;
  end
  else
    inherited Assign(Source);
end;

procedure TJvTabBarItem.Notification(Component: TComponent;
  Operation: TOperation);
begin
  if Operation = opRemove then
    if Component = PopupMenu then
      PopupMenu := nil;
end;

procedure TJvTabBarItem.Changed;
begin
  TabBar.Changed;
end;

function TJvTabBarItem.GetDisplayRect: TRect;
begin
  if not Visible then
    Result := Rect(-1, -1, -1, -1)
  else
  begin
    if FLeft = -1 then
      TabBar.CalcTabsRects; // not initialized

    case TabBar.Align of
      alBottom:
          Result := Rect(FLeft, 0,
            FLeft + TabBar.GetTabWidth(Self), 0 + TabBar.GetTabHeight(Self));
    else
      // Top
      Result := Rect(FLeft, TabBar.ClientHeight - TabBar.GetTabHeight(Self),
          FLeft + TabBar.GetTabWidth(Self), TabBar.ClientHeight);
    end;
  end;
end;

function TJvTabBarItem.GetHot: Boolean;
begin
  Result := TabBar.HotTab = Self;
end;

function TJvTabBarItem.GetImages: TCustomImageList;
begin
  Result := TabBar.Images;
end;

function TJvTabBarItem.GetSelected: Boolean;
begin
  Result := TabBar.SelectedTab = Self;
end;

function TJvTabBarItem.GetTabBar: TJvCustomTabBar;
begin
  Result := (GetOwner as TJvTabBarItems).TabBar;
end;

procedure TJvTabBarItem.SetCaption(const Value: TCaption);
begin
  if Value <> FCaption then
  begin
    FCaption := Value;
    Changed;
  end;
end;

procedure TJvTabBarItem.SetEnabled(const Value: Boolean);
begin
  if Value <> FEnabled then
  begin
    FEnabled := Value;
    Changed;
  end;
end;

procedure TJvTabBarItem.SetImageIndex(const Value: TImageIndex);
begin
  if Value <> FImageIndex then
  begin
    FImageIndex := Value;
    Changed;
  end;
end;

procedure TJvTabBarItem.SetName(const Value: string);
begin
  if (Value <> FName) and (TJvTabBarItems(Collection).Find(Value) = nil) then
    FName := Value;
end;

procedure TJvTabBarItem.SetSelected(const Value: Boolean);
begin
  if Value then
    TabBar.SelectedTab := Self;
end;

procedure TJvTabBarItem.SetVisible(const Value: Boolean);
begin
  if Value <> FVisible then
  begin
    FVisible := Value;
    FLeft := -1; // discard
    Changed;
  end;
end;

function TJvTabBarItem.CanSelect: Boolean;
begin
  Result := Visible and Enabled;
end;

function TJvTabBarItem.GetNextVisible: TJvTabBarItem;
var
  I: Integer;
begin
  for I := Index + 1 to TabBar.Tabs.Count - 1 do
    if TabBar.Tabs[I].Visible then
    begin
      Result := TabBar.Tabs[I];
      Exit;
    end;
  Result := nil;
end;

function TJvTabBarItem.GetPreviousVisible: TJvTabBarItem;
var
  I: Integer;
begin
  for I := Index - 1 downto 0 do
    if TabBar.Tabs[I].Visible then
    begin
      Result := TabBar.Tabs[I];
      Exit;
    end;
  Result := nil;
end;

function TJvTabBarItem.GetClosing: Boolean;
begin
  Result := TabBar.ClosingTab = Self;
end;

procedure TJvTabBarItem.SetModified(const Value: Boolean);
begin
  if Value <> FModified then
  begin
    FModified := Value;
    Changed;
  end;
end;

procedure TJvTabBarItem.SetPopupMenu(const Value: TPopupMenu);
begin
  if Value <> FPopupMenu then
  begin
    if Assigned(FPopupMenu) then
      FPopupMenu.RemoveFreeNotification(TabBar);
    FPopupMenu := Value;
    if Assigned(FPopupMenu) then
      FPopupMenu.FreeNotification(TabBar);
  end;
end;