FIX: KASButton - draw gray icon when button disabled

(cherry picked from commit b812db501c)
This commit is contained in:
Alexander Koblov 2026-05-05 21:24:03 +03:00
commit ec44ebc623

View file

@ -27,7 +27,7 @@ interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
Buttons, Themes, Types, ImgList;
Buttons, Themes, Types, ImgList, LMessages;
type
@ -37,6 +37,7 @@ type
private
FState: TButtonState;
FShowCaption: Boolean;
FMouseInControl: Boolean;
FButtonGlyph: TButtonGlyph;
FImageChangeLink: TChangeLink;
private
@ -62,11 +63,13 @@ type
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
protected
procedure Click; override;
function GetGlyphSize: TSize;
procedure GlyphChanged(Sender: TObject);
procedure ImageListChange(Sender: TObject);
class function GetControlClassDefaultSize: TSize; override;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
procedure CMEnabledChanged(var Message: TLMessage); message CM_ENABLEDCHANGED;
procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: Integer; WithThemeSpace: Boolean); override;
public
constructor Create(TheOwner: TComponent); override;
@ -92,6 +95,9 @@ begin
RegisterComponents('KASComponents',[TKASButton]);
end;
const
UpState: array[Boolean] of TButtonState = (bsUp, bsHot);
{ TKASButton }
procedure TKASButton.DoEnter;
@ -254,15 +260,23 @@ end;
procedure TKASButton.MouseEnter;
begin
inherited MouseEnter;
FState:= bsHot;
Invalidate;
FMouseInControl:= True;
if IsEnabled then
begin
FState:= bsHot;
Invalidate;
end;
end;
procedure TKASButton.MouseLeave;
begin
inherited MouseLeave;
FState:= bsUp;
Invalidate;
FMouseInControl:= False;
if IsEnabled then
begin
FState:= bsUp;
Invalidate;
end;
end;
procedure TKASButton.KeyUp(var Key: Word; Shift: TShiftState);
@ -290,16 +304,27 @@ procedure TKASButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
FState:= bsUp;
Invalidate;
if IsEnabled then
begin
FState:= bsUp;
Invalidate;
end;
end;
procedure TKASButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseDown(Button, Shift, X, Y);
FState:= bsDown;
Invalidate;
if IsEnabled then
begin
FState:= bsDown;
Invalidate;
end;
end;
procedure TKASButton.Click;
begin
if IsEnabled then inherited Click;
end;
function TKASButton.GetGlyphSize: TSize;
@ -354,6 +379,16 @@ begin
end;
end;
procedure TKASButton.CMEnabledChanged(var Message: TLMessage);
begin
if Enabled then
FState:= UpState[FMouseInControl]
else begin
FState:= bsDisabled;
end;
Invalidate;
end;
procedure TKASButton.CalculatePreferredSize(var PreferredWidth,
PreferredHeight: Integer; WithThemeSpace: Boolean);
var