mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-16 09:28:26 +02:00
LCL: clean up
git-svn-id: trunk@14205 -
This commit is contained in:
parent
d1f4791230
commit
2bf1ed6db8
@ -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;
|
||||||
|
@ -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;
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
@ -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;
|
||||||
|
Loading…
Reference in New Issue
Block a user