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

added TToolButton.Action and published some props

Browse Source 
git-svn-id: trunk@5162 -
This commit is contained in:
mattias 2004-02-04 12:59:08 +00:00
parent 033a8d0037
commit d7b70bb93d
3 changed files with 82 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
lcl/comctrls.pp
View File

@ -37,9 +37,9 @@ unit ComCtrls;
interface
uses
SysUtils, Classes, FPCAdds, LCLStrConsts, LCLIntf, LCLType, LCLProc,
AvgLvlTree, Controls, Forms, StdCtrls, ExtCtrls, vclGlobals, LMessages, Menus,
ImgList, GraphType, Graphics, ToolWin, CommCtrl, Buttons, Math;
SysUtils, Classes, Math, FPCAdds, LCLStrConsts, LCLIntf, LCLType, LCLProc,
AvgLvlTree, vclGlobals, LMessages, ImgList, ActnList, GraphType, Graphics,
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

54
lcl/include/toolbutton.inc
View File

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

5
lcl/stdctrls.pp
View File

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