diff --git a/lcl/include/customcheckbox.inc b/lcl/include/customcheckbox.inc index fa8a89bec8..1f844fcea4 100644 --- a/lcl/include/customcheckbox.inc +++ b/lcl/include/customcheckbox.inc @@ -134,6 +134,9 @@ begin FState := cbUnChecked; if FState <> OldState then begin + if Assigned(Action) + and (Action is TCustomAction) then + TCustomAction(Action).Checked := FState=cbChecked; ApplyChanges; if UseOnChange then begin DoOnChange; @@ -195,6 +198,9 @@ end; { $Log$ + Revision 1.16 2004/02/05 09:45:33 mattias + implemented Actions for TSpeedButton, TMenuItem, TCheckBox + Revision 1.15 2004/01/21 10:19:16 micha enable tabstops for controls; implement tabstops in win32 intf diff --git a/lcl/include/menuactionlink.inc b/lcl/include/menuactionlink.inc index 8fdae0e107..f18b55fe21 100644 --- a/lcl/include/menuactionlink.inc +++ b/lcl/include/menuactionlink.inc @@ -28,20 +28,20 @@ end; function TMenuActionLink.IsCaptionLinked: Boolean; begin - Result := inherited IsCaptionLinked and - (AnsiCompareText(FClient.Caption, (Action as TCustomAction).Caption)=0); + Result := inherited IsCaptionLinked + and (AnsiCompareText(FClient.Caption, (Action as TCustomAction).Caption)=0); end; function TMenuActionLink.IsCheckedLinked: Boolean; begin - Result := inherited IsCheckedLinked and - (FClient.Checked = (Action as TCustomAction).Checked); + Result := inherited IsCheckedLinked + and (FClient.Checked = (Action as TCustomAction).Checked); end; function TMenuActionLink.IsEnabledLinked: Boolean; begin - Result := inherited IsEnabledLinked and - (FClient.Enabled = (Action as TCustomAction).Enabled); + Result := inherited IsEnabledLinked + and (FClient.Enabled = (Action as TCustomAction).Enabled); end; function TMenuActionLink.IsHelpContextLinked: Boolean; @@ -52,38 +52,38 @@ end; function TMenuActionLink.IsHintLinked: Boolean; begin - Result := inherited IsHintLinked and - (FClient.Hint = (Action as TCustomAction).Hint); + Result := inherited IsHintLinked + and (FClient.Hint = (Action as TCustomAction).Hint); end; function TMenuActionLink.IsGroupIndexLinked: Boolean; begin - Result := FClient.RadioItem and inherited IsGroupIndexLinked and - (FClient.GroupIndex = (Action as TCustomAction).GroupIndex); + Result := FClient.RadioItem and inherited IsGroupIndexLinked + and (FClient.GroupIndex = (Action as TCustomAction).GroupIndex); end; function TMenuActionLink.IsImageIndexLinked: Boolean; begin - Result := inherited IsImageIndexLinked and - (FClient.ImageIndex = (Action as TCustomAction).ImageIndex); + Result := inherited IsImageIndexLinked + and (FClient.ImageIndex = (Action as TCustomAction).ImageIndex); end; function TMenuActionLink.IsShortCutLinked: Boolean; begin - Result := inherited IsShortCutLinked and - (FClient.ShortCut = (Action as TCustomAction).ShortCut); + Result := inherited IsShortCutLinked + and (FClient.ShortCut = (Action as TCustomAction).ShortCut); end; function TMenuActionLink.IsVisibleLinked: Boolean; begin - Result := inherited IsVisibleLinked and - (FClient.Visible = (Action as TCustomAction).Visible); + Result := inherited IsVisibleLinked + and (FClient.Visible = (Action as TCustomAction).Visible); end; function TMenuActionLink.IsOnExecuteLinked: Boolean; begin - Result := inherited IsOnExecuteLinked and - (@FClient.OnClick = @Action.OnExecute); + Result := inherited IsOnExecuteLinked + and (@FClient.OnClick = @Action.OnExecute); end; procedure TMenuActionLink.SetAutoCheck(Value: Boolean); diff --git a/lcl/include/menuitem.inc b/lcl/include/menuitem.inc index c28425658a..95fb15e644 100644 --- a/lcl/include/menuitem.inc +++ b/lcl/include/menuitem.inc @@ -51,17 +51,18 @@ begin begin if (not Assigned(ActionLink) and AutoCheck) or (Assigned(ActionLink) and not (ActionLink.IsAutoCheckLinked) and AutoCheck) - then + then begin // Break a little Delphi compatibility // It makes no sense to uncheck a checked RadioItem (besides, GTK cant handle it) - if not RadioItem or not Checked - then Checked := not Checked; + if (not RadioItem) or (not Checked) then + Checked := not Checked; + end; { Call OnClick if assigned and not equal to associated action's OnExecute. If associated action's OnExecute assigned then call it, otherwise, call OnClick. } if Assigned(FOnClick) - {and (Action <> nil) and (FOnClick <> Action.OnExecute)} then + and (Action <> nil) and (FOnClick <> Action.OnExecute) then FOnClick(Self) else if not (csDesigning in ComponentState) and (ActionLink <> nil) then FActionLink.Execute(Self) @@ -94,6 +95,9 @@ begin FVisible := True; FEnabled := True; FCommand := UniqueCommand; + + FImageChangeLink := TChangeLink.Create; + FImageChangeLink.OnChange := @ImageListChange; //writeln('TMenuItem.Create END TheOwner=',TheOwner.Name,':',TheOwner.ClassName); end; @@ -173,8 +177,9 @@ begin dec(i); end; end; - FItems.Free; - FItems:=nil; + FreeAndNil(FItems); + FreeAndNil(FActionLink); + FreeAndNil(FImageChangeLink); if FParent<>nil then FParent.FItems.Remove(Self); if FCommand <> 0 then CommandPool[FCommand] := False; @@ -403,7 +408,7 @@ end; {------------------------------------------------------------------------------ function TMenuItem.IsEnabledStored: boolean; - Checks if 'Checked' needs to be saved to stream + Checks if 'Enabled' needs to be saved to stream ------------------------------------------------------------------------------} function TMenuItem.IsEnabledStored: boolean; begin @@ -415,10 +420,25 @@ begin Result := (ActionLink = nil) or not FActionLink.IsHelpContextLinked; end; +function TMenuItem.IsHintStored: Boolean; +begin + Result := (ActionLink = nil) or not FActionLink.IsHintLinked; +end; + +function TMenuItem.IsImageIndexStored: Boolean; +begin + Result := (ActionLink = nil) or not FActionLink.IsImageIndexLinked; +end; + +function TMenuItem.IsOnClickStored: Boolean; +begin + Result := (ActionLink = nil) or not FActionLink.IsOnExecuteLinked; +end; + {------------------------------------------------------------------------------ function TMenuItem.IsShortCutStored: boolean; - Checks if 'Checked' needs to be saved to stream + Checks if 'ShotCut' needs to be saved to stream ------------------------------------------------------------------------------} function TMenuItem.IsShortCutStored: boolean; begin @@ -428,7 +448,7 @@ end; {------------------------------------------------------------------------------ function TMenuItem.IsVisibleStored: boolean; - Checks if 'Checked' needs to be saved to stream + Checks if 'Visible' needs to be saved to stream ------------------------------------------------------------------------------} function TMenuItem.IsVisibleStored: boolean; begin @@ -521,6 +541,25 @@ begin FHandle:=0; end; +procedure TMenuItem.Loaded; +begin + inherited Loaded; + if Action <> nil then ActionChange(Action, True); +end; + +procedure TMenuItem.Notification(AComponent: TComponent; Operation: TOperation + ); +begin + inherited Notification(AComponent, Operation); + if Operation = opRemove then + if AComponent = Action then + Action := nil + else if AComponent = FSubMenuImages then + SubMenuImages := nil + {else if AComponent = FMerged then + MergeWith(nil)}; +end; + {------------------------------------------------------------------------------ procedure TMenuItem.RecreateHandle; @@ -858,22 +897,22 @@ end; {------------------------------------------------------------------------------ procedure TMenuItem.SetSubMenuImages(const AValue: TCustomImageList); - Enables a menuItem. + Sets the new sub images list ------------------------------------------------------------------------------} procedure TMenuItem.SetSubMenuImages(const AValue: TCustomImageList); begin - if FSubMenuImages=AValue then exit; - // ToDo: - raise Exception.Create('TMenuItem.SetSubMenuImages: not implemented yet'); - {if FSubMenuImages <> nil then + if FSubMenuImages <> nil then FSubMenuImages.UnRegisterChanges(FImageChangeLink); - FSubMenuImages := Value; + FSubMenuImages := AValue; if FSubMenuImages <> nil then begin FSubMenuImages.RegisterChanges(FImageChangeLink); FSubMenuImages.FreeNotification(Self); end; - UpdateItems;} + UpdateImages; + if HandleAllocated and ([csLoading,csDestroying]*ComponentState=[]) then begin + // ToDo: Update images + end; end; {------------------------------------------------------------------------------ @@ -968,6 +1007,18 @@ begin FVisible := AValue; end; +procedure TMenuItem.UpdateImages; +begin + if HandleAllocated and ([csLoading,csDestroying]*ComponentState=[]) then begin + // ToDo: Update images + end; +end; + +procedure TMenuItem.ImageListChange(Sender: TObject); +begin + if Sender = SubMenuImages then UpdateImages; +end; + {------------------------------------------------------------------------------ Method: TMenuItem.ShortcutChanged Params: OldValue: Old shortcut, Value: New shortcut @@ -1044,35 +1095,22 @@ begin if Sender=Action then ActionChange(Sender,False); end; - -{------------------------------------------------------------------------------ - Method: TMenuItem.VerifyGroupIndex - Params: Position: Integer; Value: Byte - Returns: Nothing - - Make sure, that all GroupIndex are in ascending order. - ------------------------------------------------------------------------------} -(* - * MWE: Disabled this feature, it makes not much sense - * suppose a menu with items grouped like : G=1, G=1, ---, G=2, G=2 - * where --- is separator with G=0 - * It will fail to insert --- - -procedure TMenuItem.VerifyGroupIndex(Position: Integer; Value: Byte); -var - i: Integer; +procedure TMenuItem.AssignTo(Dest: TPersistent); begin - for i:=0 to GetCount-1 do - if iValue then - raise EMenuError.Create(rsGroupIndexCannotBeLessThanPrevious) + if Dest is TCustomAction then begin + with TCustomAction(Dest) do + begin + Caption := Self.Caption; + Enabled := Self.Enabled; + HelpContext := Self.HelpContext; + Hint := Self.Hint; + ImageIndex := Self.ImageIndex; + OnExecute := Self.OnClick; + Visible := Self.Visible; end - else - // Ripple change to menu items at Position and after - if (Items[i].GroupIndex<>0) and (Items[i].GroupIndexOldState then + if (Action is TCustomAction) then + TCustomAction(Action).Checked := FState=bsDown; + if InvalidateOnChange and ((FState<>OldState) or (FLastDrawFlags<>GetDrawFlags)) then @@ -244,7 +248,6 @@ function TSpeedButton.GetDrawFlags: integer; begin Result:=DFCS_BUTTONPUSH; if FState in [bsDown, bsExclusive] then inc(Result,DFCS_PUSHED); -// if FMouseInControl then inc(Result,DFCS_CHECKED); if not Enabled then inc(Result,DFCS_INACTIVE); if Flat and (not (csDesigning in ComponentState)) and @@ -527,6 +530,8 @@ begin if not FDown then begin FState := bsDown; + if (Action is TCustomAction) then + TCustomAction(Action).Checked := False; Invalidate; end; FDragging := True; @@ -768,6 +773,9 @@ end; { ============================================================================= $Log$ + Revision 1.46 2004/02/05 09:45:33 mattias + implemented Actions for TSpeedButton, TMenuItem, TCheckBox + Revision 1.45 2004/02/02 18:01:31 mattias added TSpeedButton.Action and TBitBtn.Action diff --git a/lcl/menus.pp b/lcl/menus.pp index 72157682cc..afb49fb8a2 100644 --- a/lcl/menus.pp +++ b/lcl/menus.pp @@ -106,6 +106,7 @@ type FHandle: HMenu; FHelpContext: THelpContext; FHint: String; + FImageChangeLink: TChangeLink; FImageIndex : Integer; FItems: TList; // list of TMenuItem FMenu: TMenu; @@ -126,6 +127,9 @@ type function IsCheckedStored: boolean; function IsEnabledStored: boolean; function IsHelpContextStored: boolean; + function IsHintStored: Boolean; + function IsImageIndexStored: Boolean; + function IsOnClickStored: Boolean; function IsShortCutStored: boolean; function IsVisibleStored: boolean; procedure SetAutoCheck(const AValue: boolean); @@ -145,13 +149,17 @@ type procedure TurnSiblingsOff; procedure DoActionChange(Sender: TObject); protected + procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); dynamic; + procedure AssignTo(Dest: TPersistent); override; function GetAction: TBasicAction; function GetActionLinkClass: TMenuActionLinkClass; dynamic; function GetHandle: HMenu; - procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); dynamic; + procedure DoClicked(var msg); message LM_ACTIVATE; procedure CreateHandle; virtual; procedure DestroyHandle; virtual; - procedure DoClicked(var msg); message LM_ACTIVATE; + procedure Loaded; override; + procedure Notification(AComponent: TComponent; + Operation: TOperation); override; procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; procedure InitiateActions; procedure MenuChanged(Rebuild : Boolean); @@ -162,6 +170,8 @@ type procedure SetParentComponent(AValue : TComponent); override; procedure SetShortCut(const AValue : TShortCut); procedure SetVisible(AValue: Boolean); + procedure UpdateImages; + procedure ImageListChange(Sender: TObject); protected property ActionLink: TMenuActionLink read FActionLink write FActionLink; public @@ -207,9 +217,11 @@ type stored IsEnabledStored default True; property Bitmap: TBitmap read FBitmap write SetBitmap; property GroupIndex: Byte read FGroupIndex write SetGroupIndex default 0; - property HelpContext: THelpContext read FHelpContext write FHelpContext stored IsHelpContextStored default 0; - property Hint: String read FHint write FHint; - property ImageIndex: Integer read FImageIndex write SetImageIndex; + property HelpContext: THelpContext read FHelpContext write FHelpContext + stored IsHelpContextStored default 0; + property Hint: String read FHint write FHint stored IsHintStored; + property ImageIndex: Integer read FImageIndex write SetImageIndex + stored IsImageIndexStored; property RadioItem: Boolean read FRadioItem write SetRadioItem default False; property RightJustify: boolean read FRightJustify write SetRightJustify; @@ -221,7 +233,8 @@ type write SetSubMenuImages; property Visible: Boolean read FVisible write SetVisible stored IsVisibleStored default True; - property OnClick: TNotifyEvent read FOnClick write FOnClick; + property OnClick: TNotifyEvent read FOnClick write FOnClick + stored IsOnClickStored; end; @@ -391,6 +404,9 @@ end. { $Log$ + Revision 1.62 2004/02/05 09:45:33 mattias + implemented Actions for TSpeedButton, TMenuItem, TCheckBox + Revision 1.61 2004/02/04 17:06:26 mattias fixed updating menu designer caption when editing in OI diff --git a/lcl/stdctrls.pp b/lcl/stdctrls.pp index d713400b48..d4b8f9604f 100644 --- a/lcl/stdctrls.pp +++ b/lcl/stdctrls.pp @@ -31,8 +31,8 @@ interface uses VCLGlobals, Classes, SysUtils, LCLStrConsts, LCLType, LCLProc, - Graphics, GraphType, LMessages, Controls, ExtendedStrings, LCLIntf, - ClipBrd, GraphMath, Forms; + LMessages, Graphics, GraphType, ExtendedStrings, LCLIntf, + ClipBrd, ActnList, GraphMath, Controls, Forms; type @@ -755,10 +755,13 @@ type public constructor Create(AOwner: TComponent); override; published + property Action; property AllowGrayed; + property Align; property Anchors; property AutoSize; property Caption; + property Constraints; property Checked; property DragCursor; property DragKind; @@ -775,6 +778,8 @@ type property OnMouseDown; property OnMouseMove; property OnMouseUp; + property OnChangeBounds; + property OnResize; property OnStartDrag; property ParentShowHint; property PopupMenu; @@ -1489,6 +1494,9 @@ end. { ============================================================================= $Log$ + Revision 1.127 2004/02/05 09:45:33 mattias + implemented Actions for TSpeedButton, TMenuItem, TCheckBox + Revision 1.126 2004/02/04 23:30:18 mattias completed TControl actions