actnman.pas

多数代码可以直接在Delphi6和Delphi7环境下运行。部分涉及.NET技术内容的代码

begin
  if AClient is TActionClientItem then
    with AClient as TActionClientItem do
      if AnsiCompareText(Caption, FCompareCaption) = 0 then
        FFoundClient := TActionClientItem(AClient);
end;

function TCustomActionManager.CreateActionBars: TActionBars;
begin
  Result := GetActionBarsClass.Create(Self, GetActionBarItemClass);
end;

procedure TCustomActionManager.DeleteActionItems(
  Actions: array of TCustomAction);
var
  I: Integer;
  Item: TActionClientItem;
begin
  for I := Low(Actions) to High(Actions) do
  begin
    Item := FindItemByAction(Actions[I]);
    if Assigned(Item) then
      Item.Free;
  end;
end;

procedure TCustomActionManager.DefineProperties(Filer: TFiler);

  function StyleNameStored: Boolean;
  begin
    if Assigned(Filer.Ancestor) then
      Result := Style <> TCustomActionManager(Filer.Ancestor).Style else
      Result := Style <> nil;
  end;

begin
  inherited;
  Filer.DefineProperty('StyleName', ReadStyleProp, { Do not localize }
    WriteStyleProp, StyleNameStored);
end;

procedure TCustomActionManager.DeleteItem(Caption: string);
var
  Item: TActionClientItem;
begin
  FFoundClient := nil;
  FCompareCaption := Caption;
  Item := FindItemByCaption(Caption);
  if Assigned(Item) then
    Item.Free;
end;

procedure TCustomActionManager.FindClient(AClient: TActionClient);
begin
  if Assigned(AClient) and Assigned(FCompareProc) and
     Assigned(FFoundClient) then exit;  // Only find the first occurance
    FCompareProc(AClient);
end;

function TCustomActionManager.FindItem: TActionClientItem;
begin
  FFoundClient := nil;
  ActionBars.IterateClients(ActionBars, FindClient);
  Result := FFoundClient;
end;

function TCustomActionManager.FindItemByAction(
  Action: TCustomAction): TActionClientItem;
begin
  FCompareProc := CompareAction;
  FAction := Action;
  Result := FindItem;
end;

function TCustomActionManager.FindItemByCaption(
  ACaption: string): TActionClientItem;
begin
  FCompareProc := CompareCaption;
  FCompareCaption := ACaption;
  Result := FindItem;
end;

function TCustomActionManager.FindActionClient(AnAction: TContainedAction;
  Clients: TActionClientsCollection): TActionClientItem;
var
  I: Integer;
begin
  Result := nil;
  if Clients = nil then
   Clients := ActionBars;
   for I := 0 to Clients.Count - 1 do
    if Clients[I] is TActionClientItem and
       (TActionClientItem(Clients[I]).Action = AnAction) then
    begin
      Result := TActionClientItem(Clients[I]);
      break;
    end
    else
      if Clients[I].HasItems then
      begin
        Result := FindActionClient(AnAction, Clients[I].Items);
        if Assigned(Result) then
          break;
      end;
end;

function TCustomActionManager.FindActionBar(ActionBar: TCustomActionBar;
  Clients: TActionClientsCollection): TActionClient;
var
  I: Integer;
begin
  Result := nil;
  if Clients = nil then
    Clients := ActionBars;
  for I := 0 to Clients.Count - 1 do
    if Clients[I].ActionBar = ActionBar then
    begin
      Result := Clients[I];
      break;
    end
    else
      if Clients[I].HasItems then
      begin
        Result := FindActionBar(ActionBar, Clients[I].Items);
        if Assigned(Result) then
          break;
      end;
end;

procedure TCustomActionManager.LoadFromFile(const Filename: string);
var
  S: TFileStream;
begin
  S := TFileStream.Create(Filename, fmOpenRead or fmShareDenyWrite);
  try
    try
      LoadFromStream(S);
    except
      //  swallow exceptions here because we still want the app to start
      FreeAndNil(S);
      if MessageDlg(Format(SErrorLoadingFile, [FileName]), mtError,
         [mbYes, mbNo], 0) = mrYes then
        DeleteFile(FileName);
    end;
  finally
    FreeAndNil(S);
  end;
end;

procedure TCustomActionManager.LoadFromStream(S: TStream);
var
  Stream: TMemoryStream;
begin
  Stream := TMemoryStream.Create;
  FLoading := True;
  try
    FDefaultActionBars := CreateActionBars;
    FDefaultActionBars.Assign(ActionBars);
    try
      Stream.LoadFromStream(S);
      Stream.Position := 0;
      Stream.ReadComponent(Self);
      inherited Loaded;  // Reset the csLoading flag
      SetupActionBars(ActionBars);
    except
      FActionBars.Assign(FDefaultActionBars);
      raise;
    end;
  finally
    FLoading := False;
    Stream.Free;
  end;
end;

procedure TCustomActionManager.Loaded;
var
  I: Integer;
begin
  inherited Loaded;
  if FLoading then exit;
  if not (csDesigning in ComponentState) and FileExists(FileName) then
    LoadFromFile(FFileName)
  else
    SetupActionBars(FActionBars);
  if not (csDesigning in ComponentState) then
    Inc(ActionBars.FSessionCount);
  for I := 0 to ActionBars.Count - 1 do
    if Assigned(ActionBars[I].ActionBar) and 
       (ActionBars[I].ActionBar.ColorMap = ActionBars[I].ActionBar.FDefaultColorMap) then
      ActionBars[I].ActionBar.ColorMap := nil;
end;

procedure TCustomActionManager.LoadMenu(Clients: TActionClients; AMenu: TMenuItem);
var
  I: Integer;
begin
  for I := 0 to AMenu.Count - 1 do
    with Clients.Add do
    begin
      Caption := AMenu.Items[I].Caption;
      Action := TContainedAction(AMenu.Items[I].Action);
      if Assigned(Action) then
        Action.ActionList := Self;
      if AMenu.Items[I].Count > 0 then
        LoadMenu(Items, AMenu.Items[I]);
    end;
end;

procedure TCustomActionManager.Notification(AComponent: TComponent;
  Operation: TOperation);
var
  Item: TActionClientItem;
  ABar: TActionClient;
  I: Integer;
  Bars: TList;
begin
  inherited Notification(AComponent, Operation);
  if Application.Terminated and (Length(FFileName) > 0) and not FSaved then
  begin
    SaveToFile(FFileName);
    FSaved := True;
  end;
  if (Operation = opRemove) and not (csDestroying in ComponentState) then
    if (AComponent is TContainedAction) then
    begin
      Item := FindActionClient(TContainedAction(AComponent));
      Bars := TList.Create;
      try
        while Item <> nil do
        begin
          if Assigned(Item.ActionClients.ParentItem.ActionBar) then
          begin
            Item.ActionClients.ParentItem.ActionBar.DisableAlign;
            Bars.Add(Item.ActionClients.ParentItem.ActionBar);
          end;
          Item.ActionClients.Delete(Item.Index);
          Item := FindActionClient(TContainedAction(AComponent));
        end;
      finally
        for I := 0 to Bars.Count - 1 do
          if Assigned(Bars[I]) then
            TCustomActionBar(Bars[I]).EnableAlign;
        Bars.Free;
      end;
    end
    else if (AComponent is TCustomActionBar) then
    begin
      ABar := FindActionBar(TCustomActionBar(AComponent), ActionBars);
      if Assigned(ABar) then
        ABar.FActionBar := nil;
      ABar := FindActionBar(TCustomActionBar(AComponent), DefaultActionBars);
      if Assigned(ABar) then
        ABar.FActionBar := nil;
    end
    else if (AComponent is TCustomActionList) and Assigned(FLinkedActionLists) then
      for I := FLinkedActionLists.Count - 1 downto 0 do
        if FLinkedActionLists[I].ActionList = AComponent then
        begin
          FLinkedActionLists.Delete(I);
          break;
        end;
end;

procedure TCustomActionManager.SaveToFile(const Filename: string);
var
  S: TStream;
begin
  State := asNormal;
  try
    S := TFileStream.Create(ExpandFileName(Filename), fmCreate);
    try
      try
        SaveToStream(S);
      except
        //  catch all exceptions because we still want the app to shutdown
      end;
    finally
      S.Free;
    end;
  except
    ShowMessage(SUnableToSaveSettings);
  end;
end;

procedure TCustomActionManager.SaveToStream(S: TStream);
var
  BinaryStream: TMemoryStream;
begin
  BinaryStream := TMemoryStream.Create;
  try
    BinaryStream.WriteComponent(Self);
    BinaryStream.Position := 0;
    S.CopyFrom(BinaryStream, BinaryStream.Size);
  finally
    BinaryStream.Free;
  end;
end;

procedure TCustomActionManager.SetupActionBars(ActionBars: TActionClientsCollection);
var
  I: Integer;
begin
  if ActionBars.Count = 0 then exit;
  for I := 0 to ActionBars.Count - 1 do
    if Assigned(ActionBars[I].ActionBar) then
    begin
      ActionBars.InternalRethinkHotkeys(True);
      ActionBars[I].ActionBar.ActionClient := ActionBars[I];
      ActionBars[I].ActionBar.Resize;
      ActionBars[I].ActionBar.RequestAlign;
    end;
end;

procedure TCustomActionManager.SetActionBars(const Value: TActionBars);
begin
  FActionBars.Assign(Value);
end;

procedure TCustomActionManager.SetImages(Value: TCustomImageList);
var
  I, X: Integer;
  Update: Boolean;
begin
  Update := (Value <> Images) and not (csDestroying in ComponentState);
  inherited SetImages(Value);
  if not Update then exit;
  for I := 0 to ActionBars.Count - 1 do
    for X := 0 to ActionBars[I].Items.Count - 1 do
      if Assigned(ActionBars[I].Items[X].Control) then
        ActionBars[I].Items[X].Control.CalcBounds;
end;

function PrioritySort(List: TStringList; Index1, Index2: Integer): Integer;
begin
  Result := AnsiCompareText(List.Names[Index1], List.Names[Index2]);
end;

procedure TCustomActionManager.SetPrioritySchedule(const Value: TStringList);
var
  I: Integer;
begin
  if Length(Trim(FPrioritySchedule.Text)) = 0 then
  begin
    if MessageDlg(SRestoreDefaultSchedule, mtConfirmation, mbOKCancel, 0) = mrOk then
      FPrioritySchedule.Text := cDefaultSchedule
    else
      FPrioritySchedule.Clear;
  end
  else
  begin
    StrToInt(Value.Names[0]);
    StrToInt(Value.Values[Value.Names[0]]);
    FPrioritySchedule.Assign(Value);
  end;
  FPrioritySchedule.CustomSort(PrioritySort);
  for I := 0 to FPrioritySchedule.Count - 1 do
    with FPrioritySchedule do