jvtabbar.pas

East make Tray Icon in delphi

constructor TJvCustomTabBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csAcceptsControls];
  
  FTabs := TJvTabBarItems.Create(Self, TJvTabBarItem);
  FChangeLink := TChangeLink.Create;
  FChangeLink.OnChange := ImagesChanged;

  FRightClickSelect := True;
  FCloseButton := True;
  FAutoFreeClosed := True;

  FMargin := 6;

  Align := alTop;
  Height := 23;
end;

destructor TJvCustomTabBar.Destroy;
begin
  // these events are too dangerous during object destruction
  FOnTabSelected := nil;
  FOnTabSelecting := nil;
  FOnChange := nil;

  Painter := nil;
  Images := nil;
  FChangeLink.Free;
  FreeAndNil(FTabs);
  FreeAndNil(FBmpLeftScroll);
  FreeAndNil(FBmpRightScroll);
  inherited Destroy;
end;

procedure TJvCustomTabBar.Notification(Component: TComponent; Operation: TOperation);
var
  I: Integer;
begin
  inherited Notification(Component, Operation);
  if Operation = opRemove then
  begin
    if Component = FPainter then
      Painter := nil
    else
    if Component = FImages then
      Images := nil;
  end;
  if Assigned(FTabs) then
    for I := Tabs.Count - 1 downto 0 do
      Tabs[I].Notification(Component, Operation);
end;

function TJvCustomTabBar.GetScrollBarGlyph(Left: Boolean): TBitmap;
const
  W = 6;
  H = 6;
var
  Pts: array [0..2] of TPoint;
begin
  if Left then
    Result := FBmpLeftScroll
  else
    Result := FBmpRightScroll;

  if not Assigned(Result) then
  begin
    Result := TBitmap.Create;
    Result.Width := 8;
    Result.Height := 8;

    if Left then
    begin
      Pts[0] := Point(W div 2 + 1, 0);
      Pts[1] := Point(W div 2 + 1, H);
      Pts[2] := Point(0 + 1, H div 2);
    end
    else
    begin
      Pts[0] := Point(W div 2 - 1, 0);
      Pts[1] := Point(W div 2 - 1, H);
      Pts[2] := Point(W - 1, H div 2);
    end;
    Result.Canvas.Brush.Style := bsSolid;
    Result.Canvas.Brush.Color := clBlack;
    Result.Canvas.Pen.Color := Result.Canvas.Brush.Color;
    Result.Canvas.Polygon(Pts)
  end;

  if Left then
    FBmpLeftScroll := Result
  else
    FBmpRightScroll := Result;
end;

procedure TJvCustomTabBar.SetTabs(Value: TJvTabBarItems);
begin
  if Value <> FTabs then
    FTabs.Assign(Value);
end;

procedure TJvCustomTabBar.SetPainter(Value: TJvTabBarPainter);
begin
  if Value <> FPainter then
  begin
    if Assigned(FPainter) then
    begin
      FPainter.FOnChange := nil;
      FPainter.RemoveFreeNotification(Self);
    end;
    FPainter := Value;
    if Assigned(FPainter) then
    begin
      FreeAndNil(FDefaultPainter);
      FPainter.FreeNotification(Self);
      FPainter.FOnChange := ImagesChanged;
    end;

    if not (csDestroying in ComponentState) then
      Invalidate;
  end;
end;

procedure TJvCustomTabBar.SetImages(Value: TImageList);
begin
  if Value <> FImages then
  begin
    if Assigned(FImages) then
    begin
      FImages.UnregisterChanges(FChangeLink);
      FImages.RemoveFreeNotification(Self);
    end;
    FImages := Value;
    if Assigned(FImages) then
    begin
      FImages.RegisterChanges(FChangeLink);
      FImages.FreeNotification(Self);
    end;

    if not (csDestroying in ComponentState) then
      Invalidate;
  end;
end;

procedure TJvCustomTabBar.SetCloseButton(Value: Boolean);
begin
  if Value <> FCloseButton then
  begin
    FCloseButton := Value;
    Invalidate;
  end;
end;

procedure TJvCustomTabBar.SetMargin(Value: Integer);
begin
  if Value <> FMargin then
  begin
    FMargin := Value;
    Invalidate;
  end;
end;

procedure TJvCustomTabBar.SetSelectedTab(Value: TJvTabBarItem);
begin
  if Value <> FSelectedTab then
  begin
    if Assigned(Value) and not Value.CanSelect then
      Exit;

    if TabSelecting(Value) then
    begin
      FSelectedTab := Value;
      if not (csDestroying in ComponentState) then
        Invalidate;
      MakeVisible(FSelectedTab);
      TabSelected(FSelectedTab);
    end;
  end;
end;

function TJvCustomTabBar.CurrentPainter: TJvTabBarPainter;
begin
  Result := FPainter;
  if not Assigned(Result) then
  begin
    if not Assigned(FDefaultPainter) then
      FDefaultPainter := TJvModernTabBarPainter.Create(Self);
    Result := FDefaultPainter;
  end;
end;

function TJvCustomTabBar.TabClosing(Tab: TJvTabBarItem): Boolean;
begin
  Result := True;
  if Assigned(FOnTabClosing) then
    FOnTabClosing(Self, Tab, Result);
end;

procedure TJvCustomTabBar.TabClosed(Tab: TJvTabBarItem);
begin
  if AutoFreeClosed then
    Tab.Visible := False;
  try
    if Assigned(FOnTabClosed) then
      FOnTabClosed(Self, Tab);
  finally
    if AutoFreeClosed then
      Tab.Free;
  end;
end;

function TJvCustomTabBar.TabSelecting(Tab: TJvTabBarItem): Boolean;
begin
  Result := True;
  if Assigned(FOnTabSelecting) then
    FOnTabSelecting(Self, Tab, Result);
end;

procedure TJvCustomTabBar.TabSelected(Tab: TJvTabBarItem);
begin
  if Assigned(FOnTabSelected) then
    FOnTabSelected(Self, Tab);
end;

function TJvCustomTabBar.FindSelectableTab(Tab: TJvTabBarItem): TJvTabBarItem;
var
  Index: Integer;
begin
  Result := Tab;
  if Assigned(Result) and not Result.CanSelect then
  begin
    if AllowUnselected then
      Result := nil
    else
    begin
      Index := Result.Index + 1;
      while Index < Tabs.Count do
      begin
        if Tabs[Index].CanSelect then
          Break;
        Inc(Index);
      end;
      if Index >= Tabs.Count then
      begin
        Index := Result.Index - 1;
        while Index >= 0 do
        begin
          if Tabs[Index].CanSelect then
            Break;
          Dec(Index);
        end;
      end;
      if Index >= 0 then
        Result := Tabs[Index]
      else
        Result := nil;
    end;
  end;
  if not AllowUnselected and not Assigned(Result) then
  begin
    // try to find a selectable tab
    for Index := 0 to Tabs.Count - 1 do
      if Tabs[Index].CanSelect then
      begin
        Result := Tabs[Index];
        Break;
      end;
  end;
end;

procedure TJvCustomTabBar.Changed;
begin
  if not (csDestroying in ComponentState) then
  begin
    // The TabSelected tab is now no more selectable
    SelectedTab := FindSelectableTab(SelectedTab);

    Invalidate;
    if Assigned(FOnChange) then
      FOnChange(Self);
    UpdateScrollButtons;
  end;
end;

procedure TJvCustomTabBar.ImagesChanged(Sender: TObject);
begin
  if not (csDestroying in ComponentState) then
    Invalidate;
end;

{$IFDEF VCL}

procedure TJvCustomTabBar.CMMouseLeave(var Msg: TMessage);
begin
  SetHotTab(nil);
  inherited;
end;

procedure TJvCustomTabBar.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin
  Msg.Result := 1;
end;

{$ENDIF VCL}

{$IFDEF VisualCLX}
procedure TJvCustomTabBar.MouseLeave(AControl: TControl);
begin
  SetHotTab(nil);
  inherited MouseLeave(AControl);
end;
{$ENDIF VisualCLX}

procedure TJvCustomTabBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var
  Tab: TJvTabBarItem;
  LastSelected: TJvTabBarItem;
begin
  if Button = mbLeft then
  begin
    FMouseDownClosingTab := nil;
    SetClosingTab(nil); // no tab should be closed

    LastSelected := SelectedTab;
    Tab := TabAt(X, Y);
    if Assigned(Tab) then
      SelectedTab := Tab;

    if Assigned(Tab) and (Tab = SelectedTab) then
      if CloseButton and (not SelectBeforeClose or (SelectedTab = LastSelected)) and
        PtInRect(CurrentPainter.GetCloseRect(Canvas, Tab, Tab.DisplayRect), Point(X, Y)) then
        if TabClosing(Tab) then
        begin
          FMouseDownClosingTab := Tab;
          SetClosingTab(Tab);
        end;
  end;
  inherited MouseDown(Button, Shift, X, Y);
end;

procedure TJvCustomTabBar.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  Pt: TPoint;
  Tab: TJvTabBarItem;
begin
  try
    if RightClickSelect and not Assigned(PopupMenu) and (Button = mbRight) then
    begin
      Tab := TabAt(X, Y);
      if Assigned(Tab) then
        SelectedTab := Tab;
      if Assigned(Tab) and Assigned(Tab.PopupMenu) then
      begin
        Pt := ClientToScreen(Point(X, Y));
        Tab.PopupMenu.Popup(Pt.X, Pt.Y);
      end;
    end
    else
    if Button = mbLeft then
    begin
      if Assigned(FClosingTab) and CloseButton then
      begin
        CalcTabsRects;
        if PtInRect(CurrentPainter.GetCloseRect(Canvas, FClosingTab,
          FClosingTab.DisplayRect), Point(X, Y)) then
          TabClosed(FClosingTab);
      end;
    end;
  finally
    FMouseDownClosingTab := nil;
    SetClosingTab(nil);
  end;
  inherited MouseUp(Button, Shift, X, Y);
end;

procedure TJvCustomTabBar.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  Tab: TJvTabBarItem;
  NewHint: TCaption;
begin
  CalcTabsRects;
  Tab := TabAt(X, Y);
  if HotTracking and ([ssLeft, ssMiddle, ssRight] * Shift = []) then
    SetHotTab(Tab);

  if CloseButton and Assigned(FMouseDownClosingTab) and (ssLeft in Shift) then
  begin
    if PtInRect(CurrentPainter.GetCloseRect(Canvas, FMouseDownClosingTab,
      FMouseDownClosingTab.DisplayRect), Point(X, Y)) then
      SetClosingTab(FMouseDownClosingTab)
    else
      SetClosingTab(nil)
  end;

  if Assigned(Tab) and Tab.ShowHint then
    NewHint := Tab.Hint
  else
    NewHint := FHint;

  if NewHint <> inherited Hint then
  begin
    Application.CancelHint;
    ShowHint := False;
    ShowHint := True;
    inherited Hint := NewHint;
  end;

  inherited MouseMove(Shift, X, Y);
end;

procedure TJvCustomTabBar.SetHotTab(Tab: TJvTabBarItem);
begin
  if (csDestroying in ComponentState) or not HotTracking then
    FHotTab := nil
  else
  if Tab <> FHotTab then
  begin
    FHotTab := Tab;
    Paint;
  end;
end;

function TJvCustomTabBar.AddTab(const Caption: string): TJvTabBarItem;
begin
  Result := TJvTabBarItem(Tabs.Add);
  Result.Caption := Caption;
end;

procedure TJvCustomTabBar.CalcTabsRects;
var
  I, X: Integer;
  Tab: TJvTabBarItem;
  Offset: Integer;
  Index: Integer;
begin
  if csDestroying in ComponentState then
    Exit;

  Offset := 0;
  X := Margin;  // adjust for scrolled area
  Index := 0;
  for I := 0 to Tabs.Count - 1 do
  begin
    Tab := Tabs[I];
    if Tab.Visible then
    begin
      Tab.FLeft := X;
      Inc(X, GetTabWidth(Tab));
      Inc(X, CurrentPainter.GetDividerWidth(Canvas, Tab));
      if Index < FLeftIndex then
      begin
        Inc(Offset, X); // this tab is placed too left.
        X := 0;
        Tab.FLeft := -Offset - 10;
      end;
      Inc(Index);
    end
    else
      Tab.FLeft := -1;
  end;

  FRequiredWidth := X + Offset;
  FLastTabRight := X;
end;

type
  TSpeedButtonAccess = class(TSpeedButton);
  
procedure TJvCustomTabBar.Paint;