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

started TButtonActionLink

Browse Source 
git-svn-id: trunk@7125 -
This commit is contained in:
mattias 2005-05-02 09:17:08 +00:00
parent bcb6a561b8
commit a7b16d2f92
4 changed files with 63 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
components/codetools/pascalparsertool.pas
View File

@ -1154,7 +1154,6 @@ begin
else
ExtractNextAtom(copying,Attr);
if not AtomIsIdentifier(ExceptionOnError) then exit;
CurNode.EndPos:=CurPos.EndPos;
if not Extract then
ReadNextAtom
else
@ -1251,6 +1250,18 @@ begin
EndChildNode;
end;
ReadNextAtom;
if CurPos.Flag=cafPoint then begin
// unitname.identifier -> read identifier
ReadNextAtom;
AtomIsIdentifier(true);
if (pphCreateNodes in ParseAttr) then begin
CreateChildNode;
CurNode.Desc:=ctnIdentifier;
CurNode.EndPos:=CurPos.EndPos;
EndChildNode;
end;
ReadNextAtom;
end;
end else begin
if (Scanner.CompilerMode<>cmDelphi) then
RaiseCharExpectedButAtomFound(':')
@ -1402,6 +1413,12 @@ begin
else exit;
end;
if not Extract then ReadNextAtom else ExtractNextAtom(true,Attr);
if CurPos.Flag=cafPoint then begin
// Unitname.Constant
if not Extract then ReadNextAtom else ExtractNextAtom(true,Attr);
Result:=ReadConstant(ExceptionOnError,Extract,Attr);
exit;
end;
if WordIsTermOperator.DoItUpperCase(UpperSrc,
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)
then begin

5
lcl/buttons.pp
View File

@ -101,7 +101,7 @@ type
{ TButton }
TButton = class(TCustomButton)
public
procedure Click; override;
@ -406,6 +406,9 @@ end.
{ =============================================================================
$Log$
Revision 1.97 2005/05/02 09:17:08 mattias
started TButtonActionLink
Revision 1.96 2005/04/27 12:37:28 micha
implement/fix button/label shortcut accelchar handling

26
lcl/include/buttoncontrol.inc
View File

@ -72,5 +72,31 @@ begin
Color:=clBtnFace;
end;
{ TButtonActionLink }
procedure TButtonActionLink.AssignClient(AClient: TObject);
begin
inherited AssignClient(AClient);
FClientButton := AClient as TButtonControl;
end;
function TButtonActionLink.IsCheckedLinked: Boolean;
begin
Result:=inherited IsCheckedLinked
and (FClientButton.Checked = (Action as TCustomAction).Checked);
end;
procedure TButtonActionLink.SetChecked(Value: Boolean);
begin
if IsCheckedLinked then begin
FClientButton.ClicksDisabled := True;
try
FClientButton.Checked := Value;
finally
FClientButton.ClicksDisabled := False;
end;
end;
end;
// included by stdctrls.pp

15
lcl/stdctrls.pp
View File

@ -836,6 +836,18 @@ type
constructor Create(TheOwner: TComponent); override;
end;
{ TButtonActionLink - Finish me }
TButtonActionLink = class(TWinControlActionLink)
protected
FClientButton: TButtonControl;
procedure AssignClient(AClient: TObject); override;
function IsCheckedLinked: Boolean; override;
procedure SetChecked(Value: Boolean); override;
end;
TButtonActionLinkClass = class of TButtonActionLink;
{ TCustomCheckBox }
@ -1240,6 +1252,9 @@ end.
{ =============================================================================
$Log$
Revision 1.203 2005/05/02 09:17:08 mattias
started TButtonActionLink
Revision 1.202 2005/04/27 12:37:28 micha
implement/fix button/label shortcut accelchar handling