paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-13 15:59:38 +02:00
Code Issues Packages Projects Releases Wiki Activity

implemented Actions for TSpeedButton, TMenuItem, TCheckBox

Browse Source 
git-svn-id: trunk@5172 -
This commit is contained in:
mattias 2004-02-05 09:45:33 +00:00
parent ddd3ba7dbd
commit 7218b6a616
6 changed files with 151 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lcl/include/customcheckbox.inc
View File

@ -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

36
lcl/include/menuactionlink.inc
View File

@ -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);

128
lcl/include/menuitem.inc
View File

@ -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 i<Position then begin
if Items[i].GroupIndex>Value 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].GroupIndex<Value) then
Items[i].FGroupIndex:=Value;
end else
inherited AssignTo(Dest);
end;
*)
// included by menus.pp
@ -1080,6 +1118,9 @@ end;
{ =============================================================================
$Log$
Revision 1.50 2004/02/05 09:45:33 mattias
implemented Actions for TSpeedButton, TMenuItem, TCheckBox
Revision 1.49 2004/02/04 17:06:26 mattias
fixed updating menu designer caption when editing in OI
@ -1258,6 +1299,9 @@ end;
$Log$
Revision 1.50 2004/02/05 09:45:33 mattias
implemented Actions for TSpeedButton, TMenuItem, TCheckBox
Revision 1.49 2004/02/04 17:06:26 mattias
fixed updating menu designer caption when editing in OI

10
lcl/include/speedbutton.inc
View File

@ -231,6 +231,10 @@ begin
else FState := bsUp;
end;
end;
if FState<>OldState 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

28
lcl/menus.pp
View File

@ -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

12
lcl/stdctrls.pp
View File

@ -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