tb2item.pas

对于单个控件,COMPONET-->INSTALL COMPONENT..-->PAS或DCU文件-->INSTALL。 2.对于带*.DPK文件的控件包,FILE-->OP

    Result := FItems.Count;
end;

function TTBCustomItem.GetItem(Index: Integer): TTBCustomItem;
begin
  if (FItems = nil) or (Index < 0) or (Index >= FItems.Count) then begin
    IndexError;
    Result := nil;
    Exit;
  end;
  Result := TTBCustomItem(FItems.List[Index]);
end;

procedure TTBCustomItem.Add(AItem: TTBCustomItem);
begin
  Insert(Count, AItem);
end;

procedure TTBCustomItem.InternalNotify(Ancestor: TTBCustomItem;
  NestingLevel: Integer; Action: TTBItemChangedAction; Index: Integer;
  Item: TTBCustomItem);
{ Note: Ancestor is Item's parent, or in the case of a group item relayed
  notification, it can also be a group item which *links* to Item's parent
  (i.e. ItemContainingItems(Ancestor) = Item.Parent). }

  procedure RelayToParentOf(const AItem: TTBCustomItem);
  begin
    if NestingLevel > MaxGroupLevel then
      Exit;
    if (tbisEmbeddedGroup in AItem.ItemStyle) and Assigned(AItem.Parent) then begin
      if Ancestor = Self then
        AItem.Parent.InternalNotify(AItem, NestingLevel + 1, Action, Index, Item)
      else
        { Don't alter Ancestor on subsequent relays; only on the first. }
        AItem.Parent.InternalNotify(Ancestor, NestingLevel + 1, Action, Index, Item);
    end;
  end;

var
  I: Integer;
  P: TTBCustomItem;
  SaveProc: TTBItemChangedProc;
begin
  { If Self is a group item, relay the notification to the parent }
  RelayToParentOf(Self);
  { If any group items are linked to Self, relay the notification to
    those items' parents }
  if Assigned(FLinkParents) then
    for I := 0 to FLinkParents.Count-1 do begin
      P := TTBCustomItem(FLinkParents[I]);
      if P <> Parent then
        RelayToParentOf(P);
    end;
  if Assigned(FNotifyList) then begin
    I := 0;
    while I < FNotifyList.Count do begin
      with TItemChangedNotificationData(FNotifyList[I]) do begin
        SaveProc := Proc;
        Proc(Ancestor, Ancestor <> Self, Action, Index, Item);
      end;
      { Is I now out of bounds? }
      if I >= FNotifyList.Count then
        Break;
      { Only proceed to the next index if the list didn't change }
      {$IFNDEF CLR}
      if MethodsEqual(TMethod(TItemChangedNotificationData(FNotifyList[I]).Proc),
         TMethod(SaveProc)) then
      {$ELSE}
      if @TItemChangedNotificationData(FNotifyList[I]).Proc = @SaveProc then
      {$ENDIF}
        Inc(I);
    end;
  end;
end;

procedure TTBCustomItem.Notify(Action: TTBItemChangedAction; Index: Integer;
  Item: TTBCustomItem);
begin
  InternalNotify(Self, 0, Action, Index, Item);
end;

procedure TTBCustomItem.ViewBeginUpdate;
begin
  Notify(tbicSubitemsBeginUpdate, -1, nil);
end;

procedure TTBCustomItem.ViewEndUpdate;
begin
  Notify(tbicSubitemsEndUpdate, -1, nil);
end;

procedure TTBCustomItem.Insert(NewIndex: Integer; AItem: TTBCustomItem);
begin
  if Assigned(AItem.FParent) then
    raise ETBItemError.Create(STBToolbarItemReinserted);
  if (NewIndex < 0) or (NewIndex > Count) then IndexError;
  if FItems = nil then
    FItems := TList.Create;
  FItems.Insert(NewIndex, AItem);
  AItem.FParent := Self;
  ViewBeginUpdate;
  try
    Notify(tbicInserted, NewIndex, AItem);
    AItem.RefreshOptions;
  finally
    ViewEndUpdate;
  end;
end;

procedure TTBCustomItem.Delete(Index: Integer);
var
  Item: TTBCustomItem;
begin
  Item := Items[Index];  { will raise exception if out of range }
  Notify(tbicDeleting, Index, Item);
  Item.FParent := nil;
  FItems.Delete(Index);
end;

function TTBCustomItem.IndexOf(AItem: TTBCustomItem): Integer;
var
  I: Integer;
begin
  for I := 0 to Count-1 do
    if FItems.List[I] = AItem then begin
      Result := I;
      Exit;
    end;
  Result := -1;
end;

procedure TTBCustomItem.Remove(Item: TTBCustomItem);
var
  I: Integer;
begin
  I := IndexOf(Item);
  //if I = -1 then raise ETBItemError.Create(STBToolbarItemNotFound);
  if I <> -1 then
    Delete(I);
end;

procedure TTBCustomItem.Clear;
var
  I: Integer;
begin
  for I := Count-1 downto 0 do
    Items[I].Free;
end;

procedure TTBCustomItem.Move(CurIndex, NewIndex: Integer);
var
  Item: TTBCustomItem;
begin
  if CurIndex <> NewIndex then begin
    if (NewIndex < 0) or (NewIndex >= Count) then IndexError;
    Item := Items[CurIndex];
    ViewBeginUpdate;
    try
      Delete(CurIndex);
      Insert(NewIndex, Item);
    finally
      ViewEndUpdate;
    end;
  end;
end;

function TTBCustomItem.ContainsItem(AItem: TTBCustomItem): Boolean;
begin
  while Assigned(AItem) and (AItem <> Self) do
    AItem := AItem.Parent;
  Result := Assigned(AItem);
end;

procedure TTBCustomItem.RegisterNotification(ANotify: TTBItemChangedProc);
var
  I: Integer;
  Data: TItemChangedNotificationData;
begin
  if FNotifyList = nil then FNotifyList := TList.Create;
  for I := 0 to FNotifyList.Count-1 do
    with TItemChangedNotificationData(FNotifyList[I]) do
      {$IFNDEF CLR}
      if MethodsEqual(TMethod(ANotify), TMethod(Proc)) then begin
      {$ELSE}
      if @ANotify = @Proc then begin
      {$ENDIF}
        Inc(RefCount);
        Exit;
      end;
  FNotifyList.Expand;
  Data := TItemChangedNotificationData.Create;
  Data.Proc := ANotify;
  Data.RefCount := 1;
  FNotifyList.Add(Data);
end;

procedure TTBCustomItem.UnregisterNotification(ANotify: TTBItemChangedProc);
var
  I: Integer;
  Data: TItemChangedNotificationData;
begin
  if Assigned(FNotifyList) then
    for I := 0 to FNotifyList.Count-1 do begin
      Data := TItemChangedNotificationData(FNotifyList[I]);
      {$IFNDEF CLR}
      if MethodsEqual(TMethod(Data.Proc), TMethod(ANotify)) then begin
      {$ELSE}
      if @Data.Proc = @ANotify then begin
      {$ENDIF}
        Dec(Data.RefCount);
        if Data.RefCount = 0 then begin
          FNotifyList.Delete(I);
          Data.Free;
          if FNotifyList.Count = 0 then
            FreeAndNil(FNotifyList);
        end;
        Break;
      end;
    end;
end;

function TTBCustomItem.GetPopupWindowClass: TTBPopupWindowClass;
begin
  Result := TTBPopupWindow;
end;

procedure TTBCustomItem.DoPopup(Sender: TTBCustomItem; FromLink: Boolean);
begin
  if Assigned(FOnPopup) then
    FOnPopup(Sender, FromLink);
  if not(tbisCombo in ItemStyle) then
    Click;
end;

var
  PlayedSound: Boolean = False;

function TTBCustomItem.CreatePopup(const ParentView: TTBView;
  const ParentViewer: TTBItemViewer; const PositionAsSubmenu, SelectFirstItem,
  Customizing: Boolean; const APopupPoint: TPoint;
  const Alignment: TTBPopupAlignment): TTBPopupWindow;

  function CountObscured(X, Y, W, H: Integer): Integer;
  var
    I: Integer;
    P: TPoint;
    V: TTBItemViewer;
  begin
    Result := 0;
    if ParentView = nil then
      Exit;
    P := ParentView.FWindow.ClientToScreen(Point(0, 0));
    Dec(X, P.X);
    Dec(Y, P.Y);
    Inc(W, X);
    Inc(H, Y);
    for I := 0 to ParentView.FViewers.Count-1 do begin
      V := ParentView.Viewers[I];
      if V.Show and (V.BoundsRect.Left >= X) and (V.BoundsRect.Right <= W) and
         (V.BoundsRect.Top >= Y) and (V.BoundsRect.Bottom <= H) then
        Inc(Result);
    end;
  end;

var
  EventItem, ParentItem: TTBCustomItem;
  Opposite: Boolean;
  ChevronParentView: TTBView;
  X, X2, Y, Y2, W, H: Integer;
  P: TPoint;
  RepeatCalcX: Boolean;
  ParentItemRect: TRect;
  MonitorRect: TRect;
  AnimDir: TTBAnimationDirection;
begin
  EventItem := ItemContainingItems(Self);
  if EventItem <> Self then
    EventItem.DoPopup(Self, True);
  DoPopup(Self, False);

  ChevronParentView := GetChevronParentView;
  if ChevronParentView = nil then
    ParentItem := Self
  else
    ParentItem := ChevronParentView.FParentItem;

  Opposite := Assigned(ParentView) and (vsOppositePopup in ParentView.FState);
  Result := GetPopupWindowClass.CreatePopupWindow(nil, ParentView, ParentItem,
    Customizing);
  try
    if Assigned(ChevronParentView) then begin
      ChevronParentView.FreeNotification(Result.View);
      Result.View.FChevronParentView := ChevronParentView;
      Result.View.FIsToolbar := True;
      Result.View.Style := Result.View.Style +
        (ChevronParentView.Style * [vsAlwaysShowHints]);
      Result.Color := clBtnFace;
    end;

    { Calculate ParentItemRect, and MonitorRect (the rectangle of the monitor
      that the popup window will be confined to) }
    if Assigned(ParentView) then begin
      ParentView.ValidatePositions;
      ParentItemRect := ParentViewer.BoundsRect;
      P := ParentView.FWindow.ClientToScreen(Point(0, 0));
      OffsetRect(ParentItemRect, P.X, P.Y);
      if not IsRectEmpty(ParentView.FMonitorRect) then
        MonitorRect := ParentView.FMonitorRect
      else
        MonitorRect := GetRectOfMonitorContainingRect(ParentItemRect, False);
    end
    else begin
      ParentItemRect.TopLeft := APopupPoint;
      ParentItemRect.BottomRight := APopupPoint;
      MonitorRect := GetRectOfMonitorContainingPoint(APopupPoint, False);
    end;
    Result.View.FMonitorRect := MonitorRect;

    { Initialize item positions and size of the popup window }
    if ChevronParentView = nil then
      Result.View.FMaxHeight := (MonitorRect.Bottom - MonitorRect.Top) -
        (PopupMenuWindowNCSize * 2)
    else
      Result.View.WrapOffset := (MonitorRect.Right - MonitorRect.Left) -
        (PopupMenuWindowNCSize * 2);
    if SelectFirstItem then
      Result.View.Selected := Result.View.FirstSelectable;
    Result.View.UpdatePositions;
    W := Result.Width;
    H := Result.Height;

    { Calculate initial X,Y position of the popup window }
    if Assigned(ParentView) then begin
      if not PositionAsSubmenu then begin
        if ChevronParentView = nil then begin
          if (ParentView = nil) or (ParentView.FOrientation <> tbvoVertical) then begin
            if GetSystemMetrics(SM_MENUDROPALIGNMENT) = 0 then
              X := ParentItemRect.Left
            else
              X := ParentItemRect.Right - W;
            Y := ParentItemRect.Bottom;
          end
          else begin
            X := ParentItemRect.Left - W;
            Y := ParentItemRect.Top;
          end;
        end
        else begin
          if ChevronParentView.FOrientation <> tbvoVertical then begin
            X := ParentItemRect.Right - W;
            Y := ParentItemRect.Bottom;
          end
          else begin
            X := ParentItemRect.Left - W;
            Y := ParentItemRect.Top;
          end;
        end;
      end
      else begin
        X := ParentItemRect.Right - PopupMenuWindowNCSize;
        Y := ParentItemRect.Top - PopupMenuWindowNCSize;
      end;
    end
    else begin
      X := APopupPoint.X;
      Y := APopupPoint.Y;
      case Alignment of
        tbpaRight: Dec(X, W);
        tbpaCenter: Dec(X, W div 2);
      end;
    end