paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Industrial: Use SetShape to define the border of the rounded TOnOffButton control

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9030 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2023-11-15 19:03:00 +00:00
parent 380344d99e
commit c3ce0e4b85
1 changed files with 37 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -87,7 +87,7 @@ type
procedure SetShowFocusRect(AValue: Boolean);
procedure UpdateButtonPos;
procedure UpdateMaxDistance;
procedure WM_EraseBkGnd(var Msg: TMsg); message LM_EraseBkGnd;
procedure UpdateShape;
protected
function CalcButtonRect: TRect;
function CalcMargin: Integer;
@ -862,12 +862,14 @@ procedure TCustomOnOffSwitch.SetBorderStyle(AValue: TSwitchBorderStyle);
begin
if AValue = FBorderStyle then exit;
FBorderStyle := AValue;
UpdateShape;
Invalidate;
end;
procedure TCustomOnOffSwitch.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
inherited;
UpdateShape;
UpdateMaxDistance;
end;
@ -1006,9 +1008,41 @@ begin
UpdateButtonPos;
end;
procedure TCustomOnOffSwitch.WM_EraseBkGnd(var Msg: TMsg);
procedure TCustomOnOffSwitch.UpdateShape;
var
R: TRect;
bmp: TBitmap;
diam: Integer;
begin
Msg.message := 1;
R := Rect(0, 0, Width, Height);
bmp := TBitmap.Create;
try
bmp.Monochrome := true;
bmp.SetSize(R.Width, R.Height);
if FBorderStyle in [bsNoneRounded, bsThinRounded, bsThickRounded] then
begin
if Orientation = soHorizontal then
diam := R.Height
else
diam := R.Width;
bmp.Canvas.Brush.Color := clBlack;
bmp.Canvas.FillRect(R);
bmp.Canvas.Brush.Color := clWhite;
// bmp.Canvas.Pen.Style := psClear;
bmp.Canvas.Pen.Color := clWhite;
bmp.Canvas.Pen.Width := GetBorderWidth;
if FBorderStyle = bsThickRounded then
InflateRect(R, -1, -1);
bmp.Canvas.RoundRect(R.Left, R.Top, R.Right, R.Bottom, diam, diam);
end else
begin
bmp.Canvas.Brush.Color := clWhite;
bmp.Canvas.FillRect(R);
end;
SetShape(bmp);
finally
bmp.Free;
end;
end;
end.