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