customizedlg.pas

这是不可多得的源代码

  end;
  Application.ProcessMessages;
end;

procedure TCustomizeFrm.ActionsListMeasureItem(Control: TWinControl;
  Index: Integer; var Height: Integer);
begin
  if Assigned(ActionManager) and Assigned(ActionManager.Images) then
    Height := ActionManager.Images.Height + 4
  else
    Height := Abs(ActionsList.Font.Height) + 8;
end;

procedure TCustomizeFrm.UpdateDialog;

  function AddActions(ActionList: TCustomActionList): string;
  var
    I: Integer;
  begin
    Result := '';
    for I := 0 to ActionList.ActionCount - 1 do
      Result := AddAction(ActionList.Actions[I]);
  end;

  procedure SelectCategory(ACategory: string);
  begin
    if CatList.HandleAllocated and (CatList.Items.IndexOf(ACategory) <> -1) then
    begin
      CatList.ItemIndex := CatList.Items.IndexOf(ACategory);
      CatListClick(nil);
    end
  end;

var
  Category: string;
  OriginalCat: string;
  I: Integer;
begin
  CatList.Items.BeginUpdate;
  try
    if CatList.ItemIndex <> -1 then
      OriginalCat := CatList.Items[CatList.ItemIndex];
    ClearCatList;
    if Assigned(FActionManager) then
    begin
      if ActionManager.ActionBars.Count > 0 then
      ShowHintsActn.Checked := ActionManager.ActionBars.ShowHints;
      ShowShortCutsInTipsActn.Checked := ActionManager.ActionBars.HintShortCuts;
      FindActionBars;
      if FActiveActionList = nil then
      begin
        if FActionManager.ActionCount > 0 then
          Category := AddActions(FActionManager);
        for I := 0 to FActionManager.LinkedActionLists.Count - 1 do
          Category := AddActions(FActionManager.LinkedActionLists[I].ActionList);
      end
      else
        if FActiveActionList.ActionCount > 0 then
          Category := AddActions(FActiveActionList);
    end;
  finally
    CatList.Items.EndUpdate;
    ActionsList.Items.Clear;
    if (OriginalCat <> '') then
      SelectCategory(OriginalCat)
    else
      SelectCategory(Category);
  end;
end;

procedure TCustomizeFrm.ClearCatList;
var
  I, Y: Integer;
begin
  CatList.Items.BeginUpdate;
  try
    for I := 0 to CatList.Items.Count - 1 do
      if Assigned(CatList.Items.Objects[I]) then
      begin
        with CatList.Items.Objects[I] as TStringList do
          for Y := 0 to Count - 1 do
            TComponent(Objects[Y]).RemoveFreeNotification(Self);
        CatList.Items.Objects[I].Free;
      end;
    CatList.Clear;
  finally
    CatList.Items.EndUpdate;
  end;
end;

procedure TCustomizeFrm.CMVisiblechanged(var Message: TMessage);
begin
  inherited;
  if Visible then
    UpdateDialog;
end;

function TCustomizeFrm.IsDupShortCut(AShortCut: TShortCut;
  var Action: TContainedAction): Boolean;

  function CheckAction(AnAction: TContainedAction): Boolean;
  begin
    Result := (AnAction is TCustomAction) and
              ((TCustomAction(AnAction).ShortCut = AShortCut) or
               (Assigned(TCustomAction(AnAction).SecondaryShortCuts) and 
               (TCustomAction(AnAction).SecondaryShortCuts.IndexOfShortCut(AShortCut) >= 0)))
  end;

var
  I: Integer;
begin
  Action := nil;
  Result := False;
  if ActionsList.ItemIndex = -1 then Exit;
  Action := TContainedAction(ActionsList.Items.Objects[ActionsList.ItemIndex]);
  Result := CheckAction(TContainedAction(ActionsList.Items.Objects[ActionsList.ItemIndex]));
  if Result then Exit;
  for I := 0 to ActionManager.ActionCount - 1 do
    if (ActionManager.Actions[I].Index <> Integer(ActionsList.Items.Objects[ActionsList.ItemIndex])) and
       (ActionManager.Actions[I] is TCustomAction) then
    begin
      Result := CheckAction(ActionManager.Actions[I]);
      if not Result then continue;
      Action := ActionManager.Actions[I];
      Break;
    end;
end;

procedure TCustomizeFrm.SetActiveActionList(
  const Value: TCustomActionList);
begin
  if FActiveActionList <> Value then
  begin
    FActiveActionList := Value;
    UpdateDialog;
  end;
end;

procedure TCustomizeFrm.SetupListCombo;
var
  I: Integer;
begin
  if not Assigned(FActionManager) then Exit;
  if not (csDesigning in FActionManager.ComponentState) and
     (FActionManager.LinkedActionLists.Count = 0) then
  begin
    ComboPanel.Visible := False;
    ListPanel.Height := DescGroupBox.Top - 5;
    Exit;
  end;
  ListCombo.Items.AddObject(SAllActions, nil);
  ListCombo.Items.AddObject(FActionManager.Name, FActionManager);
  for I := 0 to FActionManager.LinkedActionLists.Count - 1 do
    if Assigned(FActionManager.LinkedActionLists[I].ActionList) then
      ListCombo.Items.AddObject(FActionManager.LinkedActionLists.ListItems[I].Caption,
        FActionManager.LinkedActionLists[I].ActionList);
  ListCombo.ItemIndex := 0;
  if ListCombo.Items.Count = 2 then
    ActiveActionList := FActionManager;
end;

procedure TCustomizeFrm.FormCreate(Sender: TObject);
begin
  Tabs.ActivePage := ActionsTab;
  ActiveControl := CatList;
  HintLbl.Caption := '';
end;

procedure TCustomizeFrm.ActionsListClick(Sender: TObject);
begin
  if (ActionsList.Items.Count = 0) or (ActionsList.ItemIndex = -1) then Exit;
  if ActionsList.Items.Objects[ActionsList.ItemIndex] is TCustomAction then
    with ActionsList.Items.Objects[ActionsList.ItemIndex] as TCustomAction do
      HintLbl.Caption := GetLongHint(Hint);
end;

procedure TCustomizeFrm.MenuAnimationStylesChange(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to ActionBarList.Items.Count - 1 do
    if ActionBarList.Items.Objects[I] is TCustomActionMenuBar then
      with ActionBarList.Items.Objects[I] as TCustomActionMenuBar do
        AnimationStyle := TAnimationStyle(MenuAnimationStyles.ItemIndex);
end;

procedure TCustomizeFrm.ResetActnUpdate(Sender: TObject);
begin
  with Sender as TCustomAction do
    Enabled := Assigned(ActionManager) and
      Assigned(ActionManager.DefaultActionBars) and
      (ActionBarList.ItemIndex <> -1);
end;

procedure TCustomizeFrm.ResetActnExecute(Sender: TObject);
begin
  ActionManager.ResetActionBar(ActionBarList.ItemIndex);
end;

procedure TCustomizeFrm.ResetUsageDataActnExecute(Sender: TObject);
begin
  if MessageDlg(SResetUsageData, mtConfirmation, [mbOK, mbCancel], 0) = mrOK then
    if Assigned(FActionManager) then
      ActionManager.ResetUsageData;
end;

procedure TCustomizeFrm.RecentlyUsedActnExecute(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to ActionBarList.Items.Count - 1 do
    with ActionBarList, ActionBarList.Items do
      if (TCustomActionBar(Objects[I]) is TCustomActionMenuBar) and
         Assigned(TCustomActionBar(Objects[I]).ActionClient) then
        TCustomActionBar(Objects[I]).ActionClient.Items.HideUnused := RecentlyUsedChk.Checked;
end;

procedure TCustomizeFrm.ShowHintsActnExecute(Sender: TObject);
begin
  ActionManager.ActionBars.ShowHints := ShowHintsActn.Checked;
end;

procedure TCustomizeFrm.ShowHintsActnUpdate(Sender: TObject);
begin
  ShowHintsActn.Enabled := ActionManager.ActionBars.Count > 0;
  ShowShortCutsInTipsActn.Enabled := ShowHintsActn.Enabled and ShowHintsActn.Checked;
end;

procedure TCustomizeFrm.ShowShortCutsInTipsActnExecute(Sender: TObject);
begin
  ActionManager.ActionBars.HintShortCuts := ShowShortCutsInTipsActn.Checked;
end;

procedure TCustomizeFrm.RecentlyUsedActnUpdate(Sender: TObject);
var
  I: Integer;
begin
  if ActionBarList.Items.Count = 0 then
  begin
    RecentlyUsedActn.Enabled := False;
    Exit;
  end;
  for I := 0 to ActionBarList.Items.Count - 1 do
    with ActionBarList, ActionBarList.Items do
      if (TCustomActionBar(Objects[I]) is TCustomActionMenuBar) and
         Assigned(TCustomActionBar(Objects[I]).ActionClient) then
      begin
        RecentlyUsedActn.Enabled := True;
        break;
      end
      else
        RecentlyUsedActn.Enabled := False;
end;

procedure TCustomizeFrm.ActionBarListClick(Sender: TObject);
begin
  if (ActionBarList.Items.Count = 0) or (ActionBarList.ItemIndex = -1) then Exit;
  with TCustomActionBar(ActionBarList.Items.Objects[ActionBarList.ItemIndex]) do
    CaptionOptionsCombo.ItemIndex := Ord(ActionClient.Items.CaptionOptions);
end;

procedure TCustomizeFrm.ActionsListData(Control: TWinControl;
  Index: Integer; var Data: string);
begin
  Data := TStringList(CatList.Items.Objects[CatList.ItemIndex]).Strings[Index];
end;

procedure TCustomizeFrm.LargeIconsActnExecute(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to ActionBarList.Items.Count - 1 do
    if ActionBarList.Items.Objects[I] is TCustomActionToolBar then
      with TCustomActionBar(ActionBarList.Items.Objects[I]) do
        ActionClient.Items.SmallIcons := not LargeIconsActn.Checked;
end;

procedure TCustomizeFrm.LargeIconsActnUpdate(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to ActionBarList.Items.Count - 1 do
    if ActionBarList.Items.Objects[I] is TCustomActionToolBar then
    begin
      with TCustomActionBar(ActionBarList.Items.Objects[I]) do
        LargeIconsActn.Checked := not ActionClient.Items.SmallIcons;
      Exit;
    end;
  LargeIconsActn.Checked := False;
end;

procedure TCustomizeFrm.ListComboSelect(Sender: TObject);
begin
  ActiveActionList := TCustomActionList(ListCombo.Items.Objects[ListCombo.ItemIndex]);
end;

procedure TCustomizeFrm.CaptionOptionsComboChange(Sender: TObject);
var
  I: Integer;
begin
  if ApplyToAllActn.Checked then
  begin
    for I := 0 to ActionBarList.Items.Count - 1 do
      if ActionBarList.Items.Objects[ActionBarList.ItemIndex] is TCustomActionToolBar then
        with TCustomActionBar(ActionBarList.Items.Objects[I]) do
          ActionClient.Items.CaptionOptions := TCaptionOptions(CaptionOptionsCombo.ItemIndex);
  end
  else
    with TCustomActionBar(ActionBarList.Items.Objects[ActionBarList.ItemIndex]) do
      ActionClient.Items.CaptionOptions := TCaptionOptions(CaptionOptionsCombo.ItemIndex);
end;

procedure TCustomizeFrm.FormResize(Sender: TObject);
begin
  ActionsList.Invalidate;
end;

{ TCustomizeDlg }

procedure TCustomizeDlg.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) then
  begin
    if AComponent = FActionManager then
    begin
      if Assigned(FCustomizeFrm) then
        FCustomizeFrm.Close;
      FActionManager := nil;
    end;
    if AComponent = FCustomizeFrm then
    begin
      FCustomizeFrm := nil;
      if Assigned(FOnClose) then
        FOnClose(Self);
    end;
  end;
end;

procedure TCustomizeDlg.SetActionManager(const Value: TCustomActionManager);
begin
  if FActionManager <> Value then
  begin
    if Assigned(FActionManager) then
      FActionManager.RemoveFreeNotification(Self);
    FActionManager := Value;
    if Assigned(FActionManager) then
      FActionManager.FreeNotification(Self);
  end;
end;

procedure TCustomizeDlg.SetStayOnTop(const Value: Boolean);
begin
  FStayOnTop := Value;
  if Assigned(FCustomizeFrm) then
    if Value then
      FCustomizeFrm.FormStyle := fsStayOnTop
    else
      FCustomizeFrm.FormStyle := fsNormal;    
end;

procedure TCustomizeDlg.SetupDlg;
begin
  if FActionManager = nil then
    raise Exception.Create(SErrorActionManagerNotAssigned);
  if FCustomizeFrm = nil then
    FCustomizeFrm := TCustomizeFrm.Create(Self);
  with FCustomizeFrm do
  begin
    FCustomizeFrm.ActionManager := Self.ActionManager;
    if FCustomizeFrm.CatList.Items.Count > 0 then
      FCustomizeFrm.CatList.ItemIndex := 0;
    OnShow := FOnShow;
    if FStayOnTop then
      FormStyle := fsStayOnTop
    else
      FormStyle := fsNormal;
  end;
end;

procedure TCustomizeDlg.Show;
begin
  SetupDlg;
  FCustomizeFrm.Show;
end;

type
  TCustomActionControlClass = class(TCustomActionControl);
  TControlClass = class(TControl);

{ TActionSeparatorDragObject }

  TActionSeparatorDragObject = class(TActionItemDragObject)
  private
    FCustomizeFrm: TCustomizeFrm;
  protected
    constructor Create(CustomizeFrm: TCustomizeFrm; Client: TActionClientItem);
    procedure Finished(Target: TObject; X: Integer; Y: Integer;
      Accepted: Boolean); override;
  end;

procedure TCustomizeFrm.SeparatorBtnStartDrag(Sender: TObject;
  var DragObject: TDragObject);
var
  C: TCustomActionControl;
begin
  // Create a scratch ActionBand for us to drop separators from
  if not Assigned(FScratchBar) then
    FScratchBar := FActionManager.ActionBars.Add;
  C := TCustomActionControl.Create(nil);
  try
    TControlClass(C).DragMode := dmAutomatic;
    C.ActionClient := FScratchBar.Items.Add;
    C.Visible := False;
    C.Parent := Self;
    C.Align := alCustom;
    C.ActionClient.Caption := '-';
    TCustomActionControlClass(C).DragMode := dmAutomatic;
    DragObject := TActionSeparatorDragObject.Create(Self, C.ActionClient);
    TActionSeparatorDragObject(DragObject).ActionManager := ActionManager;
  finally
    C.Free;
  end;
end;

{ TActionSeparatorDragObject }

constructor TActionSeparatorDragObject.Create(CustomizeFrm: TCustomizeFrm;
  Client: TActionClientItem);
begin
  FCustomizeFrm := CustomizeFrm;
  ClientItem := Client;
end;

procedure TActionSeparatorDragObject.Finished(Target: TObject; X,
  Y: Integer; Accepted: Boolean);
begin
  inherited;
  FreeAndNil(FCustomizeFrm.FScratchBar);
end;

procedure TCustomizeFrm.ApplyToAllActnUpdate(Sender: TObject);
begin
  with Sender as TCustomAction do
  begin
    Enabled := (ActionBarList.ItemIndex <> -1);
    CaptionOptionsGrp.Enabled := Enabled;
  end;
end;

initialization
  GroupDescendentsWith(TCustomizeDlg, Controls.TControl);

end.