paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-11 16:36:01 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: updating TCustomUpDown to use WS interface, if provided. #34663

Browse Source 
git-svn-id: trunk@60966 -
This commit is contained in:
dmitry 2019-04-14 06:52:26 +00:00
parent 78bc4df384
commit 3d2a723a44
2 changed files with 45 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/comctrls.pp
View File

@ -1891,6 +1891,7 @@ type
FPosition: SmallInt;
FThousands: Boolean;
FWrap: Boolean;
FUseWS: Boolean;
function GetPosition: SmallInt;
procedure BTimerExec(Sender : TObject);
function GetFlat: Boolean;
@ -1911,6 +1912,7 @@ type
procedure UpdateUpDownPositionText;
protected
class procedure WSRegisterClass; override;
procedure InitializeWnd; override;
procedure AssociateKeyDown(Sender: TObject; var Key: Word; ShiftState : TShiftState);
procedure AssociateMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint; var Handled: Boolean);

48
lcl/include/customupdown.inc
View File

@ -209,9 +209,13 @@ begin
inherited Create(AOwner);
ControlStyle := ControlStyle - [csDoubleClicks] +
[csClickEvents, csOpaque, csReplicatable, csNoFocus];
FUseWS := IsWSComponentInheritsFrom(TCustomUpDown, TWSCustomUpDown);
FOrientation := udVertical;
FMinBtn := TUpDownButton.CreateWithParams(Self, btPrev);
FMaxBtn := TUpDownButton.CreateWithParams(Self, btNext);
if not FUseWS then begin
FMinBtn := TUpDownButton.CreateWithParams(Self, btPrev);
FMaxBtn := TUpDownButton.CreateWithParams(Self, btNext);
end;
with GetControlClassDefaultSize do
SetInitialBounds(0, 0, CX, CY);
FArrowKeys := True;
@ -260,10 +264,24 @@ begin
RegisterCustomUpDown;
end;
procedure TCustomUpDown.InitializeWnd;
begin
inherited InitializeWnd;
if not FUseWS then Exit;
TWSCustomUpDownClass(WidgetSetClass).SetMaxPosition(Self, FMax);
TWSCustomUpDownClass(WidgetSetClass).SetPosition(Self, FPosition);
TWSCustomUpDownClass(WidgetSetClass).SetIncrement(Self, FIncrement);
TWSCustomUpDownClass(WidgetSetClass).SetWrap(Self, FWrap);
TWSCustomUpDownClass(WidgetSetClass).SetOrientation(Self, FOrientation);
TWSCustomUpDownClass(WidgetSetClass).SetUseArrowKeys(Self, FArrowKeys);
end;
procedure TCustomUpDown.UpdateOrientation;
var
d, r: Integer;
begin
if FUseWS then Exit;
If FOrientation = udHorizontal then begin
d:=ClientWidth div 2;
r:=ClientWidth mod 2;
@ -526,7 +544,9 @@ end;
function TCustomUpDown.GetFlat: Boolean;
begin
if FMinBtn<>nil then
if FUseWS then
Result := false
else if FMinBtn<>nil then
Result := (FMinBtn as TSpeedButton).Flat
else
Result := False;
@ -539,6 +559,8 @@ begin
FMin := Value;
If FPosition < FMin then
Position := FMin;
if FUseWS then
TWSCustomUpDownClass(WidgetSetClass).SetMinPosition(Self, FMin);
end;
end;
@ -556,19 +578,26 @@ begin
FMax := Value;
If FPosition > FMax then
Position := FMax;
if FUseWS then
TWSCustomUpDownClass(WidgetSetClass).SetMaxPosition(Self, FMax);
end;
end;
procedure TCustomUpDown.SetIncrement(Value: Integer);
begin
if Value <> FIncrement then
if Value <> FIncrement then begin
FIncrement := Value;
if FUseWS then
TWSCustomUpDownClass(WidgetSetClass).SetIncrement(Self, FIncrement);
end;
end;
procedure TCustomUpDown.SetPosition(Value: SmallInt);
begin
if FPosition = Value then exit;
FPosition := Value;
if FUseWS then
TWSCustomUpDownClass(WidgetSetClass).SetPosition(Self, FPosition);
UpdateUpDownPositionText;
end;
@ -576,6 +605,9 @@ procedure TCustomUpDown.SetOrientation(Value: TUDOrientation);
begin
if FOrientation = Value then exit;
FOrientation := Value;
if FUseWS then
TWSCustomUpDownClass(WidgetSetClass).SetOrientation(Self, FOrientation);
UpdateOrientation;
end;
@ -588,8 +620,11 @@ end;
procedure TCustomUpDown.SetArrowKeys(Value: Boolean);
begin
if Value <> FArrowKeys then
if Value <> FArrowKeys then begin
FArrowKeys := Value;
if FUseWS then
TWSCustomUpDownClass(WidgetSetClass).SetUseArrowKeys(Self, Value);
end;
end;
procedure TCustomUpDown.SetThousands(Value: Boolean);
@ -600,6 +635,7 @@ end;
procedure TCustomUpDown.SetFlat(Value: Boolean);
begin
if FUseWS then Exit; // todo: not supported by WS yet
if Flat = Value then Exit;
(FMinBtn as TSpeedButton).Flat := Value;
@ -610,6 +646,8 @@ procedure TCustomUpDown.SetWrap(Value: Boolean);
begin
if Value <> FWrap then
FWrap := Value;
if FUseWS then
TWSCustomUpDownClass(WidgetSetClass).SetWrap(Self, FWrap);
end;
// included by comctrls.pp