LCL: clean up

git-svn-id: trunk@14205 -
This commit is contained in:
mattias 2008-02-20 10:14:38 +00:00
parent d1f4791230
commit 2bf1ed6db8
4 changed files with 207 additions and 267 deletions

View File

@ -40,14 +40,12 @@ type
FCategory: string; FCategory: string;
FActionList: TCustomActionList; FActionList: TCustomActionList;
function GetIndex: Integer; function GetIndex: Integer;
function IsCategoryStored: Boolean;
procedure SetCategory(const Value: string); procedure SetCategory(const Value: string);
procedure SetIndex(Value: Integer); procedure SetIndex(Value: Integer);
procedure SetActionList(AActionList: TCustomActionList); procedure SetActionList(NewActionList: TCustomActionList);
protected protected
procedure ReadState(Reader: TReader); override; procedure ReadState(Reader: TReader); override;
procedure SetParentComponent(AParent: TComponent); override; procedure SetParentComponent(AParent: TComponent); override;
procedure Change; override;
public public
destructor Destroy; override; destructor Destroy; override;
function Execute: Boolean; override; function Execute: Boolean; override;
@ -58,7 +56,7 @@ type
property Index: Integer read GetIndex write SetIndex stored False; property Index: Integer read GetIndex write SetIndex stored False;
published published
property Category: string property Category: string
read FCategory write SetCategory stored IsCategoryStored; read FCategory write SetCategory;
end; end;
TContainedActionClass = class of TContainedAction; TContainedActionClass = class of TContainedAction;
@ -71,7 +69,7 @@ type
TCustomActionList = class(TLCLComponent) TCustomActionList = class(TLCLComponent)
private private
FActions: TList; FActions: TFPList;// list of TContainedAction
FImageChangeLink: TChangeLink; FImageChangeLink: TChangeLink;
FImages: TCustomImageList; FImages: TCustomImageList;
FOnChange: TNotifyEvent; FOnChange: TNotifyEvent;
@ -123,7 +121,8 @@ type
end; end;
{ TShortCutList } { TShortCutList
List of shortcut and texts. The TShortCut values are stored in the Objects. }
TShortCutList = class(TStringList) TShortCutList = class(TStringList)
private private
@ -135,29 +134,30 @@ type
end; end;
{ TControlAction } { TCustomAction
FClients is a list of TActionLink }
THintEvent = procedure (var HintStr: string; var CanShow: Boolean) of object; THintEvent = procedure (var HintStr: string; var CanShow: Boolean) of object;
TCustomAction = class(TContainedAction) TCustomAction = class(TContainedAction)
private private
FDisableIfNoHandler: Boolean; FAutoCheck: Boolean;
FCaption: TTranslateString; FCaption: TTranslateString;
FChecking: Boolean;
FChecked: Boolean; FChecked: Boolean;
FChecking: Boolean;
FDisableIfNoHandler: Boolean;
FEnabled: Boolean; FEnabled: Boolean;
FGroupIndex: Integer; FGroupIndex: Integer;
FHelpType: THelpType;
FHelpContext: THelpContext; FHelpContext: THelpContext;
FHelpKeyword: string; FHelpKeyword: string;
FHelpType: THelpType;
FHint: TTranslateString; FHint: TTranslateString;
FImageIndex: TImageIndex; FImageIndex: TImageIndex;
FOnHint: THintEvent;
FSavedEnabledState: Boolean;
FSecondaryShortCuts: TShortCutList;// nil as default
FShortCut: TShortCut; FShortCut: TShortCut;
FVisible: Boolean; FVisible: Boolean;
FOnHint: THintEvent;
FSecondaryShortCuts: TShortCutList;
FSavedEnabledState: Boolean;
FAutoCheck: Boolean;
procedure SetAutoCheck(Value: Boolean); procedure SetAutoCheck(Value: Boolean);
procedure SetCaption(const Value: TTranslateString); procedure SetCaption(const Value: TTranslateString);
procedure SetChecked(Value: Boolean); procedure SetChecked(Value: Boolean);
@ -203,11 +203,11 @@ type
property Hint: TTranslateString read FHint write SetHint; property Hint: TTranslateString read FHint write SetHint;
property ImageIndex: TImageIndex property ImageIndex: TImageIndex
read FImageIndex write SetImageIndex default -1; 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 property SecondaryShortCuts: TShortCutList read GetSecondaryShortCuts
write SetSecondaryShortCuts stored IsSecondaryShortCutsStored; write SetSecondaryShortCuts stored IsSecondaryShortCutsStored;
property ShortCut: TShortCut read FShortCut write SetShortCut default 0;
property Visible: Boolean read FVisible write SetVisible default True; property Visible: Boolean read FVisible write SetVisible default True;
property OnHint: THintEvent read FOnHint write FOnHint;
end; end;
@ -269,7 +269,7 @@ type
TActionLinkClass = class of TActionLink; TActionLinkClass = class of TActionLink;
type
TEnumActionProc = procedure (const Category: string; TEnumActionProc = procedure (const Category: string;
ActionClass: TBasicActionClass; Info: Pointer) of object; ActionClass: TBasicActionClass; Info: Pointer) of object;
@ -292,7 +292,7 @@ const
ActionClass: TBasicActionClass): TBasicAction = nil; ActionClass: TBasicActionClass): TBasicAction = nil;
var var
ApplicationActionComponent: TComponent; ApplicationActionComponent: TComponent = nil;
procedure Register; procedure Register;

View File

@ -27,26 +27,24 @@ end;
function TContainedAction.GetIndex: Integer; function TContainedAction.GetIndex: Integer;
begin begin
if ActionList <> nil then if ActionList <> nil then
Result := ActionList.FActions.IndexOf(Self) else Result := ActionList.FActions.IndexOf(Self)
else
Result := -1; Result := -1;
end; end;
function TContainedAction.IsCategoryStored: Boolean;
begin
Result := True;//GetParentComponent <> ActionList;
end;
function TContainedAction.GetParentComponent: TComponent; function TContainedAction.GetParentComponent: TComponent;
begin begin
if ActionList <> nil then if ActionList <> nil then
Result := ActionList else Result := ActionList
else
Result := inherited GetParentComponent; Result := inherited GetParentComponent;
end; end;
function TContainedAction.HasParent: Boolean; function TContainedAction.HasParent: Boolean;
begin begin
if ActionList <> nil then if ActionList <> nil then
Result := True else Result := True
else
Result := inherited HasParent; Result := inherited HasParent;
end; end;
@ -82,12 +80,13 @@ begin
end; end;
end; end;
procedure TContainedAction.SetActionList(AActionList: TCustomActionList); procedure TContainedAction.SetActionList(NewActionList: TCustomActionList);
begin begin
if AActionList <> ActionList then if NewActionList <> ActionList then
begin begin
if ActionList <> nil then ActionList.RemoveAction(Self); 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;
end; end;
@ -97,27 +96,21 @@ begin
ActionList := TCustomActionList(AParent); ActionList := TCustomActionList(AParent);
end; end;
procedure TContainedAction.Change;
begin
inherited Change;
end;
function TContainedAction.Execute: Boolean; function TContainedAction.Execute: Boolean;
begin begin
Result := (ActionList <> nil) and ActionList.ExecuteAction(Self) Result := ((ActionList <> nil) and ActionList.ExecuteAction(Self))
or ((ApplicationActionComponent<>nil) or ((ApplicationActionComponent<>nil)
and ApplicationActionComponent.ExecuteAction(Self)) and ApplicationActionComponent.ExecuteAction(Self))
or inherited Execute or (inherited Execute)
or (SendApplicationMessage(CM_ACTIONEXECUTE, 0, PtrInt(Self)) = 1); or (SendApplicationMessage(CM_ACTIONEXECUTE, 0, PtrInt(Self)) = 1);
end; end;
function TContainedAction.Update: Boolean; function TContainedAction.Update: Boolean;
begin begin
Result := (ActionList <> nil) Result := ((ActionList <> nil) and ActionList.UpdateAction(Self))
and ActionList.UpdateAction(Self)
or ((ApplicationActionComponent<>nil) or ((ApplicationActionComponent<>nil)
and ApplicationActionComponent.UpdateAction(Self)) and ApplicationActionComponent.UpdateAction(Self))
or inherited Update or (inherited Update)
or (SendApplicationMessage(CM_ACTIONUPDATE, 0, PtrInt(Self)) = 1); or (SendApplicationMessage(CM_ACTIONUPDATE, 0, PtrInt(Self)) = 1);
end; end;

View File

@ -21,107 +21,92 @@ begin
FEnabled := True; FEnabled := True;
FImageIndex := -1; FImageIndex := -1;
FVisible := True; FVisible := True;
FSecondaryShortCuts := nil; FSecondaryShortCuts := nil; // no list as default
FHelpType := htContext; FHelpType := htContext;
end; end;
destructor TCustomAction.Destroy; destructor TCustomAction.Destroy;
begin begin
FImage.Free; FreeAndNil(FImage);
FMask.Free; FreeAndNil(FMask);
if Assigned(FSecondaryShortCuts) then if Assigned(FSecondaryShortCuts) then
FreeAndNil(FSecondaryShortCuts); FreeAndNil(FSecondaryShortCuts);
inherited Destroy; inherited Destroy;
end; end;
procedure TCustomAction.AssignTo(Dest: TPersistent); procedure TCustomAction.AssignTo(Dest: TPersistent);
var
Target: TCustomAction;
begin 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; end;
procedure TCustomAction.SetAutoCheck(Value: Boolean); procedure TCustomAction.SetAutoCheck(Value: Boolean);
var var
I: Integer; I: Integer;
begin begin
if Value <> FAutoCheck then if Value = FAutoCheck then exit;
begin
for I := 0 to FClients.Count - 1 do for I := 0 to FClients.Count - 1 do
if TBasicActionLink(FClients[I]) is TActionLink then
TActionLink(FClients[I]).SetAutoCheck(Value); TActionLink(FClients[I]).SetAutoCheck(Value);
FAutoCheck := Value; FAutoCheck := Value;
Change; Change;
end;
end; end;
procedure TCustomAction.SetCaption(const Value: TTranslateString); procedure TCustomAction.SetCaption(const Value: TTranslateString);
var var
I: Integer; I: Integer;
Link: TActionLink;
begin begin
if Value <> FCaption then if Value = FCaption then exit;
begin
for I := 0 to FClients.Count - 1 do 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; FCaption := Value;
Change; Change;
end;
end; end;
procedure TCustomAction.SetChecked(Value: Boolean); procedure TCustomAction.SetChecked(Value: Boolean);
var var
I: Integer; I: Integer;
Link: TActionLink;
Action: TContainedAction; Action: TContainedAction;
begin begin
if FChecking then exit; if FChecking or (Value=FChecked) then exit;
FChecking := True; FChecking := True;
try try
if Value <> FChecked then
begin
for I := 0 to FClients.Count - 1 do 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; FChecked := Value;
if (FGroupIndex > 0) and FChecked then if (FGroupIndex > 0) and FChecked then
for I := 0 to ActionList.ActionCount - 1 do for I := 0 to ActionList.ActionCount - 1 do
begin 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; TCustomAction(Action).Checked := False;
end; end;
Change; Change;
end;
finally finally
FChecking := False; FChecking := False;
end; end;
@ -130,175 +115,125 @@ end;
procedure TCustomAction.SetEnabled(Value: Boolean); procedure TCustomAction.SetEnabled(Value: Boolean);
var var
I: Integer; I: Integer;
Link: TActionLink;
begin begin
if Value <> FEnabled then if Value = FEnabled then exit;
if ActionList<>nil then
begin begin
if Assigned(ActionList) then
if ActionList.State = asSuspended then if ActionList.State = asSuspended then
begin begin
FEnabled := Value; FEnabled := Value;
exit; 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; 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; FEnabled := Value;
Change; Change;
end;
end; end;
procedure TCustomAction.SetGroupIndex(const Value: Integer); procedure TCustomAction.SetGroupIndex(const Value: Integer);
var var
I: Integer; I: Integer;
Link: TActionLink;
begin begin
if Value <> FGroupIndex then if Value = FGroupIndex then exit;
begin
FGroupIndex := Value; FGroupIndex := Value;
for I := 0 to FClients.Count - 1 do 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; Change;
end;
end; end;
procedure TCustomAction.SetHelpType(Value: THelpType); procedure TCustomAction.SetHelpType(Value: THelpType);
var var
I: Integer; I: Integer;
begin begin
if Value <> FHelpType then if Value = FHelpType then exit;
begin
for I := 0 to FClients.Count -1 do for I := 0 to FClients.Count -1 do
if TBasicActionLink(FCLients[I]) is TActionLink then
TActionLink(FClients[I]).SetHelpType(Value); TActionLink(FClients[I]).SetHelpType(Value);
FHelpType := Value; FHelpType := Value;
Change; Change;
end;
end; end;
procedure TCustomAction.SetHelpKeyword(const Value: string); procedure TCustomAction.SetHelpKeyword(const Value: string);
var var
I: Integer; I: Integer;
begin begin
if Value <> FHelpKeyword then if Value = FHelpKeyword then exit;
begin
for I := 0 to FClients.Count -1 do for I := 0 to FClients.Count -1 do
if TBasicActionLink(FCLients[I]) is TActionLink then
TActionLink(FClients[I]).SetHelpKeyword(Value); TActionLink(FClients[I]).SetHelpKeyword(Value);
FHelpKeyword := Value; FHelpKeyword := Value;
Change; Change;
end;
end; end;
procedure TCustomAction.SetHelpContext(Value: THelpContext); procedure TCustomAction.SetHelpContext(Value: THelpContext);
var var
I: Integer; I: Integer;
Link: TActionLink;
begin begin
if Value <> FHelpContext then if Value = FHelpContext then exit;
begin
for I := 0 to FClients.Count - 1 do 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; FHelpContext := Value;
Change; Change;
end;
end; end;
procedure TCustomAction.SetHint(const Value: TTranslateString); procedure TCustomAction.SetHint(const Value: TTranslateString);
var var
I: Integer; I: Integer;
Link: TActionLink;
begin begin
if Value <> FHint then if Value = FHint then exit;
begin
for I := 0 to FClients.Count - 1 do 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; FHint := Value;
Change; Change;
end;
end; end;
procedure TCustomAction.SetImageIndex(Value: TImageIndex); procedure TCustomAction.SetImageIndex(Value: TImageIndex);
var var
I: Integer; I: Integer;
Link: TActionLink;
begin begin
if Value <> FImageIndex then if Value = FImageIndex then exit;
begin
for I := 0 to FClients.Count - 1 do 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; FImageIndex := Value;
Change; Change;
end;
end; end;
procedure TCustomAction.SetShortCut(Value: TShortCut); procedure TCustomAction.SetShortCut(Value: TShortCut);
var var
I: Integer; I: Integer;
Link: TActionLink;
begin begin
if Value <> FShortCut then if Value = FShortCut then exit;
begin
for I := 0 to FClients.Count - 1 do 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; FShortCut := Value;
Change; Change;
end;
end; end;
procedure TCustomAction.SetVisible(Value: Boolean); procedure TCustomAction.SetVisible(Value: Boolean);
var var
I: Integer; I: Integer;
Link: TActionLink;
begin begin
if Value <> FVisible then if Value = FVisible then exit;
begin
for I := 0 to FClients.Count - 1 do 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); TActionLink(FClients[I]).SetVisible(Value);
end;
FVisible := Value; FVisible := Value;
Change; Change;
end;
end; end;
procedure TCustomAction.SetName(const Value: TComponentName); procedure TCustomAction.SetName(const Value: TComponentName);
var var
ChangeText: Boolean; AutoChangeCaption: Boolean;
begin 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); 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; end;
function TCustomAction.DoHint(var HintStr: string): Boolean; function TCustomAction.DoHint(var HintStr: string): Boolean;
@ -326,8 +261,10 @@ end;
procedure TCustomAction.SetSecondaryShortCuts(const Value: TShortCutList); procedure TCustomAction.SetSecondaryShortCuts(const Value: TShortCutList);
begin begin
if FSecondaryShortCuts = nil then if FSecondaryShortCuts = nil then begin
if (Value=nil) or (Value.Count=0) then exit;
FSecondaryShortCuts := TShortCutList.Create; FSecondaryShortCuts := TShortCutList.Create;
end;
FSecondaryShortCuts.Assign(Value); FSecondaryShortCuts.Assign(Value);
end; end;
@ -341,5 +278,4 @@ begin
Result := Execute; Result := Execute;
end; end;
// included by actnlist.pas // included by actnlist.pas

View File

@ -20,7 +20,7 @@
constructor TCustomActionList.Create(AOwner: TComponent); constructor TCustomActionList.Create(AOwner: TComponent);
begin begin
inherited Create(AOwner); inherited Create(AOwner);
FActions := TList.Create; FActions := TFPList.Create;
FImageChangeLink := TChangeLink.Create; FImageChangeLink := TChangeLink.Create;
FImageChangeLink.OnChange := @ImageListChange; FImageChangeLink.OnChange := @ImageListChange;
FState := asNormal; FState := asNormal;
@ -28,28 +28,31 @@ end;
destructor TCustomActionList.Destroy; destructor TCustomActionList.Destroy;
begin begin
FImageChangeLink.Free; FreeAndNil(FImageChangeLink);
while FActions.Count > 0 do TContainedAction(FActions.Last).Free; while FActions.Count > 0 do TContainedAction(FActions.Last).Free;
FActions.Free; FreeAndNil(FActions);
inherited Destroy; inherited Destroy;
end; end;
procedure TCustomActionList.GetChildren(Proc: TGetChildProc; Root: TComponent); procedure TCustomActionList.GetChildren(Proc: TGetChildProc; Root: TComponent);
var var
I: Integer; I: Integer;
Action: TAction; Action: TContainedAction;
begin begin
for I := 0 to FActions.Count - 1 do for I := 0 to FActions.Count - 1 do
begin begin
Action := TAction(FActions.List^[I]); Action := TContainedAction(FActions[I]);
if Action.Owner = Root then Proc(Action); if Action.Owner = Root then Proc(Action);
end; end;
end; end;
procedure TCustomActionList.SetChildOrder(Component: TComponent; Order: Integer); procedure TCustomActionList.SetChildOrder(Component: TComponent; Order: Integer);
var
i: LongInt;
begin 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; end;
function TCustomActionList.GetAction(Index: Integer): TContainedAction; function TCustomActionList.GetAction(Index: Integer): TContainedAction;
@ -64,17 +67,23 @@ end;
procedure TCustomActionList.SetAction(Index: Integer; Value: TContainedAction); procedure TCustomActionList.SetAction(Index: Integer; Value: TContainedAction);
begin begin
if TObject(FActions[Index])=Value then exit;
TContainedAction(FActions[Index]).Assign(Value); TContainedAction(FActions[Index]).Assign(Value);
end; end;
procedure TCustomActionList.SetImages(Value: TCustomImageList); procedure TCustomActionList.SetImages(Value: TCustomImageList);
begin begin
if Images <> nil then Images.UnRegisterChanges(FImageChangeLink); if FImages=Value then exit;
FImages := Value; if FImages <> nil then
if Images <> nil then
begin 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;
end; end;
@ -88,14 +97,16 @@ procedure TCustomActionList.Notification(AComponent: TComponent;
begin begin
inherited Notification(AComponent, Operation); inherited Notification(AComponent, Operation);
if Operation = opRemove then 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)); RemoveAction(TContainedAction(AComponent));
end; end;
procedure TCustomActionList.AddAction(Action: TContainedAction); procedure TCustomActionList.AddAction(Action: TContainedAction);
begin begin
if Action.FActionList = Self then
raise Exception.Create('TCustomActionList.AddAction already added');
FActions.Add(Action); FActions.Add(Action);
Action.FActionList := Self; Action.FActionList := Self;
Action.FreeNotification(Self); Action.FreeNotification(Self);
@ -103,17 +114,19 @@ end;
procedure TCustomActionList.RemoveAction(Action: TContainedAction); procedure TCustomActionList.RemoveAction(Action: TContainedAction);
begin 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; end;
procedure TCustomActionList.Change; procedure TCustomActionList.Change;
var var
I: Integer; i: Integer;
begin begin
if Assigned(FOnChange) then FOnChange(Self); 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); OwnerFormDesignerModified(Self);
end; end;
@ -129,11 +142,12 @@ begin
if ShortCut <> scNone then if ShortCut <> scNone then
for I := 0 to FActions.Count - 1 do for I := 0 to FActions.Count - 1 do
begin 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; Result := Action.HandleShortCut;
Exit; Exit;
end; end;
@ -157,7 +171,7 @@ function TCustomActionList.IndexOfName(const ActionName: string): integer;
begin begin
Result:=FActions.Count-1; Result:=FActions.Count-1;
while (Result>=0) while (Result>=0)
and (AnsiCompareText(TAction(FActions[Result]).Name,ActionName)<>0) do and (SysUtils.CompareText(TAction(FActions[Result]).Name,ActionName)<>0) do
dec(Result); dec(Result);
end; end;
@ -178,29 +192,26 @@ var
I: Integer; I: Integer;
Action: TCustomAction; Action: TCustomAction;
begin begin
if FState <> Value then if FState = Value then exit;
begin
FState := Value; FState := Value;
if State = asSuspended then exit; if State = asSuspended then exit;
for I := 0 to FActions.Count - 1 do for I := 0 to FActions.Count - 1 do
begin begin
Action := TAction(FActions.List^[I]); Action := TAction(FActions[I]);
if Action is TCustomAction then
begin
case Value of case Value of
asNormal: asNormal:
begin begin
if Action is TCustomAction then
if State = asSuspendedEnabled then if State = asSuspendedEnabled then
with Action as TCustomAction do Action.Enabled := Action.SavedEnabledState;
Enabled := SavedEnabledState;
Action.Update; Action.Update;
end; end;
asSuspendedEnabled: asSuspendedEnabled:
if Action is TCustomAction then
if Value = asSuspendedEnabled then if Value = asSuspendedEnabled then
with Action as TCustomAction do
begin begin
SavedEnabledState := Enabled; Action.SavedEnabledState := Action.Enabled;
Enabled := True; Action.Enabled := True;
end; end;
end; end;
end; end;