customizedlg.pas

这是不可多得的源代码

{*******************************************************}
{                                                       }
{       Borland Delphi Visual Component Library         }
{                                                       }
{  Copyright (c) 2000,2001 Borland Software Corporation }
{                                                       }
{*******************************************************}

unit CustomizeDlg;

interface

(*$HPPEMIT '#pragma link "dclact.lib"'*)

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ActnList, CheckLst, ComCtrls, Menus, ExtCtrls, ImgList,
  ActnMan, ActnCtrls, ActnMenus, Buttons;

type
  TCustomizeFrm = class(TForm)
    CloseBtn: TButton;
    Tabs: TPageControl;
    ToolbarsTab: TTabSheet;
    ActionsTab: TTabSheet;
    OptionsTab: TTabSheet;
    ToolbarsLbl: TLabel;
    ActionBarList: TCheckListBox;
    ResetBtn: TButton;
    CloseMenu: TPopupMenu;
    CloseItem: TMenuItem;
    PersonalizeLbl: TLabel;
    OptionsBevel2: TBevel;
    RecentlyUsedChk: TCheckBox;
    ResetUsageBtn: TButton;
    LargeIconsChk: TCheckBox;
    ShowTipsChk: TCheckBox;
    ShortCutTipsChk: TCheckBox;
    OptionsBevel1: TBevel;
    OtherLbl: TLabel;
    ActionImages: TImageList;
    Label1: TLabel;
    MenuAnimationStyles: TComboBox;
    InfoLbl: TLabel;
    DescGroupBox: TGroupBox;
    HintLbl: TLabel;
    ActionsCatLbl: TLabel;
    CatList: TListBox;
    ActionsList: TListBox;
    ActionsActionsLbl: TLabel;
    ActionList1: TActionList;
    ResetActn: TAction;
    CloseActn: TAction;
    ResetUsageDataActn: TAction;
    RecentlyUsedActn: TAction;
    FullMenusActn: TAction;
    ShowHintsActn: TAction;
    ShowShortCutsInTipsActn: TAction;
    ListPanel: TPanel;
    ComboPanel: TPanel;
    ListCombo: TComboBox;
    ApplyToAllActn: TAction;
    CaptionOptionsGrp: TGroupBox;
    ApplyToAllChk: TCheckBox;
    Label4: TLabel;
    LargeIconsActn: TAction;
    CaptionOptionsCombo: TComboBox;
    Label2: TLabel;
    SeparatorBtn: TButton;
    procedure CatListClick(Sender: TObject);
    procedure ActionsListStartDrag(Sender: TObject;
      var DragObject: TDragObject);
    procedure ActionsListDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure CloseBtnClick(Sender: TObject);
    procedure CatListStartDrag(Sender: TObject;
      var DragObject: TDragObject);
    procedure ActionBarListClickCheck(Sender: TObject);
    procedure ActionsListMeasureItem(Control: TWinControl; Index: Integer;
      var Height: Integer);
    procedure FormCreate(Sender: TObject);
    procedure ActionsListClick(Sender: TObject);
    procedure MenuAnimationStylesChange(Sender: TObject);
    procedure ResetActnUpdate(Sender: TObject);
    procedure ResetActnExecute(Sender: TObject);
    procedure ResetUsageDataActnExecute(Sender: TObject);
    procedure RecentlyUsedActnExecute(Sender: TObject);
    procedure ShowHintsActnExecute(Sender: TObject);
    procedure ShowHintsActnUpdate(Sender: TObject);
    procedure ShowShortCutsInTipsActnExecute(Sender: TObject);
    procedure RecentlyUsedActnUpdate(Sender: TObject);
    procedure ActionBarListClick(Sender: TObject);
    procedure ActionsListData(Control: TWinControl; Index: Integer;
      var Data: string);
    procedure LargeIconsActnExecute(Sender: TObject);
    procedure ListComboSelect(Sender: TObject);
    procedure CaptionOptionsComboChange(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure LargeIconsActnUpdate(Sender: TObject);
    procedure SeparatorBtnStartDrag(Sender: TObject;
      var DragObject: TDragObject);
    procedure ApplyToAllActnUpdate(Sender: TObject);
  private
    FScratchBar: TActionBarItem;
    FActionManager: TCustomActionManager;
    FActiveActionList: TCustomActionList;
    procedure SetActionManager(const Value: TCustomActionManager);
    procedure SetupListCombo;
  protected
    function AddAction(AnAction: TContainedAction): string;
    function IsDupShortCut(AShortCut: TShortCut;
      var Action: TContainedAction): Boolean;
    procedure ClearCatList; virtual;
    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;
    procedure FindActionBars;
    procedure SetActiveActionList(const Value: TCustomActionList);
    procedure UpdateDialog; virtual;
    procedure CMVisiblechanged(var Message: TMessage);
      message CM_VISIBLECHANGED;
  public
    property ActionManager: TCustomActionManager read FActionManager
      write SetActionManager;
    property ActiveActionList: TCustomActionList read FActiveActionList
      write SetActiveActionList;
  end;

  TCustomizeDlg = class(TComponent)
  private
    FCustomizeFrm: TCustomizeFrm;
    FStayOnTop: Boolean;
    FOnClose: TNotifyEvent;
    FOnShow: TNotifyEvent;
    FActionManager: TCustomActionManager;
    procedure SetStayOnTop(const Value: Boolean);
    procedure SetActionManager(const Value: TCustomActionManager);
  protected
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure SetupDlg; virtual;
  public
    procedure Show;
    property CustomizeForm: TCustomizeFrm read FCustomizeFrm;
  published
    property ActionManager: TCustomActionManager read FActionManager
      write SetActionManager;
    property StayOnTop: Boolean read FStayOnTop write SetStayOnTop;
    property OnClose: TNotifyEvent read FOnClose write FOnClose;
    property OnShow: TNotifyEvent read FOnShow write FOnShow;
  end;

implementation

{$R *.DFM}

uses Consts, TypInfo, Commctrl;

var
  CustomizeFrm: TCustomizeFrm;

{ TCustomizeFrm }

function TCustomizeFrm.AddAction(AnAction: TContainedAction): string;
var
  I: Integer;
begin
  if AnAction = nil then Exit;
  AnAction.FreeNotification(Self);
  if (AnAction.Category = '') then
    Result := SNoCategory
  else
    Result := AnAction.Category;
  with CatList.Items do
  begin
    I := CatList.Items.IndexOf(Result);
    if I = -1 then
      I := CatList.Items.AddObject(Result, TStringList.Create);
    TStringList(Objects[I]).AddObject('', AnAction);
    I := IndexOf(SAllActions);
    if I = -1 then
      I := AddObject(SAllActions, TStringList.Create);
    TStringList(Objects[I]).AddObject('', AnAction);
    Move(I, Count - 1);
  end;
end;

procedure TCustomizeFrm.SetActionManager(const Value: TCustomActionManager);
begin
  if FActionManager <> Value then
  begin
    ClearCatList;
    if Assigned(FActionManager) then
      FActionManager.RemoveFreeNotification(Self);
    FActionManager := Value;
    if Assigned(FActionManager) then
    begin
      if not (csDesigning in FActionManager.ComponentState) then
        FActionManager.State := asSuspendedEnabled;
      FActiveActionList := FActionManager;
      FActionManager.FreeNotification(Self);
      SetupListCombo;
    end;
  end;
end;

procedure TCustomizeFrm.CatListClick(Sender: TObject);
begin
  if (CatList.Items.Count = 0) or (CatList.ItemIndex = -1) then Exit;
    if Assigned(CatList.Items.Objects[CatList.ItemIndex]) then
      ActionsList.Items.Assign(TStringList(CatList.Items.Objects[CatList.ItemIndex]));
  HintLbl.Caption := '';
  if ActionsList.Items.Count > 0 then
  begin
    ActionsList.ItemIndex := 0;
    ActionsList.Selected[0] := True;
    ActionsListClick(Sender);
  end;
end;

procedure TCustomizeFrm.ActionsListStartDrag(Sender: TObject;
  var DragObject: TDragObject);
var
  I: Integer;
begin
  if (ActionsList.Items.Count = 0) or (ActionsList.ItemIndex = -1) then Exit;
  DragObject := TActionDragObject.Create;
  TCategoryDragObject(DragObject).ActionManager := ActionManager;
  for I := 0 to ActionsList.Items.Count - 1 do
    if ActionsList.Selected[I] then
      with ActionsList do
        TActionDragObject(DragObject).AddAction(
          TCustomAction(ActionsList.Items.Objects[I]));
end;

procedure TCustomizeFrm.ActionsListDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
const
  TextColor: array[Boolean] of TColor = (clWindowText, clHighlight);
var
  AnAction: TCustomAction;
  ImgRect: TRect;
  OldColor: TColor;
  ARect: TRect;
  ACaption: string;
  ShortCutText: string;
begin
  if (ActionManager = nil) or (ActionsList.Items.Count = 0) then Exit;
  Canvas.Font.Color := TextColor[odSelected in State];
  if odSelected in State then
    ActionsList.Canvas.Brush.Color := clHighlight
  else
    ActionsList.Canvas.Brush.Color := ActionsList.Color;
  ActionsList.Canvas.FillRect(Rect);
  AnAction := nil;
  if ActionsList.Items.Objects[Index] is TCustomAction then
    AnAction := TCustomAction(ActionsList.Items.Objects[Index]);
  if AnAction = nil then Exit;
  ARect := Rect;
  if Assigned(AnAction.ActionList.Images) then
  begin
    if TCustomAction(ActionsList.Items.Objects[Index]) is TCustomAction then
    begin
      if (AnAction.ImageIndex > -1) and
         (AnAction.ImageIndex < AnAction.ActionList.Images.Count) then
      begin
        if odSelected in State then
        begin
          OldColor := ActionsList.Canvas.Brush.Color;
          ActionsList.Canvas.Brush.Color := ActionsList.Color;
          ImgRect := Classes.Rect(1, Rect.Top + 1, AnAction.ActionList.Images.Width + 4,
            Rect.Top + AnAction.ActionList.Images.Height + 3);
          ActionsList.Canvas.FillRect(ImgRect);
          DrawEdge(ActionsList.Canvas.Handle, ImgRect, BDR_RAISEDINNER,
            BF_RECT or BF_MIDDLE);
          ActionsList.Canvas.Brush.Color := OldColor;
        end;
        with AnAction.ActionList.Images do
          ImageList_DrawEx(Handle, AnAction.ImageIndex, ActionsList.Canvas.Handle,
            2, Rect.Top + 2, AnAction.ActionList.Images.Width,
            AnAction.ActionList.Images.Height, ColorToRGB(ActionsList.Color),
            clNone, ILD_Normal);
      end;
    end;
    ARect.Left := AnAction.ActionList.Images.Width + 6;
  end
  else
    ARect.Left := 6;
  if AnAction.Caption <> '' then
    ACaption := AnAction.Caption
  else
    ACaption := AnAction.Name;
  DrawText(ActionsList.Canvas.Handle, PChar(ACaption),
    Length(ACaption), ARect, DT_LEFT or DT_VCENTER or DT_SINGLELINE);
  if AnAction.ShortCut <> 0 then
  begin
    Dec(ARect.Right, 10);
    ShortCutText := ShortCutToText(AnAction.ShortCut);
    DrawText(ActionsList.Canvas.Handle, PChar(ShortCutText),
      Length(ShortCutText), ARect, DT_RIGHT or DT_VCENTER or DT_SINGLELINE);
  end;

  if (Tabs.ActivePage = ActionsTab) and (odSelected in State) then
  begin
    ActionsList.Canvas.Brush.Color := clHighlight;
    PatBlt(ActionsList.Canvas.Handle, Rect.Left + 4, Rect.Top + 2,
      Rect.Right - Rect.Left - 8, 1, DSTINVERT);
    PatBlt(ActionsList.Canvas.Handle, Rect.Left + 4, Rect.Bottom - 3,
      Rect.Right - Rect.Left - 8, 1, DSTINVERT);
    PatBlt(ActionsList.Canvas.Handle, Rect.Left + 3, Rect.Top + 2,
      1, Rect.Bottom - Rect.Top - 4, DSTINVERT);
    PatBlt(ActionsList.Canvas.Handle, Rect.Right - Rect.Left - 4, Rect.Top + 2,
      1, Rect.Bottom - Rect.Top - 4, DSTINVERT);
  end;
end;

procedure TCustomizeFrm.FindActionBars;
var
  I: Integer;
  Idx: Integer;
begin
  if ActionManager = nil then Exit;
  ActionBarList.Items.BeginUpdate;
  Idx := ActionBarList.ItemIndex;
  try
    ActionBarList.Clear;
    for I := 0 to ActionManager.ActionBars.Count - 1 do
      if Assigned(ActionManager.ActionBars[I].ActionBar) then
        with ActionManager.ActionBars[I] do
        begin
          ActionBar.FreeNotification(Self);
          ActionBar.DesignMode := True;
          ActionBarList.Items.AddObject(ActionBar.Caption, ActionBar);
          ActionBarList.Checked[ActionBarList.Items.Count - 1] := ActionBar.Visible;
          ActionBarList.ItemEnabled[ActionBarList.Items.Count - 1] := ActionBar.AllowHiding;
          if (ActionBar is TCustomActionMainMenuBar) and
             Assigned(TCustomActionBar(ActionBar).ActionClient) then
          begin
            RecentlyUsedActn.Checked := ActionBar.ActionClient.Items.HideUnused;
            MenuAnimationStyles.ItemIndex := Ord(TCustomActionMenuBar(ActionBar).AnimationStyle);
          end;
        end;
  finally
    ActionBarList.Items.EndUpdate;
    if (Idx = -1) and (ActionBarList.Items.Count > 0) then
      ActionBarList.ItemIndex := 0
    else
      ActionBarList.ItemIndex := Idx;
    ActionBarListClick(nil);
  end;
end;

procedure TCustomizeFrm.FormClose(Sender: TObject;
  var Action: TCloseAction);
var
  I: Integer;
begin
  FScratchBar.Free;
  if Assigned(FActionManager) then
  begin
    if not (csDesigning in FActionManager.ComponentState) then
    begin
      FActionManager.State := asNormal;
      for I := 0 to ActionBarList.Items.Count - 1 do
        TCustomActionBar(ActionBarList.Items.Objects[I]).DesignMode := False;
    end;
    for I := 0 to ActionManager.ActionBars.Count - 1 do
      if Assigned(ActionManager.ActionBars[I].ActionBar) then
        ActionManager.ActionBars[I].ActionBar.RemoveFreeNotification(Self);
  end;
  ActionManager := nil;
  Action := caFree;
  CustomizeFrm := nil;
end;

procedure TCustomizeFrm.CloseBtnClick(Sender: TObject);
begin
  Close;
end;

procedure TCustomizeFrm.Notification(AComponent: TComponent;
  Operation: TOperation);
var
  I, X: Integer;
  UpdateList: Boolean;
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
    if AComponent = FActionManager then
    begin
      FActionManager := nil;
      Close;
    end
    else if AComponent is TBasicAction and not (csDestroying in ComponentState) then
    begin
      UpdateList := False;
      with CatList.Items do
        for I := Count - 1 downto 0 do
        begin
          X := TStringList(Objects[I]).IndexOfObject(AComponent);
          if X <> - 1 then
          begin
            TStringList(Objects[I]).Delete(X);
            UpdateList := True;
          end;
          if TStringList(Objects[I]).Count = 0 then
          begin
            CatList.Items.Delete(I);
            ActionsList.Items.BeginUpdate;
            try
              ActionsList.Items.Clear;
            finally
              ActionsList.Items.EndUpdate;
            end;
          end;
        end;
      if UpdateList then
        CatListClick(nil);
    end
    else if AComponent is TCustomActionBar then
      for I := 0 to ActionBarList.Items.Count - 1 do
        if AComponent = ActionBarList.Items.Objects[I] then
        begin
          ActionBarList.Items.Delete(I);
          break;
        end;
end;

procedure TCustomizeFrm.CatListStartDrag(Sender: TObject;
  var DragObject: TDragObject);
var
  I: Integer;
begin
  if (ActionManager.ActionCount = 0) or (CatList.Items.Count = 0) or
     (ActionsList.Items.Count = 0) or (CatList.ItemIndex = -1) then Exit;
  if (AnsiCompareText(CatList.Items[CatList.ItemIndex], SNoCategory) = 0) or
     (AnsiCompareText(CatList.Items[CatList.ItemIndex], SAllActions) = 0) then
    Exit;
  DragObject := TCategoryDragObject.Create(CatList.Items[CatList.ItemIndex]);
  TCategoryDragObject(DragObject).ActionManager := ActionManager;
  for I := 0 to ActionsList.Items.Count - 1 do
    with ActionsList, ActionsList.Items do
      TActionDragObject(DragObject).AddAction(TContainedAction(Objects[I]));
end;

procedure TCustomizeFrm.ActionBarListClickCheck(Sender: TObject);
begin
  with ActionBarList do
  begin
    if (Items.Count = 0) or (ItemIndex < 0) or
       not TCustomActionBar(Items.Objects[ItemIndex]).AllowHiding then Exit;
      if Assigned(TCustomActionBar(Items.Objects[ItemIndex]).ActionClient) then
        TCustomActionBar(Items.Objects[ItemIndex]).ActionClient.Visible := Checked[ItemIndex]
      else
        TCustomActionBar(Items.Objects[ItemIndex]).Visible := Checked[ItemIndex];