Industrial: Add property Switchmode to TOnOffSwitch to control how the switch state can be changed by the mouse.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8965 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-10-15 14:51:13 +00:00
parent e842d8bf0d
commit 1a62c8a157
2 changed files with 25 additions and 7 deletions

View File

@ -59,6 +59,9 @@
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>

View File

@ -26,6 +26,7 @@ type
bsNone, bsThin, bsThick, bsThin3D, bsThick3D,
bsNoneRounded, bsThinRounded, bsThickRounded
);
TSwitchMode = (smClick, smDblClick, smSlide, smSlideDblClick);
TSwitchOrientation = (soHorizontal, soVertical);
TCustomOnOffSwitch = class(TCustomControl)
@ -49,6 +50,7 @@ type
FShowButtonBorder: Boolean;
FShowCaption: Boolean;
FShowFocusRect: Boolean;
FSwitchMode: TSwitchMode;
FOnChange: TNotifyEvent;
FDblClickTimer: TTimer;
FPicture: array[0..1] of TPicture;
@ -85,6 +87,7 @@ type
procedure DrawCaption(ARect: TRect; AChecked: Boolean); virtual;
procedure DrawFocusRect(ARect: TRect);
class function GetControlClassDefaultSize: TSize; override;
function HasPicture: Boolean;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
@ -108,6 +111,7 @@ type
property ShowButtonBorder: Boolean read FShowButtonBorder write SetShowButtonBorder default true;
property ShowFocusRect: Boolean read FShowFocusRect write SetShowFocusRect default true;
property ShowCaption: Boolean read FShowCaption write SetShowCaption default true;
property SwitchMode: TSwitchMode read FSwitchMode write FSwitchMode default smSlideDblClick;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
public
constructor Create(AOwner: TComponent); override;
@ -135,6 +139,7 @@ type
property ShowButtonBorder;
property ShowCaption;
property ShowFocusRect;
property SwitchMode;
// inherited
property Action;
@ -214,6 +219,7 @@ begin
FShowCaption := true;
FShowButtonBorder := true;
FShowFocusRect := true;
FSwitchMode := smSlideDblClick;
FDblClickTimer := TTimer.Create(self);
FDblClickTimer.Interval := 500;
FDblClickTimer.Enabled := false;
@ -453,6 +459,11 @@ begin
Result := FPicture[AIndex];
end;
function TCustomOnOffSwitch.HasPicture: Boolean;
begin
Result := (FPicture[0].Width <> 0) or (FPicture[1].Width <> 0);
end;
procedure TCustomOnOffSwitch.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited;
@ -465,7 +476,7 @@ begin
inherited;
SetFocus;
if CanChange and (Button = mbLeft) and MouseOnButton(X, Y) then begin
FDragging := true;
if (FSwitchMode in [smSlide, smSlideDblClick]) then FDragging := true;
FMousePt := Point(X, Y);
FDraggedDistance := 0;
FDblClickTimer.Enabled := true;
@ -498,21 +509,25 @@ var
d: Integer;
begin
inherited;
if Button = mbLeft then begin
if (Button = mbLeft) and CanChange then begin
oldChecked := FChecked;
d := FDraggedDistance;
FDraggedDistance := 0;
if FDragging then begin
FChecked := DraggingToValue(d);
end;
FDragging := false;
if CanChange then begin
FDragging := false;
end else
begin
if (FSwitchMode = smClick) or (HasPicture and (FSwitchMode = smSlide)) then
FChecked := not FChecked;
if FChecked <> oldChecked then
DoChange
else
if (FSwitchMode in [smDblClick, smSlideDblClick]) then
FTogglePending := true;
end;
Invalidate;
if FChecked <> oldChecked then
Invalidate;
end;
end;
@ -527,7 +542,7 @@ begin
R := Rect(0, 0, Width, Height);
picIdx := IfThen(FChecked, 1, 0);
if FPicture[picIdx].Width > 0 then
if HasPicture then
begin
Canvas.StretchDraw(R, FPicture[picIdx].Graphic);
exit;