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

LCL: Change button color when enabling/disabling TUpDown. Patch from Anton, issue #18913

Browse Source 
git-svn-id: trunk@30472 -
This commit is contained in:
juha 2011-04-25 20:39:44 +00:00
parent 580a85d184
commit a5e1656dfb
2 changed files with 13 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/comctrls.pp
View File

@ -1439,6 +1439,7 @@ type
procedure AssociateKeyDown(Sender: TObject; var Key: Word; ShiftState : TShiftState);
procedure OnAssociateChangeBounds(Sender: TObject);
procedure DoOnResize; override;
procedure SetEnabled(Value: Boolean); override;
class function GetControlClassDefaultSize: TSize; override;
function CanChange: Boolean; virtual;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;

14
lcl/include/customupdown.inc
View File

@ -130,8 +130,11 @@ var
j : integer;
begin
Inherited Paint;
Canvas.Pen.Color := clBtnText;//Not perfect, but it works
if Enabled then
Canvas.Pen.Color := clBtnText //Not perfect, but it works
else
Canvas.Pen.Color := clGrayText;
ah := height div 2;
aw := width div 2;
@ -393,6 +396,13 @@ begin
UpdateOrientation;
end;
procedure TCustomUpDown.SetEnabled(Value: Boolean);
begin
MinBtn.Enabled := Value;
MaxBtn.Enabled := Value;
inherited SetEnabled(Value);
end;
class function TCustomUpDown.GetControlClassDefaultSize: TSize;
begin
Result.CX := 17;