diff --git a/lcl/actnlist.pas b/lcl/actnlist.pas index 3e8ec34df9..b0c238d585 100644 --- a/lcl/actnlist.pas +++ b/lcl/actnlist.pas @@ -40,14 +40,12 @@ type FCategory: string; FActionList: TCustomActionList; function GetIndex: Integer; - function IsCategoryStored: Boolean; procedure SetCategory(const Value: string); procedure SetIndex(Value: Integer); - procedure SetActionList(AActionList: TCustomActionList); + procedure SetActionList(NewActionList: TCustomActionList); protected procedure ReadState(Reader: TReader); override; procedure SetParentComponent(AParent: TComponent); override; - procedure Change; override; public destructor Destroy; override; function Execute: Boolean; override; @@ -58,7 +56,7 @@ type property Index: Integer read GetIndex write SetIndex stored False; published property Category: string - read FCategory write SetCategory stored IsCategoryStored; + read FCategory write SetCategory; end; TContainedActionClass = class of TContainedAction; @@ -71,7 +69,7 @@ type TCustomActionList = class(TLCLComponent) private - FActions: TList; + FActions: TFPList;// list of TContainedAction FImageChangeLink: TChangeLink; FImages: TCustomImageList; FOnChange: TNotifyEvent; @@ -123,7 +121,8 @@ type end; - { TShortCutList } + { TShortCutList + List of shortcut and texts. The TShortCut values are stored in the Objects. } TShortCutList = class(TStringList) private @@ -135,29 +134,30 @@ type end; - { TControlAction } + { TCustomAction + FClients is a list of TActionLink } THintEvent = procedure (var HintStr: string; var CanShow: Boolean) of object; TCustomAction = class(TContainedAction) private - FDisableIfNoHandler: Boolean; + FAutoCheck: Boolean; FCaption: TTranslateString; - FChecking: Boolean; FChecked: Boolean; + FChecking: Boolean; + FDisableIfNoHandler: Boolean; FEnabled: Boolean; FGroupIndex: Integer; - FHelpType: THelpType; FHelpContext: THelpContext; FHelpKeyword: string; + FHelpType: THelpType; FHint: TTranslateString; FImageIndex: TImageIndex; + FOnHint: THintEvent; + FSavedEnabledState: Boolean; + FSecondaryShortCuts: TShortCutList;// nil as default FShortCut: TShortCut; FVisible: Boolean; - FOnHint: THintEvent; - FSecondaryShortCuts: TShortCutList; - FSavedEnabledState: Boolean; - FAutoCheck: Boolean; procedure SetAutoCheck(Value: Boolean); procedure SetCaption(const Value: TTranslateString); procedure SetChecked(Value: Boolean); @@ -203,11 +203,11 @@ type property Hint: TTranslateString read FHint write SetHint; property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1; - property ShortCut: TShortCut read FShortCut write SetShortCut default 0; + property OnHint: THintEvent read FOnHint write FOnHint; property SecondaryShortCuts: TShortCutList read GetSecondaryShortCuts write SetSecondaryShortCuts stored IsSecondaryShortCutsStored; + property ShortCut: TShortCut read FShortCut write SetShortCut default 0; property Visible: Boolean read FVisible write SetVisible default True; - property OnHint: THintEvent read FOnHint write FOnHint; end; @@ -269,7 +269,7 @@ type TActionLinkClass = class of TActionLink; - +type TEnumActionProc = procedure (const Category: string; ActionClass: TBasicActionClass; Info: Pointer) of object; @@ -292,7 +292,7 @@ const ActionClass: TBasicActionClass): TBasicAction = nil; var - ApplicationActionComponent: TComponent; + ApplicationActionComponent: TComponent = nil; procedure Register; diff --git a/lcl/include/containedaction.inc b/lcl/include/containedaction.inc index 9c18367628..294773b896 100644 --- a/lcl/include/containedaction.inc +++ b/lcl/include/containedaction.inc @@ -27,26 +27,24 @@ end; function TContainedAction.GetIndex: Integer; begin if ActionList <> nil then - Result := ActionList.FActions.IndexOf(Self) else + Result := ActionList.FActions.IndexOf(Self) + else Result := -1; end; -function TContainedAction.IsCategoryStored: Boolean; -begin - Result := True;//GetParentComponent <> ActionList; -end; - function TContainedAction.GetParentComponent: TComponent; begin if ActionList <> nil then - Result := ActionList else + Result := ActionList + else Result := inherited GetParentComponent; end; function TContainedAction.HasParent: Boolean; begin if ActionList <> nil then - Result := True else + Result := True + else Result := inherited HasParent; end; @@ -82,12 +80,13 @@ begin end; end; -procedure TContainedAction.SetActionList(AActionList: TCustomActionList); +procedure TContainedAction.SetActionList(NewActionList: TCustomActionList); begin - if AActionList <> ActionList then + if NewActionList <> ActionList then begin if ActionList <> nil then ActionList.RemoveAction(Self); - if AActionList <> nil then AActionList.AddAction(Self); + // FActionList is set by AddAction + if NewActionList <> nil then NewActionList.AddAction(Self); end; end; @@ -97,27 +96,21 @@ begin ActionList := TCustomActionList(AParent); end; -procedure TContainedAction.Change; -begin - inherited Change; -end; - function TContainedAction.Execute: Boolean; begin - Result := (ActionList <> nil) and ActionList.ExecuteAction(Self) + Result := ((ActionList <> nil) and ActionList.ExecuteAction(Self)) or ((ApplicationActionComponent<>nil) and ApplicationActionComponent.ExecuteAction(Self)) - or inherited Execute + or (inherited Execute) or (SendApplicationMessage(CM_ACTIONEXECUTE, 0, PtrInt(Self)) = 1); end; function TContainedAction.Update: Boolean; begin - Result := (ActionList <> nil) - and ActionList.UpdateAction(Self) + Result := ((ActionList <> nil) and ActionList.UpdateAction(Self)) or ((ApplicationActionComponent<>nil) and ApplicationActionComponent.UpdateAction(Self)) - or inherited Update + or (inherited Update) or (SendApplicationMessage(CM_ACTIONUPDATE, 0, PtrInt(Self)) = 1); end; diff --git a/lcl/include/customaction.inc b/lcl/include/customaction.inc index 5e0c3eac6f..9ccc3e70a4 100644 --- a/lcl/include/customaction.inc +++ b/lcl/include/customaction.inc @@ -21,107 +21,92 @@ begin FEnabled := True; FImageIndex := -1; FVisible := True; - FSecondaryShortCuts := nil; + FSecondaryShortCuts := nil; // no list as default FHelpType := htContext; end; destructor TCustomAction.Destroy; begin - FImage.Free; - FMask.Free; + FreeAndNil(FImage); + FreeAndNil(FMask); if Assigned(FSecondaryShortCuts) then FreeAndNil(FSecondaryShortCuts); inherited Destroy; end; procedure TCustomAction.AssignTo(Dest: TPersistent); +var + Target: TCustomAction; begin - if Dest is TCustomAction then - with TCustomAction(Dest) do - begin - AutoCheck := Self.AutoCheck; - Caption := Self.Caption; - Category := Self.Category; - Checked := Self.Checked; - Enabled := Self.Enabled; - GroupIndex := Self.GroupIndex; - HelpContext := Self.HelpContext; - HelpKeyword := Self.HelpKeyword; - HelpType := Self.HelpType; - Hint := Self.Hint; - ImageIndex := Self.ImageIndex; - SecondaryShortCuts := Self.SecondaryShortCuts; - ShortCut := Self.ShortCut; - Tag := Self.Tag; - Visible := Self.Visible; - OnExecute := Self.OnExecute; - OnUpdate := Self.OnUpdate; - OnChange := Self.OnChange; - OnHint := Self.OnHint; - end else inherited AssignTo(Dest); + if Dest=Self then exit; + if Dest is TCustomAction then begin + Target:=TCustomAction(Dest); + Target.AutoCheck := AutoCheck; + Target.Caption := Caption; + Target.Category := Category; + Target.Checked := Checked; + Target.Enabled := Enabled; + Target.GroupIndex := GroupIndex; + Target.HelpContext := HelpContext; + Target.HelpKeyword := HelpKeyword; + Target.HelpType := HelpType; + Target.Hint := Hint; + Target.ImageIndex := ImageIndex; + Target.SecondaryShortCuts := SecondaryShortCuts; + Target.ShortCut := ShortCut; + Target.Tag := Tag; + Target.Visible := Visible; + Target.OnExecute := OnExecute; + Target.OnUpdate := OnUpdate; + Target.OnChange := OnChange; + Target.OnHint := OnHint; + end else + inherited AssignTo(Dest); end; procedure TCustomAction.SetAutoCheck(Value: Boolean); var I: Integer; begin - if Value <> FAutoCheck then - begin - for I := 0 to FClients.Count - 1 do - if TBasicActionLink(FClients[I]) is TActionLink then - TActionLink(FClients[I]).SetAutoCheck(Value); - FAutoCheck := Value; - Change; - end; + if Value = FAutoCheck then exit; + for I := 0 to FClients.Count - 1 do + TActionLink(FClients[I]).SetAutoCheck(Value); + FAutoCheck := Value; + Change; end; procedure TCustomAction.SetCaption(const Value: TTranslateString); var I: Integer; - Link: TActionLink; begin - if Value <> FCaption then - begin - for I := 0 to FClients.Count - 1 do - begin - Link := TObject(FClients.List^[I]) as TActionLink; - if Assigned(Link) then - Link.SetCaption(Value); - end; - FCaption := Value; - Change; - end; + if Value = FCaption then exit; + for I := 0 to FClients.Count - 1 do + TActionLink(FClients[I]).SetCaption(Value); + FCaption := Value; + Change; end; procedure TCustomAction.SetChecked(Value: Boolean); var I: Integer; - Link: TActionLink; Action: TContainedAction; begin - if FChecking then exit; + if FChecking or (Value=FChecked) then exit; FChecking := True; try - if Value <> FChecked then - begin - for I := 0 to FClients.Count - 1 do + for I := 0 to FClients.Count - 1 do + TActionLink(FClients[I]).SetChecked(Value); + FChecked := Value; + if (FGroupIndex > 0) and FChecked then + for I := 0 to ActionList.ActionCount - 1 do begin - Link := TObject(FClients.List^[I]) as TActionLink; - if Assigned(Link) then - Link.SetChecked(Value); + Action := ActionList[I]; + if (Action <> Self) + and (Action is TCustomAction) + and (TCustomAction(Action).FGroupIndex = FGroupIndex) then + TCustomAction(Action).Checked := False; end; - FChecked := Value; - if (FGroupIndex > 0) and FChecked then - for I := 0 to ActionList.ActionCount - 1 do - begin - Action := ActionList.Actions[I]; - if (Action <> Self) and - (TObject(Action) is TCustomAction) and - (TCustomAction(Action).FGroupIndex = FGroupIndex) then - TCustomAction(Action).Checked := False; - end; - Change; - end; + Change; finally FChecking := False; end; @@ -130,175 +115,125 @@ end; procedure TCustomAction.SetEnabled(Value: Boolean); var I: Integer; - Link: TActionLink; begin - if Value <> FEnabled then + if Value = FEnabled then exit; + if ActionList<>nil then begin - if Assigned(ActionList) then - if ActionList.State = asSuspended then - begin - FEnabled := Value; - exit; - end - else - if (ActionList.State = asSuspendedEnabled) then - Value := True; - for I := 0 to FClients.Count - 1 do + if ActionList.State = asSuspended then begin - Link := TObject(FClients.List^[I]) as TActionLink; - if Assigned(Link) then - TActionLink(Link).SetEnabled(Value); + FEnabled := Value; + exit; + end; + if ActionList.State = asSuspendedEnabled then + begin + // enable for Delphi compatibility + Value := True; end; - FEnabled := Value; - Change; end; + for I := 0 to FClients.Count - 1 do + TActionLink(FClients[I]).SetEnabled(Value); + FEnabled := Value; + Change; end; procedure TCustomAction.SetGroupIndex(const Value: Integer); var I: Integer; - Link: TActionLink; begin - if Value <> FGroupIndex then - begin - FGroupIndex := Value; - for I := 0 to FClients.Count - 1 do - begin - Link := TObject(FClients.List^[I]) as TActionLink; - if Assigned(Link) then - Link.SetGroupIndex(Value); - end; - Change; - end; + if Value = FGroupIndex then exit; + FGroupIndex := Value; + for I := 0 to FClients.Count - 1 do + TActionLink(FClients[I]).SetGroupIndex(Value); + Change; end; procedure TCustomAction.SetHelpType(Value: THelpType); var I: Integer; begin - if Value <> FHelpType then - begin - for I := 0 to FClients.Count -1 do - if TBasicActionLink(FCLients[I]) is TActionLink then - TActionLink(FClients[I]).SetHelpType(Value); - FHelpType := Value; - Change; - end; + if Value = FHelpType then exit; + for I := 0 to FClients.Count -1 do + TActionLink(FClients[I]).SetHelpType(Value); + FHelpType := Value; + Change; end; procedure TCustomAction.SetHelpKeyword(const Value: string); var I: Integer; begin - if Value <> FHelpKeyword then - begin - for I := 0 to FClients.Count -1 do - if TBasicActionLink(FCLients[I]) is TActionLink then - TActionLink(FClients[I]).SetHelpKeyword(Value); - FHelpKeyword := Value; - Change; - end; + if Value = FHelpKeyword then exit; + for I := 0 to FClients.Count -1 do + TActionLink(FClients[I]).SetHelpKeyword(Value); + FHelpKeyword := Value; + Change; end; procedure TCustomAction.SetHelpContext(Value: THelpContext); var I: Integer; - Link: TActionLink; begin - if Value <> FHelpContext then - begin - for I := 0 to FClients.Count - 1 do - begin - Link := TObject(FClients.List^[I]) as TActionLink; - if Assigned(Link) then - Link.SetHelpContext(Value); - end; - FHelpContext := Value; - Change; - end; + if Value = FHelpContext then exit; + for I := 0 to FClients.Count - 1 do + TActionLink(FClients[I]).SetHelpContext(Value); + FHelpContext := Value; + Change; end; procedure TCustomAction.SetHint(const Value: TTranslateString); var I: Integer; - Link: TActionLink; begin - if Value <> FHint then - begin - for I := 0 to FClients.Count - 1 do - begin - Link := TObject(FClients.List^[I]) as TActionLink; - if Assigned(Link) then - Link.SetHint(Value); - end; - FHint := Value; - Change; - end; + if Value = FHint then exit; + for I := 0 to FClients.Count - 1 do + TActionLink(FClients[I]).SetHint(Value); + FHint := Value; + Change; end; procedure TCustomAction.SetImageIndex(Value: TImageIndex); var I: Integer; - Link: TActionLink; begin - if Value <> FImageIndex then - begin - for I := 0 to FClients.Count - 1 do - begin - Link := TObject(FClients.List^[I]) as TActionLink; - if Assigned(Link) then - Link.SetImageIndex(Value); - end; - FImageIndex := Value; - Change; - end; + if Value = FImageIndex then exit; + for I := 0 to FClients.Count - 1 do + TActionLink(FClients[I]).SetImageIndex(Value); + FImageIndex := Value; + Change; end; procedure TCustomAction.SetShortCut(Value: TShortCut); var I: Integer; - Link: TActionLink; begin - if Value <> FShortCut then - begin - for I := 0 to FClients.Count - 1 do - begin - Link := TObject(FClients.List^[I]) as TActionLink; - if Assigned(Link) then - Link.SetShortCut(Value); - end; - FShortCut := Value; - Change; - end; + if Value = FShortCut then exit; + for I := 0 to FClients.Count - 1 do + TActionLink(FClients[I]).SetShortCut(Value); + FShortCut := Value; + Change; end; procedure TCustomAction.SetVisible(Value: Boolean); var I: Integer; - Link: TActionLink; begin - if Value <> FVisible then - begin - for I := 0 to FClients.Count - 1 do - begin - Link := TObject(FClients.List^[I]) as TActionLink; - if Assigned(Link) then - TActionLink(FClients[I]).SetVisible(Value); - end; - FVisible := Value; - Change; - end; + if Value = FVisible then exit; + for I := 0 to FClients.Count - 1 do + TActionLink(FClients[I]).SetVisible(Value); + FVisible := Value; + Change; end; procedure TCustomAction.SetName(const Value: TComponentName); var - ChangeText: Boolean; + AutoChangeCaption: Boolean; begin - ChangeText := (Name = Caption) and ((Owner = nil) or - not (csLoading in Owner.ComponentState)); + AutoChangeCaption := (Name = Caption) + and ((Owner = nil) + or not (csLoading in Owner.ComponentState)); inherited SetName(Value); - { Don't update caption to name if we've got clients connected. } - if ChangeText and (FClients.Count = 0) then Caption := Value; + if AutoChangeCaption and (FClients.Count = 0) then + Caption := Value; end; function TCustomAction.DoHint(var HintStr: string): Boolean; @@ -326,8 +261,10 @@ end; procedure TCustomAction.SetSecondaryShortCuts(const Value: TShortCutList); begin - if FSecondaryShortCuts = nil then + if FSecondaryShortCuts = nil then begin + if (Value=nil) or (Value.Count=0) then exit; FSecondaryShortCuts := TShortCutList.Create; + end; FSecondaryShortCuts.Assign(Value); end; @@ -341,5 +278,4 @@ begin Result := Execute; end; - // included by actnlist.pas diff --git a/lcl/include/customactionlist.inc b/lcl/include/customactionlist.inc index 7e11fb926c..81c721bb1a 100644 --- a/lcl/include/customactionlist.inc +++ b/lcl/include/customactionlist.inc @@ -20,7 +20,7 @@ constructor TCustomActionList.Create(AOwner: TComponent); begin inherited Create(AOwner); - FActions := TList.Create; + FActions := TFPList.Create; FImageChangeLink := TChangeLink.Create; FImageChangeLink.OnChange := @ImageListChange; FState := asNormal; @@ -28,28 +28,31 @@ end; destructor TCustomActionList.Destroy; begin - FImageChangeLink.Free; + FreeAndNil(FImageChangeLink); while FActions.Count > 0 do TContainedAction(FActions.Last).Free; - FActions.Free; + FreeAndNil(FActions); inherited Destroy; end; procedure TCustomActionList.GetChildren(Proc: TGetChildProc; Root: TComponent); var I: Integer; - Action: TAction; + Action: TContainedAction; begin for I := 0 to FActions.Count - 1 do begin - Action := TAction(FActions.List^[I]); + Action := TContainedAction(FActions[I]); if Action.Owner = Root then Proc(Action); end; end; procedure TCustomActionList.SetChildOrder(Component: TComponent; Order: Integer); +var + i: LongInt; begin - if FActions.IndexOf(Component) >= 0 then - (Component as TContainedAction).Index := Order; + i:=FActions.IndexOf(Component); + if (i>=0) and (i<>Order) then + TContainedAction(Component).Index:=Order; end; function TCustomActionList.GetAction(Index: Integer): TContainedAction; @@ -64,17 +67,23 @@ end; procedure TCustomActionList.SetAction(Index: Integer; Value: TContainedAction); begin + if TObject(FActions[Index])=Value then exit; TContainedAction(FActions[Index]).Assign(Value); end; procedure TCustomActionList.SetImages(Value: TCustomImageList); begin - if Images <> nil then Images.UnRegisterChanges(FImageChangeLink); - FImages := Value; - if Images <> nil then + if FImages=Value then exit; + if FImages <> nil then begin - Images.RegisterChanges(FImageChangeLink); - Images.FreeNotification(Self); + FImages.UnRegisterChanges(FImageChangeLink); + FImages.RemoveFreeNotification(Self); + end; + FImages := Value; + if FImages <> nil then + begin + FImages.RegisterChanges(FImageChangeLink); + FImages.FreeNotification(Self); end; end; @@ -88,14 +97,16 @@ procedure TCustomActionList.Notification(AComponent: TComponent; begin inherited Notification(AComponent, Operation); if Operation = opRemove then - if AComponent = Images then - Images := nil - else if (AComponent is TContainedAction) then + if AComponent = Images then begin + Images := nil; // call SetImages, because it can be overridden + end else if (AComponent is TContainedAction) then RemoveAction(TContainedAction(AComponent)); end; procedure TCustomActionList.AddAction(Action: TContainedAction); begin + if Action.FActionList = Self then + raise Exception.Create('TCustomActionList.AddAction already added'); FActions.Add(Action); Action.FActionList := Self; Action.FreeNotification(Self); @@ -103,17 +114,19 @@ end; procedure TCustomActionList.RemoveAction(Action: TContainedAction); begin - if FActions.Remove(Action) >= 0 then - Action.FActionList := nil; + if Action.FActionList<>Self then exit; + Action.FActionList:=nil; + FActions.Remove(Action); + Action.RemoveFreeNotification(Self); end; procedure TCustomActionList.Change; var - I: Integer; + i: Integer; begin if Assigned(FOnChange) then FOnChange(Self); - for I := 0 to FActions.Count - 1 do - TContainedAction(FActions.List^[I]).Change; + for i := 0 to FActions.Count - 1 do + TContainedAction(FActions[i]).Change; OwnerFormDesignerModified(Self); end; @@ -129,14 +142,15 @@ begin if ShortCut <> scNone then for I := 0 to FActions.Count - 1 do begin - Action := TCustomAction(FActions.Items[I]); - if (TObject(Action) is TCustomAction) then - if (Action.ShortCut = ShortCut) or (Assigned(Action.FSecondaryShortCuts) and - (Action.SecondaryShortCuts.IndexOfShortCut(ShortCut) <> -1)) then - begin - Result := Action.HandleShortCut; - Exit; - end; + Action := TCustomAction(FActions[I]); + if (Action is TCustomAction) + and ((Action.ShortCut = ShortCut) + or ((Assigned(Action.FSecondaryShortCuts) and + (Action.SecondaryShortCuts.IndexOfShortCut(ShortCut) >= 0)))) + then begin + Result := Action.HandleShortCut; + Exit; + end; end; Result := False; end; @@ -157,7 +171,7 @@ function TCustomActionList.IndexOfName(const ActionName: string): integer; begin Result:=FActions.Count-1; while (Result>=0) - and (AnsiCompareText(TAction(FActions[Result]).Name,ActionName)<>0) do + and (SysUtils.CompareText(TAction(FActions[Result]).Name,ActionName)<>0) do dec(Result); end; @@ -178,30 +192,27 @@ var I: Integer; Action: TCustomAction; begin - if FState <> Value then + if FState = Value then exit; + FState := Value; + if State = asSuspended then exit; + for I := 0 to FActions.Count - 1 do begin - FState := Value; - if State = asSuspended then exit; - for I := 0 to FActions.Count - 1 do + Action := TAction(FActions[I]); + if Action is TCustomAction then begin - Action := TAction(FActions.List^[I]); case Value of - asNormal: - begin - if Action is TCustomAction then - if State = asSuspendedEnabled then - with Action as TCustomAction do - Enabled := SavedEnabledState; - Action.Update; - end; - asSuspendedEnabled: - if Action is TCustomAction then - if Value = asSuspendedEnabled then - with Action as TCustomAction do - begin - SavedEnabledState := Enabled; - Enabled := True; - end; + asNormal: + begin + if State = asSuspendedEnabled then + Action.Enabled := Action.SavedEnabledState; + Action.Update; + end; + asSuspendedEnabled: + if Value = asSuspendedEnabled then + begin + Action.SavedEnabledState := Action.Enabled; + Action.Enabled := True; + end; end; end; end;