tb2item.pas

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

begin
  if IsShortCutLinked then FClient.ShortCut := Value;
end;

procedure TTBCustomItemActionLink.SetVisible(Value: Boolean);
begin
  if IsVisibleLinked then FClient.Visible := Value;
end;

procedure TTBCustomItemActionLink.SetOnExecute(Value: TNotifyEvent);
begin
  if IsOnExecuteLinked then FClient.OnClick := Value;
end;


{ TTBCustomItem }

{}function ItemContainingItems(const AItem: TTBCustomItem): TTBCustomItem;
begin
  if Assigned(AItem) and Assigned(AItem.FLinkSubitems) then
    Result := AItem.FLinkSubitems
  else
    Result := AItem;
end;

constructor TTBCustomItem.Create(AOwner: TComponent);
begin
  inherited;
  FEnabled := True;
  FImageIndex := -1;
  FInheritOptions := True;
  FItemStyle := [tbisSelectable, tbisRedrawOnSelChange, tbisRedrawOnMouseOverChange];
  FVisible := True;
  ReferenceClickWnd;
end;

destructor TTBCustomItem.Destroy;
var
  I: Integer;
begin
  Destroying;
  RemoveFromClickList(Self);
  { Changed in 0.33. Moved FParent.Remove call *after* the child items are
    deleted. }
  for I := Count-1 downto 0 do
    Items[I].Free;
  if Assigned(FParent) then
    FParent.Remove(Self);
  FreeAndNil(FItems);
  FActionLink.Free;
  FActionLink := nil;
  FreeAndNil(FSubMenuImagesChangeLink);
  FreeAndNil(FImagesChangeLink);
  inherited;
  if Assigned(FNotifyList) then begin
    for I := FNotifyList.Count-1 downto 0 do
      TItemChangedNotificationData(FNotifyList[I]).Free;
    FNotifyList.Free;
  end;
  FLinkParents.Free;
  ReleaseClickWnd;
end;

{$IFDEF JR_D6}
function TTBCustomItem.IsAutoCheckStored: Boolean;
begin
  Result := (ActionLink = nil) or not FActionLink.IsAutoCheckLinked;
end;
{$ENDIF}

function TTBCustomItem.IsCaptionStored: Boolean;
begin
  Result := (ActionLink = nil) or not FActionLink.IsCaptionLinked;
end;

function TTBCustomItem.IsCheckedStored: Boolean;
begin
  Result := (ActionLink = nil) or not FActionLink.IsCheckedLinked;
end;

function TTBCustomItem.IsEnabledStored: Boolean;
begin
  Result := (ActionLink = nil) or not FActionLink.IsEnabledLinked;
end;

function TTBCustomItem.IsHintStored: Boolean;
begin
  Result := (ActionLink = nil) or not FActionLink.IsHintLinked;
end;

function TTBCustomItem.IsHelpContextStored: Boolean;
begin
  Result := (ActionLink = nil) or not FActionLink.IsHelpContextLinked;
end;

function TTBCustomItem.IsImageIndexStored: Boolean;
begin
  Result := (ActionLink = nil) or not FActionLink.IsImageIndexLinked;
end;

function TTBCustomItem.IsShortCutStored: Boolean;
begin
  Result := (ActionLink = nil) or not FActionLink.IsShortCutLinked;
end;

function TTBCustomItem.IsVisibleStored: Boolean;
begin
  Result := (ActionLink = nil) or not FActionLink.IsVisibleLinked;
end;

function TTBCustomItem.IsOnClickStored: Boolean;
begin
  Result := (ActionLink = nil) or not FActionLink.IsOnExecuteLinked;
end;

function TTBCustomItem.GetAction: TBasicAction;
begin
  if FActionLink <> nil then
    Result := FActionLink.Action
  else
    Result := nil;
end;

function TTBCustomItem.GetActionLinkClass: TTBCustomItemActionLinkClass;
begin
  Result := TTBCustomItemActionLink;
end;

procedure TTBCustomItem.DoActionChange(Sender: TObject);
begin
  if Sender = Action then ActionChange(Sender, False);
end;

procedure TTBCustomItem.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
  if Action is TCustomAction then
    with TCustomAction(Sender) do
    begin
      {$IFDEF JR_D6}
      if not CheckDefaults or (Self.AutoCheck = False) then
        Self.AutoCheck := AutoCheck;
      {$ENDIF}
      if not CheckDefaults or (Self.Caption = '') then
        Self.Caption := Caption;
      if not CheckDefaults or (Self.Checked = False) then
        Self.Checked := Checked;
      if not CheckDefaults or (Self.Enabled = True) then
        Self.Enabled := Enabled;
      if not CheckDefaults or (Self.HelpContext = 0) then
        Self.HelpContext := HelpContext;
      if not CheckDefaults or (Self.Hint = '') then
        Self.Hint := Hint;
      if not CheckDefaults or (Self.ImageIndex = -1) then
        Self.ImageIndex := ImageIndex;
      if not CheckDefaults or (Self.ShortCut = scNone) then
        Self.ShortCut := ShortCut;
      if not CheckDefaults or (Self.Visible = True) then
        Self.Visible := Visible;
      if not CheckDefaults or not Assigned(Self.OnClick) then
        Self.OnClick := OnExecute;
    end;
end;

procedure TTBCustomItem.SetAction(Value: TBasicAction);
begin
  if Value = nil then begin
    FActionLink.Free;
    FActionLink := nil;
  end
  else begin
    if FActionLink = nil then
      FActionLink := GetActionLinkClass.Create(Self);
    FActionLink.Action := Value;
    FActionLink.OnChange := DoActionChange;
    { Note: Delphi's Controls.pas and Menus.pas merely check for
      "csLoading in Value.ComponentState" here. But that doesn't help when
      the Action property references an action on another form / data module
      that has already finished loading. So we check two things:
        1. csLoading in Value.ComponentState
        2. csLoading in ComponentState
      In the typical case where the item and action list reside on the same
      form, #1 and #2 are both true.
      Only #1 is true when Action references an action on another form / data
      module that is created *after* the item (e.g. if Form1.TBItem1.Action =
      Form2.Action1, and Form1 is created before Form2).
      Only #2 is true when Action references an action on another form / data
      module that is created *before* the item (e.g. if Form2.TBItem1.Action =
      Form1.Action1, and Form1 is created before Form2). }
    ActionChange(Value, (csLoading in Value.ComponentState) or
      (csLoading in ComponentState));
    Value.FreeNotification(Self);
  end;
end;

procedure TTBCustomItem.InitiateAction;
begin
  if FActionLink <> nil then FActionLink.Update;
end;

procedure TTBCustomItem.Loaded;
begin
  inherited;
  if Action <> nil then ActionChange(Action, True);
end;

procedure TTBCustomItem.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
  I: Integer;
begin
  for I := 0 to Count-1 do
    Proc(Items[I]);
end;

procedure TTBCustomItem.SetChildOrder(Child: TComponent; Order: Integer);
var
  I: Integer;
begin
  I := IndexOf(Child as TTBCustomItem);
  if I <> -1 then
    Move(I, Order);
end;

function TTBCustomItem.HasParent: Boolean;
begin
  Result := True;
end;

function TTBCustomItem.GetParentComponent: TComponent;
begin
  if (FParent <> nil) and (FParent.FParentComponent <> nil) then
    Result := FParent.FParentComponent
  else
    Result := FParent;
end;

procedure TTBCustomItem.SetName(const NewName: TComponentName);
begin
  if Name <> NewName then begin
    inherited;
    if Assigned(FParent) then
      FParent.Notify(tbicNameChanged, -1, Self);
  end;
end;

procedure TTBCustomItem.SetParentComponent(Value: TComponent);
var
  RootItem: TTBCustomItem;
begin
  if FParent <> nil then FParent.Remove(Self);
  if Value <> nil then begin
    RootItem := TBGetItems(Value);
    if Assigned(RootItem) then
      RootItem.Add(Self)
    else
      raise ETBItemError.CreateFmt(STBToolbarItemParentInvalid, [Value.ClassName]);
  end;
end;

procedure TTBCustomItem.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if Operation = opRemove then begin
    RemoveFromList(FLinkParents, AComponent);
    if AComponent = Action then Action := nil;
    if AComponent = Images then Images := nil;
    if AComponent = SubMenuImages then SubMenuImages := nil;
    if AComponent = LinkSubitems then LinkSubitems := nil;
  end;
end;

class procedure TTBCustomItem.IndexError;
begin
  raise ETBItemError.Create(STBToolbarIndexOutOfBounds);
end;

class procedure TTBCustomItem.ClickWndProc(var Message: TMessage);
var
  List: TList;
  I: Integer;
  Item: TObject;
begin
  if Message.Msg = WM_TB2K_CLICKITEM then begin
    List := ClickList;  { optimization... }
    if Assigned(List) then begin
      I := Message.LParam;
      if (I >= 0) and (I < List.Count) then begin
        Item := List[I];
        List[I] := nil;
        { If the item value is set to ClickList, then it was 'removed' from
          the list by RemoveFromClickList }
        if Item = List then
          Item := nil;
      end
      else
        Item := nil;

      { Remove trailing nil items from ClickList. This is not *necessary*, but
        it will make RemoveFromClickList faster if we clean out items that
        aren't used, and may never be used again. }
      for I := List.Count-1 downto 0 do begin
        if List[I] = nil then
          List.Delete(I)
        else
          Break;
      end;

      if Assigned(Item) then begin
        try
          if Item is TTBCustomItem then
            TTBCustomItem(Item).Click
          else if Item is TTBItemViewer then
            TTBItemViewer(Item).AccSelect(Message.WParam <> 0);
        except
          Application.HandleException(Item);
        end;
      end;
    end;
  end
  else
    with Message do
      Result := DefWindowProc(ClickWnd, Msg, wParam, lParam);
end;

procedure TTBCustomItem.PostClick;
{ Posts a message to the message queue that causes the item's Click handler to
  be executed when control is returned to the message loop.
  This should be called instead of Click when a WM_SYSCOMMAND message is
  (possibly) currently being handled, because TApplication.WndProc's
  CM_APPSYSCOMMAND handler disables the VCL's processing of focus messages
  until the Perform(WM_SYSCOMMAND, ...) call returns. (An OnClick handler which
  calls TForm.ShowModal needs focus messages to be enabled or else the form
  will be shown with no initial focus.) }
begin
  QueueClick(Self, 0);
end;

procedure TTBCustomItem.Click;
begin
  if Enabled then begin
    { Following code based on D6's TMenuItem.Click }
    {$IFDEF JR_D6}
    if (not Assigned(ActionLink) and AutoCheck) or
       (Assigned(ActionLink) and not ActionLink.IsAutoCheckLinked and AutoCheck) then
    {$ELSE}
    if AutoCheck then
    {$ENDIF}
      Checked := not Checked;
    { Following code based on D4's TControl.Click }
    { Call OnClick if assigned and not equal to associated action's OnExecute.
      If associated action's OnExecute assigned then call it, otherwise, call
      OnClick. }
    if Assigned(FOnClick) and (Action <> nil) and
       {$IFNDEF CLR}
       not MethodsEqual(TMethod(FOnClick), TMethod(Action.OnExecute)) then
       {$ELSE}
       (@FOnClick <> @Action.OnExecute) then
       {$ENDIF}
      FOnClick(Self)
    else
    if not(csDesigning in ComponentState) and (ActionLink <> nil) then
      ActionLink.Execute {$IFDEF JR_D6}(Self){$ENDIF}
    else
    if Assigned(FOnClick) then
      FOnClick(Self);
  end;
end;

function TTBCustomItem.GetCount: Integer;
begin
  if FItems = nil then
    Result := 0
  else