pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

industrial: Fix LCL scaling for TOnOffSwitch.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7303 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-01-19 16:46:53 +00:00
parent e975fefca2
commit 8e0767f36a
1 changed files with 9 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files

25
components/industrialstuff/source/switches.pas
View File

@ -25,6 +25,9 @@ type
TSwitchOrientation = (soHorizontal, soVertical);
TCustomOnOffSwitch = class(TCustomControl)
private
const
DEFAULT_BUTTON_SIZE = 24;
private
FBorderStyle: TSwitchBorderStyle;
FButtonSize: Integer;
@ -46,7 +49,6 @@ type
function GetCaptions(AIndex: Integer): String;
function GetColors(AIndex: Integer): TColor;
function GetOrientation: TSwitchOrientation;
function IsButtonSizeStored: Boolean;
procedure SetBorderStyle(AValue: TSwitchBorderStyle); reintroduce;
procedure SetButtonSize(AValue: Integer);
procedure SetCaptions(AIndex: Integer; AValue: string);
@ -79,7 +81,7 @@ type
procedure Paint; override;
property BorderColor: TColor index 2 read GetColors write SetColors default clGray;
property BorderStyle: TSwitchBorderStyle read FBorderStyle write SetBorderStyle default bsThin;
property ButtonSize: Integer read FButtonSize write SetButtonSize stored IsButtonSizeStored;
property ButtonSize: Integer read FButtonSize write SetButtonSize default DEFAULT_BUTTON_SIZE;
property CaptionOFF: String index 0 read GetCaptions write SetCaptions;
property CaptionON: String index 1 read GetCaptions write SetCaptions;
property Checked: Boolean read FChecked write SetChecked default false;
@ -148,9 +150,6 @@ implementation
uses
LCLIntf, LCLType, Math;
const
DEFAULT_BUTTON_SIZE = 24;
function TintedColor(AColor: TColor; ADelta: Integer): TColor;
var
r, g, b: Byte;
@ -180,7 +179,7 @@ begin
TabStop := true;
Color := clWindow;
FBorderStyle := bsThin;
FButtonSize := Scale96ToFont(DEFAULT_BUTTON_SIZE);
FButtonSize := DEFAULT_BUTTON_SIZE;
FColors[0] := clMaroon; // unchecked color
FColors[1] := clGreen; // checked color
FColors[2] := clGray; // Border color
@ -268,11 +267,10 @@ begin
begin
DisableAutosizing;
try
if IsButtonSizeStored then
case Orientation of
soHorizontal : FButtonSize := Round(FButtonSize * AXProportion);
soVertical : FButtonSize := Round(FButtonSize * AYProportion);
end;
case Orientation of
soHorizontal : FButtonSize := Round(FButtonSize * AXProportion);
soVertical : FButtonSize := Round(FButtonSize * AYProportion);
end;
finally
EnableAutoSizing;
end;
@ -405,11 +403,6 @@ begin
if Width > Height then Result := soHorizontal else Result := soVertical;
end;
function TCustomOnOffSwitch.IsButtonSizeStored: Boolean;
begin
Result := FButtonSize <> Scale96ToFont(DEFAULT_BUTTON_SIZE);
end;
procedure TCustomOnOffSwitch.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited;