added TToolButton.Action and published some props

git-svn-id: trunk@5162 -

lcl/comctrls.pp

@@ -37,9 +37,9 @@ unit ComCtrls;
 interface
 
 uses
-  SysUtils, Classes, FPCAdds, LCLStrConsts, LCLIntf, LCLType, LCLProc,
+  SysUtils, Classes, Math, FPCAdds, LCLStrConsts, LCLIntf, LCLType, LCLProc,
-  AvgLvlTree, Controls, Forms, StdCtrls, ExtCtrls, vclGlobals, LMessages, Menus,
+  AvgLvlTree, vclGlobals, LMessages, ImgList, ActnList, GraphType, Graphics,
-  ImgList, GraphType, Graphics, ToolWin, CommCtrl, Buttons, Math;
+  Menus, Controls, Forms, StdCtrls, ExtCtrls, ToolWin, CommCtrl, Buttons;
 
 type
   TStatusPanelStyle = (psText, psOwnerDraw);
@@ -761,6 +761,20 @@ type
   TToolButton = class;
 
 
+  { TToolButtonActionLink }
+
+  TToolButtonActionLink = class(TControlActionLink)
+  protected
+    procedure AssignClient(AClient: TObject); override;
+    function IsCheckedLinked: Boolean; override;
+    function IsImageIndexLinked: Boolean; override;
+    procedure SetChecked(Value: Boolean); override;
+    procedure SetImageIndex(Value: Integer); override;
+  end;
+
+  TToolButtonActionLinkClass = class of TToolButtonActionLink;
+  
+  
   TToolButton = class(TButtonControl)
   private
     FAllowAllUp: Boolean;
@@ -795,6 +809,8 @@ type
     procedure CMVisibleChanged(var Message: TLMessage); message CM_VISIBLECHANGED;
   protected
     FToolBar: TToolBar;
+    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+    function GetActionLinkClass: TControlActionLinkClass; override;
     procedure AssignTo(Dest: TPersistent); override;
     procedure BeginUpdate; virtual;
     procedure EndUpdate; virtual;
@@ -813,6 +829,7 @@ type
     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
     property Index: Integer read GetIndex;
   published
+    property Action;
     property AllowAllUp: Boolean read FAllowAllUp write FAllowAllUp default False;
     property AutoSize default False;
     property Caption;
@@ -1955,6 +1972,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.106  2004/02/04 12:59:07  mattias
+  added TToolButton.Action and published some props
+
   Revision 1.105  2004/02/02 20:00:45  mattias
   published TTreeView.Tab
 

lcl/include/toolbutton.inc

@@ -15,6 +15,38 @@
 
 }
 
+{ TToolButtonActionLink }
+
+procedure TToolButtonActionLink.AssignClient(AClient: TObject);
+begin
+  inherited AssignClient(AClient);
+  FClient := AClient as TToolButton;
+end;
+
+function TToolButtonActionLink.IsCheckedLinked: Boolean;
+begin
+  Result := inherited IsCheckedLinked
+    and (TToolButton(FClient).Down = (Action as TCustomAction).Checked);
+end;
+
+function TToolButtonActionLink.IsImageIndexLinked: Boolean;
+begin
+  Result := inherited IsImageIndexLinked
+   and (TToolButton(FClient).ImageIndex = (Action as TCustomAction).ImageIndex);
+end;
+
+procedure TToolButtonActionLink.SetChecked(Value: Boolean);
+begin
+  if IsCheckedLinked then TToolButton(FClient).Down := Value;
+end;
+
+procedure TToolButtonActionLink.SetImageIndex(Value: Integer);
+begin
+  if IsImageIndexLinked then TToolButton(FClient).ImageIndex := Value;
+end;
+
+{ TToolButton }
+
 constructor TToolButton.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
@@ -229,6 +261,25 @@ begin
   end;
 end;
 
+procedure TToolButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+var
+  NewAction: TCustomAction;
+begin
+  inherited ActionChange(Sender, CheckDefaults);
+  if Sender is TCustomAction then begin
+    NewAction:=TCustomAction(Sender);
+    if not CheckDefaults or (not Down) then
+      Down := NewAction.Checked;
+    if not CheckDefaults or (ImageIndex = -1) then
+      ImageIndex := NewAction.ImageIndex;
+  end;
+end;
+
+function TToolButton.GetActionLinkClass: TControlActionLinkClass;
+begin
+  Result:=TToolButtonActionLink;
+end;
+
 procedure TToolButton.CMEnabledChanged(var Message: TLMessage);
 begin
   if FToolBar <> nil then
@@ -454,6 +505,9 @@ end;
 
 {
   $Log$
+  Revision 1.5  2004/02/04 12:59:08  mattias
+  added TToolButton.Action and published some props
+
   Revision 1.4  2003/12/29 14:22:22  micha
   fix a lot of range check errors win32
 

lcl/stdctrls.pp

@@ -418,6 +418,7 @@ type
     property BorderStyle;
     property Constraints;
     property ExtendedSelect;
+    property Font;
     property Items;
     property ItemHeight;
     property MultiSelect;
@@ -438,6 +439,7 @@ type
     property OnMouseWheelUp;
     property OnResize;
     property ParentShowHint;
+    property ParentFont;
     property PopupMenu;
     property ShowHint;
     property Sorted;
@@ -1483,6 +1485,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.124  2004/02/04 12:59:07  mattias
+  added TToolButton.Action and published some props
+
   Revision 1.123  2004/02/04 11:09:40  mattias
   added DefineProperties check for check lfm