LCL: clean up

git-svn-id: trunk@14205 -

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;

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)
+  Result := ((ActionList <> nil) and ActionList.UpdateAction(Self))
-    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;
 

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;
+  FreeAndNil(FImage);
-  FMask.Free;
+  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
+  if Dest=Self then exit;
-    with TCustomAction(Dest) do
+  if Dest is TCustomAction then begin
-    begin
+    Target:=TCustomAction(Dest);
-      AutoCheck := Self.AutoCheck;
+    Target.AutoCheck := AutoCheck;
-      Caption := Self.Caption;
+    Target.Caption := Caption;
-      Category := Self.Category;
+    Target.Category := Category;
-      Checked := Self.Checked;
+    Target.Checked := Checked;
-      Enabled := Self.Enabled;
+    Target.Enabled := Enabled;
-      GroupIndex := Self.GroupIndex;
+    Target.GroupIndex := GroupIndex;
-      HelpContext := Self.HelpContext;
+    Target.HelpContext := HelpContext;
-      HelpKeyword := Self.HelpKeyword;
+    Target.HelpKeyword := HelpKeyword;
-      HelpType := Self.HelpType;
+    Target.HelpType := HelpType;
-      Hint := Self.Hint;
+    Target.Hint := Hint;
-      ImageIndex := Self.ImageIndex;
+    Target.ImageIndex := ImageIndex;
-      SecondaryShortCuts := Self.SecondaryShortCuts;
+    Target.SecondaryShortCuts := SecondaryShortCuts;
-      ShortCut := Self.ShortCut;
+    Target.ShortCut := ShortCut;
-      Tag := Self.Tag;
+    Target.Tag := Tag;
-      Visible := Self.Visible;
+    Target.Visible := Visible;
-      OnExecute := Self.OnExecute;
+    Target.OnExecute := OnExecute;
-      OnUpdate := Self.OnUpdate;
+    Target.OnUpdate := OnUpdate;
-      OnChange := Self.OnChange;
+    Target.OnChange := OnChange;
-      OnHint := Self.OnHint;
+    Target.OnHint := OnHint;
-    end else inherited AssignTo(Dest);
+  end else
+    inherited AssignTo(Dest);
 end;
 
 procedure TCustomAction.SetAutoCheck(Value: Boolean);
 var
   I: Integer;
 begin
-  if Value <> FAutoCheck then
+  if Value = FAutoCheck then exit;
-  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;
 end;
 
 procedure TCustomAction.SetCaption(const Value: TTranslateString);
 var
   I: Integer;
-  Link: TActionLink;
 begin
-  if Value <> FCaption then
+  if Value = FCaption then exit;
-  begin
   for I := 0 to FClients.Count - 1 do
-    begin
+    TActionLink(FClients[I]).SetCaption(Value);
-      Link := TObject(FClients.List^[I]) as TActionLink;
-      if Assigned(Link) then
-        Link.SetCaption(Value);
-    end;
   FCaption := Value;
   Change;
-  end;
 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
-      begin
+      TActionLink(FClients[I]).SetChecked(Value);
-        Link := TObject(FClients.List^[I]) as TActionLink;
-        if Assigned(Link) then
-          Link.SetChecked(Value);
-      end;
     FChecked := Value;
     if (FGroupIndex > 0) and FChecked then
       for I := 0 to ActionList.ActionCount - 1 do
       begin
-          Action := ActionList.Actions[I];
+        Action := ActionList[I];
-          if (Action <> Self) and
+        if (Action <> Self)
-             (TObject(Action) is TCustomAction) and
+        and (Action is TCustomAction)
-             (TCustomAction(Action).FGroupIndex = FGroupIndex) then
+        and (TCustomAction(Action).FGroupIndex = FGroupIndex) then
           TCustomAction(Action).Checked := False;
       end;
     Change;
-    end;
   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
-    begin
-      Link := TObject(FClients.List^[I]) as TActionLink;
-      if Assigned(Link) then
-        TActionLink(Link).SetEnabled(Value);
     end;
+    if ActionList.State = asSuspendedEnabled then
+    begin
+      // enable for Delphi compatibility
+      Value := True;
+    end;
+  end;
+  for I := 0 to FClients.Count - 1 do
+    TActionLink(FClients[I]).SetEnabled(Value);
   FEnabled := Value;
   Change;
-  end;
 end;
 
 procedure TCustomAction.SetGroupIndex(const Value: Integer);
 var
   I: Integer;
-  Link: TActionLink;
 begin
-  if Value <> FGroupIndex then
+  if Value = FGroupIndex then exit;
-  begin
   FGroupIndex := Value;
   for I := 0 to FClients.Count - 1 do
-    begin
+    TActionLink(FClients[I]).SetGroupIndex(Value);
-      Link := TObject(FClients.List^[I]) as TActionLink;
-      if Assigned(Link) then
-        Link.SetGroupIndex(Value);
-    end;
   Change;
-  end;
 end;
 
 procedure TCustomAction.SetHelpType(Value: THelpType);
 var
   I: Integer;
 begin
-  if Value <> FHelpType then
+  if Value = FHelpType then exit;
-  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;
 end;
 
 procedure TCustomAction.SetHelpKeyword(const Value: string);
 var
   I: Integer;
 begin
-  if Value <> FHelpKeyword then
+  if Value = FHelpKeyword then exit;
-  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;
 end;
 
 procedure TCustomAction.SetHelpContext(Value: THelpContext);
 var
   I: Integer;
-  Link: TActionLink;
 begin
-  if Value <> FHelpContext then
+  if Value = FHelpContext then exit;
-  begin
   for I := 0 to FClients.Count - 1 do
-    begin
+    TActionLink(FClients[I]).SetHelpContext(Value);
-      Link := TObject(FClients.List^[I]) as TActionLink;
-      if Assigned(Link) then
-        Link.SetHelpContext(Value);
-    end;
   FHelpContext := Value;
   Change;
-  end;
 end;
 
 procedure TCustomAction.SetHint(const Value: TTranslateString);
 var
   I: Integer;
-  Link: TActionLink;
 begin
-  if Value <> FHint then
+  if Value = FHint then exit;
-  begin
   for I := 0 to FClients.Count - 1 do
-    begin
+    TActionLink(FClients[I]).SetHint(Value);
-      Link := TObject(FClients.List^[I]) as TActionLink;
-      if Assigned(Link) then
-        Link.SetHint(Value);
-    end;
   FHint := Value;
   Change;
-  end;
 end;
 
 procedure TCustomAction.SetImageIndex(Value: TImageIndex);
 var
   I: Integer;
-  Link: TActionLink;
 begin
-  if Value <> FImageIndex then
+  if Value = FImageIndex then exit;
-  begin
   for I := 0 to FClients.Count - 1 do
-    begin
+    TActionLink(FClients[I]).SetImageIndex(Value);
-      Link := TObject(FClients.List^[I]) as TActionLink;
-      if Assigned(Link) then
-        Link.SetImageIndex(Value);
-    end;
   FImageIndex := Value;
   Change;
-  end;
 end;
 
 procedure TCustomAction.SetShortCut(Value: TShortCut);
 var
   I: Integer;
-  Link: TActionLink;
 begin
-  if Value <> FShortCut then
+  if Value = FShortCut then exit;
-  begin
   for I := 0 to FClients.Count - 1 do
-    begin
+    TActionLink(FClients[I]).SetShortCut(Value);
-      Link := TObject(FClients.List^[I]) as TActionLink;
-      if Assigned(Link) then
-        Link.SetShortCut(Value);
-    end;
   FShortCut := Value;
   Change;
-  end;
 end;
 
 procedure TCustomAction.SetVisible(Value: Boolean);
 var
   I: Integer;
-  Link: TActionLink;
 begin
-  if Value <> FVisible then
+  if Value = FVisible then exit;
-  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;
 end;
 
 procedure TCustomAction.SetName(const Value: TComponentName);
 var
-  ChangeText: Boolean;
+  AutoChangeCaption: Boolean;
 begin
-  ChangeText := (Name = Caption) and ((Owner = nil) or
+  AutoChangeCaption := (Name = Caption)
-    not (csLoading in Owner.ComponentState));
+    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 AutoChangeCaption and (FClients.Count = 0) then
-  if ChangeText and (FClients.Count = 0) then Caption := Value;
+    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

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
+  i:=FActions.IndexOf(Component);
-    (Component as TContainedAction).Index := Order;
+  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);
+  if FImages=Value then exit;
-  FImages := Value;
+  if FImages <> nil then
-  if Images <> nil then
   begin
-    Images.RegisterChanges(FImageChangeLink);
+    FImages.UnRegisterChanges(FImageChangeLink);
-    Images.FreeNotification(Self);
+    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
+    if AComponent = Images then begin
-      Images := nil
+      Images := nil; // call SetImages, because it can be overridden
-    else if (AComponent is TContainedAction) then
+    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
+  if Action.FActionList<>Self then exit;
-    Action.FActionList := nil;
+  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
+  for i := 0 to FActions.Count - 1 do
-    TContainedAction(FActions.List^[I]).Change;
+    TContainedAction(FActions[i]).Change;
   OwnerFormDesignerModified(Self);
 end;
 
@@ -129,11 +142,12 @@ begin
   if ShortCut <> scNone then
     for I := 0 to FActions.Count - 1 do
     begin
-      Action := TCustomAction(FActions.Items[I]);
+      Action := TCustomAction(FActions[I]);
-      if (TObject(Action) is TCustomAction) then
+      if (Action is TCustomAction)
-        if (Action.ShortCut = ShortCut) or (Assigned(Action.FSecondaryShortCuts) and
+      and ((Action.ShortCut = ShortCut)
-           (Action.SecondaryShortCuts.IndexOfShortCut(ShortCut) <> -1)) then
+           or ((Assigned(Action.FSecondaryShortCuts) and
-        begin
+               (Action.SecondaryShortCuts.IndexOfShortCut(ShortCut) >= 0))))
+      then begin
         Result := Action.HandleShortCut;
         Exit;
       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,29 +192,26 @@ var
   I: Integer;
   Action: TCustomAction;
 begin
-  if FState <> Value then
+  if FState = Value then exit;
-  begin
   FState := Value;
   if State = asSuspended then exit;
   for I := 0 to FActions.Count - 1 do
   begin
-      Action := TAction(FActions.List^[I]);
+    Action := TAction(FActions[I]);
+    if Action is TCustomAction then
+    begin
       case Value of
       asNormal:
         begin
-            if Action is TCustomAction then
           if State = asSuspendedEnabled then
-                 with Action as TCustomAction do
+            Action.Enabled := Action.SavedEnabledState;
-                  Enabled := SavedEnabledState;
           Action.Update;
         end;
       asSuspendedEnabled:
-          if Action is TCustomAction then
         if Value = asSuspendedEnabled then
-              with Action as TCustomAction do
         begin
-                SavedEnabledState := Enabled;
+          Action.SavedEnabledState := Action.Enabled;
-                Enabled := True;
+          Action.Enabled := True;
         end;
       end;
     end;