actnman.pas

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

      Objects[I] := Pointer(StrToInt(Values[Names[I]]));
end;

function TCustomActionManager.GetUsage(AnItem: TActionClientItem): Boolean;
var
  NumSessions: Integer;
  I: Integer;
begin
  // Returns True if AnItem is recently used
  Result := (AnItem.UsageCount = -1) or (PrioritySchedule.Count = 0);
  if Result then exit;
  NumSessions := ActionBars.SessionCount - AnItem.LastSession;
  I := 0;
  while (I < PrioritySchedule.Count) and
     (AnItem.UsageCount > StrToInt(PrioritySchedule.Names[I])) do
    Inc(I);
  if I = PrioritySchedule.Count then
    Dec(I);
  Result := NumSessions < Integer(PrioritySchedule.Objects[I]);
end;

function TCustomActionManager.IsPriorityScheduleStored: Boolean;
begin
  Result := AnsiCompareText(cDefaultSchedule, FPrioritySchedule.Text) <> 0;
end;

procedure TCustomActionManager.ResetActionBar(Index: Integer);
var
  ABar: TCustomActionBar;
begin
  if Assigned(FDefaultActionBars) then
  begin
    ABar := FActionBars[Index].ActionBar;
    FActionBars[Index].ActionBar := nil;
    FActionBars.Items[Index].Assign(FDefaultActionBars.Items[Index]);
    FActionBars[Index].ActionBar := ABar;
  end;
end;

procedure TCustomActionManager.ResetClientUsageData(
  AClient: TActionClient);
begin
  if AClient is TActionClientItem then
    with AClient as TActionClientItem do
    begin
      UsageCount := 0;
      LastSession := ActionBars.SessionCount;
    end;
end;

procedure TCustomActionManager.ResetUsageData;
begin
  ActionBars.IterateClients(ActionBars, ResetClientUsageData);
end;

procedure TCustomActionManager.SetLinkedActionLists(
  const Value: TActionListCollection);
begin
  if not Assigned(FLinkedActionLists) then
    FLinkedActionLists := TActionListCollection.Create(Self, TActionListItem);
  FLinkedActionLists.Assign(Value);
end;

procedure TCustomActionManager.Change;
begin
  inherited Change;
  if Assigned(ActionBars) then
    ActionBars.IterateClients(ActionBars, nil);
end;

function TCustomActionManager.GetActionClientsClass: TActionClientsClass;
begin
  Result := TActionClients;
  if Assigned(FOnGetClientsClass) then
    FOnGetClientsClass(Self, Result);
  if Result = nil then
    Result := TActionClients;
end;

function TCustomActionManager.GetActionClientItemClass: TActionClientItemClass;
begin
  Result := TActionClientItem;
  if Assigned(FOnGetClientItemClass) then
    FOnGetClientItemClass(Self, Result);
  if Result = nil then
    Result := TActionClientItem;
end;

function TCustomActionManager.GetActionBarsClass: TActionBarsClass;
begin
  Result := TActionBars;
  if Assigned(FOnGetBarsClass) then
    FOnGetBarsClass(Self, Result);
  if Result = nil then
    Result := TActionBars;
end;

function TCustomActionManager.GetActionBarItemClass: TActionBarItemClass;
begin
  Result := TActionBarItem;
  if Assigned(FOnGetBarItemClass) then
    FOnGetBarItemClass(Self, Result);
  if Result = nil then
    Result := TActionBarItem;
end;

function TCustomActionManager.IsLinkedActionListsStored: Boolean;
begin
  Result := Assigned(FLinkedActionLists) and (LinkedActionLists.Count > 0);
end;

function TCustomActionManager.IsActionBarsStored: Boolean;
begin
  Result := ActionBars.Count > 0;
end;

function TCustomActionManager.GetLinkedActionLists: TActionListCollection;
begin
  if not Assigned(FLinkedActionLists) then
    FLinkedActionLists := TActionListCollection.Create(Self, TActionListItem);
  Result := FLinkedActionLists;
end;

procedure TCustomActionManager.ReadStyleProp(Reader: TReader);
var
  StyleName: string;
begin
  StyleName := Reader.ReadString;
  if StyleName <> '' then
  try
    Style := ActionBarStyles.Style[ActionBarStyles.IndexOf(StyleName)];
  except
    if csDesigning in ComponentState then
      if Assigned(Classes.ApplicationHandleException) then
        Classes.ApplicationHandleException(ExceptObject)
      else
        ShowException(ExceptObject, ExceptAddr)
    else
      raise;
  end;
end;

procedure TCustomActionManager.WriteStyleProp(Writer: TWriter);
var
  AStyle: TActionBarStyle;
begin
  if Assigned(Style) then
    AStyle := Style
  else
    AStyle := ActionBarStyles.Style[0];
  Writer.WriteString(AStyle.GetStyleName);
end;

function TCustomActionManager.HasLinkedActionLists: Boolean;
begin
  Result := Assigned(FLinkedActionLists);
end;

procedure TCustomActionManager.AfterConstruction;
begin
  inherited;
  if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
    FStyle := ActionBarStyles.Style[ActionBarStyles.IndexOf(DefaultActnBarStyle)];
end;

procedure TCustomActionManager.SetStyle(const Value: TActionBarStyle);
var
  I: Integer;
begin
  if Style <> Value then
  begin
    FStyle := Value;
    for I := 0 to ActionBars.Count - 1 do
      if Assigned(ActionBars[I].ActionBar) then
      begin
        ActionBars[I].ActionBar.RecreateControls;
        if ActionBars[I].ActionBar.ColorMap = ActionBars[I].ActionBar.FDefaultColorMap then
          ActionBars[I].ActionBar.ColorMap := nil;
        ActionBars[I].ActionBar.Invalidate;
      end;
    if Assigned(FOnStyleChanged) then
      FOnStyleChanged(Self);
    if csDesigning in ComponentState then
      NotifyDesigner(nil);
  end;
end;

{ TActionListItem }

procedure TActionListItem.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
  if Source is TActionListItem then
  begin
    if Assigned(Collection) then Collection.BeginUpdate;
    try
      ActionList := TActionListItem(Source).ActionList;
      Caption := TActionListItem(Source).Caption;
    finally
      if Assigned(Collection) then Collection.EndUpdate;
    end;
  end;
end;

function TActionListItem.GetCaption: string;
begin
  Result := FCaption;
  if (Length(Result) = 0) then
    if Assigned(FActionList) then
      Result := FActionList.Name
    else
      Result := SNoName;
end;

function TActionListItem.GetDisplayName: string;
begin
  if Assigned(FActionList) then
    Result := Caption
  else
    Result := inherited GetDisplayName;
end;

function TActionListItem.Owner: TActionListCollection;
begin
  Result := TActionListCollection(Collection);
end;

procedure TActionListItem.SetActionList(
  const Value: TCustomActionList);
begin
  if Value = Owner.ActionManager then
    raise Exception.Create(SCirularReferencesNotAllowed);
  if (FActionList <> Value) then
  begin
    FActionList := Value;
    FActionList.FreeNotification(Owner.ActionManager);
  end;
end;

{ TActionListCollection }

function TActionListCollection.GetActionManager: TCustomActionManager;
begin
  Result := TCustomActionManager(Owner);
end;

function TActionListCollection.GetListItem(
  Index: Integer): TActionListItem;
begin
  Result := TActionListItem(Items[Index]);
end;

procedure TActionListCollection.SetListItem(Index: Integer;
  const Value: TActionListItem);
begin
  TActionListItem(ListItems[Index]).Assign(Value);
end;

{ TActionClientsCollection }

procedure TActionClientsCollection.SetActionClient(const Index: Integer;
  const Value: TActionClient);
begin
  inherited SetItem(Index, Value);
end;

function TActionClientsCollection.GetActionClient(
  const Index: Integer): TActionClient;
begin
  Result := TActionClient(Items[Index]);
end;

function TActionClientsCollection.GetActionManager: TCustomActionManager;
begin
  Result := Owner as TActionManager;
end;

function TActionClientsCollection.InternalRethinkHotkeys(
  ForceRethink: Boolean): Boolean;
var
  Did, Doing, ToDo, Best: TStringList;
  I, Iteration, Column, At, BestCount: Integer;
  Char, Caption, OrigAvailable, Available, BestAvailable: string;

  function IfHotkeyAvailable(const AHotkey: string): Boolean;
  var
    At: Integer;
  begin
    At := AnsiPos(AHotkey, Available);
    Result := At <> 0;
    if Result then
      System.Delete(Available, At, 1);
  end;

  procedure CopyToBest;
  var
    I: Integer;
  begin
    Best.Assign(Did);
    BestCount := Did.Count;
    for I := 0 to Doing.Count - 1 do
      Best.AddObject(TActionClient(Doing.Objects[I]).FCaption, Doing.Objects[I]);
    BestAvailable := Available;
  end;

  procedure InsertHotkeyFarEastFormat(var ACaption: string; const AHotKey: string; AColumn: Integer);
  var
    I: Integer;
    vMBCSFlag: Boolean;
  begin
    vMBCSFlag := False;
    for I := 1 to Length(ACaption) do
      if ACaption[I] in LeadBytes then
      begin
        vMBCSFlag := True;
        System.Break;
      end;
    if vMBCSFlag then
    begin
      if Copy(ACaption, (Length(ACaption) - Length(cDialogSuffix)) + 1, Length(cDialogSuffix)) = cDialogSuffix then
        ACaption := Copy(ACaption, 1, Length(ACaption) - Length(cDialogSuffix)) +
          '(' + cHotkeyPrefix + AHotKey + ')' + cDialogSuffix
      else
        ACaption := ACaption + '(' + cHotkeyPrefix + AHotKey + ')';
    end
    else if AColumn <> 0 then
      System.Insert(cHotkeyPrefix, ACaption, AColumn);
  end;

begin
  Result := False;
  if not AutoHotKeys then exit;
  if ForceRethink then
  begin
    Available := ValidMenuHotkeys;
    Did := TStringList.Create;
    Doing := TStringList.Create;
    ToDo := TStringList.Create;
    Best := TStringList.Create;
    BestCount := 0;
    try
      for I := 0 to Count - 1 do
        if ActionClients[I].Visible and
           (ActionClients[I].FCaption <> cLineCaption) and
           (ActionClients[I].FCaption <> '') then
        begin
          Char := Uppercase(GetHotkey(ActionClients[I].FCaption));
          if Char = '' then
            ToDo.InsertObject(0, ActionClients[I].FCaption, Items[I])
          else if (AnsiPos(Char, ValidMenuHotkeys) <> 0) and
                  not IfHotkeyAvailable(Char) then
          begin
            ActionClients[I].FCaption := StripHotkey(ActionClients[I].FCaption);
            ToDo.InsertObject(0, ActionClients[I].