{%MainUnit ../actnlist.pas} { ***************************************************************************** This file is part of the Lazarus Component Library (LCL) See the file COPYING.modifiedLGPL.txt, included in this distribution, for details about the license. ***************************************************************************** } constructor TCustomAction.Create(AOwner: TComponent); begin inherited Create(AOwner); FEnabled := True; FImageIndex := -1; FVisible := True; FSecondaryShortCuts := nil; // no list as default FHelpType := htContext; end; destructor TCustomAction.Destroy; begin FreeAndNil(FImage); FreeAndNil(FMask); if Assigned(FSecondaryShortCuts) then FreeAndNil(FSecondaryShortCuts); inherited Destroy; end; procedure TCustomAction.AssignTo(Dest: TPersistent); var Target: TCustomAction; begin 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 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; begin 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; Action: TContainedAction; begin if FChecking or (Value=FChecked) then exit; FChecking := True; try 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 Action := ActionList[I]; if (Action <> Self) and (Action is TCustomAction) and (TCustomAction(Action).FGroupIndex = FGroupIndex) then TCustomAction(Action).Checked := False; end; Change; finally FChecking := False; end; end; procedure TCustomAction.SetEnabled(Value: Boolean); var I: Integer; begin if Value = FEnabled then exit; if ActionList<>nil then begin if ActionList.State = asSuspended then begin FEnabled := Value; exit; 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; procedure TCustomAction.SetGroupIndex(const Value: Integer); var I: Integer; begin 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 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 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; begin 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; begin 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; begin 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; begin 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; begin 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 AutoChangeCaption: Boolean; begin AutoChangeCaption := (Name = Caption) and ((Owner = nil) or not (csLoading in Owner.ComponentState)); inherited SetName(Value); if AutoChangeCaption and (FClients.Count = 0) then Caption := Value; end; function TCustomAction.DoHint(var HintStr: string): Boolean; begin Result := True; if Assigned(FOnHint) then FOnHint(HintStr, Result); end; function TCustomAction.Execute: Boolean; begin Result := False; if Assigned(ActionList) and (ActionList.State <> asNormal) then Exit; Update; if FAutoCheck then Checked := not Checked; Result := Enabled and inherited Execute; end; function TCustomAction.GetSecondaryShortCuts: TShortCutList; begin if FSecondaryShortCuts = nil then FSecondaryShortCuts := TShortCutList.Create; Result := FSecondaryShortCuts; end; procedure TCustomAction.SetSecondaryShortCuts(const Value: TShortCutList); begin if FSecondaryShortCuts = nil then begin if (Value=nil) or (Value.Count=0) then exit; FSecondaryShortCuts := TShortCutList.Create; end; FSecondaryShortCuts.Assign(Value); end; function TCustomAction.IsSecondaryShortCutsStored: Boolean; begin Result := Assigned(FSecondaryShortCuts) and (FSecondaryShortCuts.Count > 0); end; function TCustomAction.HandleShortCut: Boolean; begin Result := Execute; end; // included by actnlist.pas