mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-08 19:58:18 +02:00
LazControls; Start T(Float)SpinEditEx.
Note: the GroupedEdit unit goes into LCLbase, since this can be used as the new baseclass for TEditButton. git-svn-id: trunk@51265 -
This commit is contained in:
parent
9f6df04a52
commit
feaa04bd41
5
.gitattributes
vendored
5
.gitattributes
vendored
@ -2266,10 +2266,12 @@ components/lazcontrols/images/lazcontrols_list.txt svneol=native#text/plain
|
||||
components/lazcontrols/images/tcheckboxthemed.png -text svneol=unset#image/png
|
||||
components/lazcontrols/images/tdividerbevel.png -text
|
||||
components/lazcontrols/images/textendednotebook.png -text
|
||||
components/lazcontrols/images/tfloatspineditex.png -text svneol=unset#image/png
|
||||
components/lazcontrols/images/tlistfilteredit.png -text
|
||||
components/lazcontrols/images/tlistviewfilteredit.png -text svneol=unset#image/png
|
||||
components/lazcontrols/images/tlvlgraphcontrol.png -text svneol=unset#image/png
|
||||
components/lazcontrols/images/tshortpathedit.png -text svneol=unset#image/png
|
||||
components/lazcontrols/images/tspineditex.png -text svneol=unset#image/png
|
||||
components/lazcontrols/images/ttreefilteredit.png -text svneol=unset#image/png
|
||||
components/lazcontrols/lazcontrols.lpk svneol=native#text/xml
|
||||
components/lazcontrols/lazcontrols.pas svneol=native#text/pascal
|
||||
@ -2278,6 +2280,8 @@ components/lazcontrols/listfilteredit.pas svneol=native#text/plain
|
||||
components/lazcontrols/listviewfilteredit.pas svneol=native#text/pascal
|
||||
components/lazcontrols/lvlgraphctrl.pas svneol=native#text/plain
|
||||
components/lazcontrols/shortpathedit.pas svneol=native#text/plain
|
||||
components/lazcontrols/spinex.inc svneol=native#text/plain
|
||||
components/lazcontrols/spinex.pp svneol=native#text/pascal
|
||||
components/lazcontrols/treefilteredit.pas svneol=native#text/plain
|
||||
components/lazdebuggergdbmi/Makefile svneol=native#text/plain
|
||||
components/lazdebuggergdbmi/Makefile.compiled svneol=native#text/plain
|
||||
@ -6687,6 +6691,7 @@ lcl/graphmath.pp svneol=native#text/pascal
|
||||
lcl/graphtype.pp svneol=native#text/pascal
|
||||
lcl/graphutil.pp svneol=native#text/pascal
|
||||
lcl/grids.pas svneol=native#text/pascal
|
||||
lcl/groupededit.pp svneol=native#text/pascal
|
||||
lcl/helpintfs.pas svneol=native#text/pascal
|
||||
lcl/icnstypes.pas svneol=native#text/pascal
|
||||
lcl/imagelistcache.pas svneol=native#text/pascal
|
||||
|
@ -3,7 +3,7 @@
|
||||
|
||||
fpmake.pp for LazControls 1.0.1
|
||||
|
||||
This file was generated on 02-01-2015
|
||||
This file was generated on 13-1-2016
|
||||
}
|
||||
|
||||
{$ifndef ALLPACKAGES}
|
||||
@ -39,7 +39,6 @@ begin
|
||||
P.Options.Add('-vewnhibq');
|
||||
P.Options.Add('-dLCL');
|
||||
P.Options.Add('-dLCL$(LCLWidgetType)');
|
||||
P.Options.Add('-dNoCarbon');
|
||||
P.UnitPath.Add('.');
|
||||
T:=P.Targets.AddUnit('lazcontrols.pas');
|
||||
t.Dependencies.AddUnit('checkboxthemed');
|
||||
@ -51,6 +50,7 @@ begin
|
||||
t.Dependencies.AddUnit('shortpathedit');
|
||||
t.Dependencies.AddUnit('lvlgraphctrl');
|
||||
t.Dependencies.AddUnit('extendedtabcontrols');
|
||||
t.Dependencies.AddUnit('spinex');
|
||||
|
||||
T:=P.Targets.AddUnit('checkboxthemed.pas');
|
||||
T:=P.Targets.AddUnit('dividerbevel.pas');
|
||||
@ -61,6 +61,7 @@ begin
|
||||
T:=P.Targets.AddUnit('shortpathedit.pas');
|
||||
T:=P.Targets.AddUnit('lvlgraphctrl.pas');
|
||||
T:=P.Targets.AddUnit('extendedtabcontrols.pas');
|
||||
T:=P.Targets.AddUnit('spinex.pp');
|
||||
|
||||
// copy the compiled file, so the IDE knows how the package was compiled
|
||||
P.InstallFiles.Add('LazControls.compiled',AllOSes,'$(unitinstalldir)');
|
||||
|
@ -6,3 +6,5 @@ tlistviewfilteredit.png
|
||||
ttreefilteredit.png
|
||||
tlvlgraphcontrol.png
|
||||
tshortpathedit.png
|
||||
tfloatspineditex.png
|
||||
tspineditex.png
|
BIN
components/lazcontrols/images/tfloatspineditex.png
Normal file
BIN
components/lazcontrols/images/tfloatspineditex.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 400 B |
BIN
components/lazcontrols/images/tspineditex.png
Normal file
BIN
components/lazcontrols/images/tspineditex.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 399 B |
@ -3,6 +3,7 @@
|
||||
<Package Version="4">
|
||||
<PathDelim Value="\"/>
|
||||
<Name Value="LazControls"/>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<AddToProjectUsesSection Value="True"/>
|
||||
<Author Value="Lazarus Team"/>
|
||||
<CompilerOptions>
|
||||
@ -18,7 +19,7 @@
|
||||
<Description Value="Some extra LCL controls needed by the IDE."/>
|
||||
<License Value="modified LGPL-2"/>
|
||||
<Version Major="1" Release="1"/>
|
||||
<Files Count="9">
|
||||
<Files Count="11">
|
||||
<Item1>
|
||||
<Filename Value="checkboxthemed.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
@ -63,9 +64,17 @@
|
||||
<Filename Value="extendedtabcontrols.pas"/>
|
||||
<UnitName Value="ExtendedTabControls"/>
|
||||
</Item9>
|
||||
<Item10>
|
||||
<Filename Value="spinex.pp"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="SpinEx"/>
|
||||
</Item10>
|
||||
<Item11>
|
||||
<Filename Value="spinex.inc"/>
|
||||
<Type Value="Include"/>
|
||||
</Item11>
|
||||
</Files>
|
||||
<LazDoc Paths="docs"/>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<RequiredPkgs Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
|
@ -9,7 +9,7 @@ interface
|
||||
uses
|
||||
CheckBoxThemed, DividerBevel, ExtendedNotebook, ListFilterEdit,
|
||||
ListViewFilterEdit, TreeFilterEdit, ShortPathEdit, LvlGraphCtrl,
|
||||
ExtendedTabControls, LazarusPackageIntf;
|
||||
ExtendedTabControls, SpinEx, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
@ -25,6 +25,7 @@ begin
|
||||
RegisterUnit('TreeFilterEdit', @TreeFilterEdit.Register);
|
||||
RegisterUnit('ShortPathEdit', @ShortPathEdit.Register);
|
||||
RegisterUnit('LvlGraphCtrl', @LvlGraphCtrl.Register);
|
||||
RegisterUnit('SpinEx', @SpinEx.Register);
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
Binary file not shown.
474
components/lazcontrols/spinex.inc
Normal file
474
components/lazcontrols/spinex.inc
Normal file
@ -0,0 +1,474 @@
|
||||
{%MainUnit spinex.pp}
|
||||
|
||||
{
|
||||
*****************************************************************************
|
||||
This file is part of the Lazarus Component Library (LCL)
|
||||
|
||||
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
||||
for details about the license.
|
||||
*****************************************************************************
|
||||
|
||||
}
|
||||
|
||||
const
|
||||
NvbStrings: Array[TNullValueBehaviour] of string = (
|
||||
'nvbShowTextHint',
|
||||
'nvbLimitedNullValue',
|
||||
'nvbMinValue',
|
||||
'nvbMaxValue',
|
||||
'nvbInitialValue'
|
||||
);
|
||||
|
||||
function DbgS(ANvb: TNullValueBehaviour): String;
|
||||
begin
|
||||
Result := NvbStrings[ANvb];
|
||||
end;
|
||||
|
||||
procedure TCustomFloatSpinEditEx.UpdateControl;
|
||||
var
|
||||
D: Double;
|
||||
begin
|
||||
if (MaxValue < MinValue) then FMaxValue := MinValue;
|
||||
if (FNullValueBehaviour <> nvbShowTextHint) then
|
||||
FValue := GetLimitedValue(FValue);
|
||||
|
||||
if (not HandleAllocated) then Exit;
|
||||
|
||||
if ([csLoading, csDestroying] * ComponentState <> []) then
|
||||
FUpdatePending := True
|
||||
else
|
||||
begin
|
||||
FUpdatePending := False;
|
||||
//Update the Text
|
||||
if (FNullValueBehaviour = nvbShowTextHint) then
|
||||
begin
|
||||
if not FSettingValue then
|
||||
begin
|
||||
if TextIsNumber(Text, D) then
|
||||
Text := ValueToStr(GetLimitedValue(D))
|
||||
else
|
||||
Text := EmptyStr;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if IsOutOfLimits(FValue) then
|
||||
Text := EmptyStr
|
||||
else
|
||||
Text := ValueToStr(FValue);
|
||||
end;
|
||||
end
|
||||
else
|
||||
Text := ValueToStr(GetLimitedValue(FValue));
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TCustomFloatSpinEditEx.SetDecimalSeparator(AValue: Char);
|
||||
begin
|
||||
if (AValue = FFS.DecimalSeparator) then Exit;
|
||||
FFS.DecimalSeparator := AValue;
|
||||
UpdateControl;
|
||||
end;
|
||||
|
||||
procedure TCustomFloatSpinEditEx.UpDownChangingEx(Sender: TObject;
|
||||
var AllowChange: Boolean; NewValue: SmallInt; Direction: TUpDownDirection);
|
||||
begin
|
||||
if ReadOnly then Exit;
|
||||
Case Direction of
|
||||
updUp: SpinUpDown(True);
|
||||
updDown: SpinUpDown(False);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomFloatSpinEditEx.UpDownClick(Sender: TObject; {%H-}Button: TUDBtnType);
|
||||
begin
|
||||
BuddyClick;
|
||||
end;
|
||||
|
||||
|
||||
function TCustomFloatSpinEditEx.GetBuddyClassType: TControlClass;
|
||||
begin
|
||||
Result := TUpDown;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
procedure TCustomFloatSpinEditEx.DoEnter;
|
||||
begin
|
||||
inherited DoEnter;
|
||||
FInitialValue := GetValue;
|
||||
end;
|
||||
|
||||
function TCustomFloatSpinEditEx.GetText: TCaption;
|
||||
begin
|
||||
if HandleAllocated then
|
||||
Result := inherited GetText
|
||||
else
|
||||
Result := ValueToStr(FValue);
|
||||
end;
|
||||
|
||||
procedure TCustomFloatSpinEditEx.Reset;
|
||||
begin
|
||||
if IsMasked then
|
||||
inherited Reset
|
||||
else
|
||||
Value := FInitialValue;
|
||||
end;
|
||||
|
||||
procedure TCustomFloatSpinEditEx.EditEditingDone;
|
||||
begin
|
||||
inherited EditEditingDone;
|
||||
GetValue;
|
||||
//debugln(['TCustomFloatSpinEditEx.EditingDone:']);
|
||||
//debugln(Format(' FValue = %.2f, Text = "%s"',[FValue,Text]));
|
||||
UpdateControl;
|
||||
end;
|
||||
|
||||
procedure TCustomFloatSpinEditEx.EditChange;
|
||||
begin
|
||||
//debugln('TCustomFloatSpinEditEx.EditChange');
|
||||
inherited EditChange;
|
||||
end;
|
||||
|
||||
procedure TCustomFloatSpinEditEx.EditKeyDown(var Key: word; Shift: TShiftState);
|
||||
begin
|
||||
inherited EditKeyDown(Key, Shift);
|
||||
if (Key = VK_Escape) and (Shift = []) then
|
||||
begin
|
||||
Key := 0;
|
||||
Reset;
|
||||
end
|
||||
else
|
||||
if FArrowKeys and (Key = VK_UP) and (Shift = []) then
|
||||
begin
|
||||
Key := 0;
|
||||
SpinUpDown(True);
|
||||
end
|
||||
else
|
||||
if FArrowKeys and (Key = VK_Down) and (Shift = []) then
|
||||
begin
|
||||
Key := 0;
|
||||
SpinUpDown(False);
|
||||
end
|
||||
end;
|
||||
|
||||
procedure TCustomFloatSpinEditEx.SetMaxValue(const AValue: Double);
|
||||
begin
|
||||
if FMaxValue = AValue then Exit;
|
||||
FMaxValue := AValue;
|
||||
UpdateControl;
|
||||
end;
|
||||
|
||||
procedure TCustomFloatSpinEditEx.SetMinValue(const AValue: Double);
|
||||
begin
|
||||
if FMinValue = AValue then Exit;
|
||||
FMinValue := AValue;
|
||||
UpdateControl;
|
||||
end;
|
||||
|
||||
|
||||
procedure TCustomFloatSpinEditEx.SetIncrement(const AIncrement: Double);
|
||||
begin
|
||||
if AIncrement = FIncrement then Exit;
|
||||
FIncrement := AIncrement;
|
||||
//UpdateControl;
|
||||
end;
|
||||
|
||||
function TCustomFloatSpinEditEx.TextIsNumber(const S: String; out D: Double): Boolean;
|
||||
begin
|
||||
//DbgOut(['TextIsNumber, S ="',S,'": Result = ']);
|
||||
try
|
||||
Result := TryStrToFloat(S, D, FFS);
|
||||
except
|
||||
Result := False;
|
||||
end;
|
||||
//debugln([Result]);
|
||||
end;
|
||||
|
||||
procedure TCustomFloatSpinEditEx.InitializeWnd;
|
||||
begin
|
||||
inherited InitializeWnd;
|
||||
UpdateControl;
|
||||
end;
|
||||
|
||||
procedure TCustomFloatSpinEditEx.Loaded;
|
||||
begin
|
||||
inherited Loaded;
|
||||
if FUpdatePending then UpdateControl;
|
||||
end;
|
||||
|
||||
procedure TCustomFloatSpinEditEx.EditKeyPress(var Key: char);
|
||||
{Disallow any key that is not a digit, decimalseparator or -
|
||||
For ease of use translate any decimalpoint or comma to DecimalSeparator
|
||||
Tab, BackSpace, Cut, Paste, Copy, Undo of course should be passed onto inherited KeyPress
|
||||
If FDecimals = 0 (as in TSpinEditEx), disallow decimalseparator also
|
||||
}
|
||||
begin
|
||||
inherited EditKeyPress(Key);
|
||||
if (Key in ['.',',']) then Key := FFS.Decimalseparator;
|
||||
if not (Key in ['0'..'9', FFS.DecimalSeparator,'-',#8,#9,^C,^X,^V,^Z]) then Key := #0;
|
||||
if (Key = FFS.DecimalSeparator) and (FDecimals = 0) then Key := #0;
|
||||
if (Key = '-') and IsLimited and (MinValue >= 0) then Key := #0;
|
||||
end;
|
||||
|
||||
|
||||
procedure TCustomFloatSpinEditEx.SetValue(const AValue: Double);
|
||||
var
|
||||
ValueFromText: Extended;
|
||||
begin
|
||||
//debugln(Format('TCustomFloatSpinEditEx.SetValue: AValue = %.2f, FValue=%.2f, Text="%s"',[AValue,fValue,Text]));
|
||||
if (FValue = AValue)
|
||||
//if you set text by code (or paste it) and text is not a valid float, then FValue will hold the previous value
|
||||
//and in that case we should not exit here...
|
||||
and (TryStrToFloat(Text, ValueFromText, FFS) and (ValueFromText = FValue)) then Exit;
|
||||
FSettingValue := True;
|
||||
FValue := AValue;
|
||||
|
||||
FUpdatePending := True;
|
||||
UpdateControl;
|
||||
FSettingValue := False;
|
||||
end;
|
||||
|
||||
function TCustomFloatSpinEditEx.GetValue: Double;
|
||||
begin
|
||||
if HandleAllocated
|
||||
and not (wcfCreatingHandle in FWinControlFlags) then
|
||||
begin
|
||||
FValue := StrToValue(Text);
|
||||
end;
|
||||
Result := FValue;
|
||||
end;
|
||||
|
||||
function TCustomFloatSpinEditEx.IsLimited: Boolean;
|
||||
begin
|
||||
Result := MaxValue > MinValue;
|
||||
end;
|
||||
|
||||
function TCustomFloatSpinEditEx.IsOutOfLimits(AValue: Double): Boolean;
|
||||
begin
|
||||
Result := IsLimited and ((AValue < MinValue) or (AValue > MaxValue));
|
||||
end;
|
||||
|
||||
|
||||
function TCustomFloatSpinEditEx.GetDecimalSeparator: Char;
|
||||
begin
|
||||
Result := FFS.DecimalSeparator;
|
||||
end;
|
||||
|
||||
function TCustomFloatSpinEditEx.GetEdit: TGEEdit;
|
||||
begin
|
||||
Result := BaseEditor;
|
||||
end;
|
||||
|
||||
|
||||
procedure TCustomFloatSpinEditEx.SpinUpDown(Up: Boolean);
|
||||
var
|
||||
OldValue, NewValue: Double;
|
||||
begin
|
||||
if not TextIsNumber(Text, OldValue) then
|
||||
NewValue := MinValue
|
||||
else
|
||||
begin
|
||||
if IsOutOfLimits(OldValue) then
|
||||
NewValue := GetLimitedValue(OldValue)
|
||||
else
|
||||
begin
|
||||
if Up then
|
||||
NewValue := GetLimitedValue(OldValue + Increment)
|
||||
else
|
||||
NewValue := GetLimitedValue(OldValue - Increment)
|
||||
end;
|
||||
end;
|
||||
SetValue(NewValue);
|
||||
end;
|
||||
|
||||
function TCustomFloatSpinEditEx.GetNullValue: Double;
|
||||
begin
|
||||
Result := FNullValue;
|
||||
end;
|
||||
|
||||
function TCustomFloatSpinEditEx.GetUpDown: TUpDown;
|
||||
begin
|
||||
Result := TUpDown(Buddy);
|
||||
end;
|
||||
|
||||
procedure TCustomFloatSpinEditEx.SetNullValue(AValue: Double);
|
||||
begin
|
||||
if (FNullValue = AValue) then Exit;
|
||||
FNullValue := AValue;
|
||||
UpdateControl;
|
||||
end;
|
||||
|
||||
procedure TCustomFloatSpinEditEx.SetDecimals(ADecimals: Integer);
|
||||
begin
|
||||
if FDecimals = ADecimals then Exit;
|
||||
FDecimals := ADecimals;
|
||||
UpdateControl;
|
||||
end;
|
||||
|
||||
constructor TCustomFloatSpinEditEx.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
|
||||
FFS := DefaultFormatSettings;
|
||||
FFS.DecimalSeparator := '.';
|
||||
FArrowKeys := True;
|
||||
FIncrement := 1;
|
||||
FDecimals := 2;
|
||||
FValue := 0;
|
||||
FMinValue := 0;
|
||||
FMaxValue := 100;
|
||||
FUpdatePending := True;
|
||||
FSettingValue := False;
|
||||
FNullValueBehaviour := nvbMinValue;
|
||||
|
||||
Edit.Alignment := taRightJustify;
|
||||
|
||||
{
|
||||
A note regarding the Updown control.
|
||||
It is by design that UpDown is not set to associate with the Edit.
|
||||
Amongst others, it would make it impossible to use with floats,
|
||||
nor have a NullValue.
|
||||
It also does align as it should when associated.
|
||||
}
|
||||
UpDown.OnChangingEx := @UpDownChangingEx;
|
||||
//OnCick signature of TUpDown differs from TControl.OnClick,
|
||||
//Yhe assigning of OnClick in inherited constructor
|
||||
//sets TControl(Buddy).OnClick to fire BuddyClick, and that won't do
|
||||
//since TUpDown does not fire a regular TControl.OnClick event
|
||||
UpDown.OnClick := @UpDownClick;
|
||||
|
||||
with GetControlClassDefaultSize do
|
||||
SetInitialBounds(0, 0, CX, CY);
|
||||
end;
|
||||
|
||||
function TCustomFloatSpinEditEx.GetLimitedValue(const AValue: Double): Double;
|
||||
begin
|
||||
Result := AValue;
|
||||
//Delphi does not constrain when MinValue = MaxValue, and does if MaxValue > MinValue,
|
||||
//but the latter makes absolutely no sense at all.
|
||||
if FMaxValue > FMinValue then
|
||||
begin
|
||||
if Result < FMinValue then Result := FMinValue;
|
||||
if Result > FMaxValue then Result := FMaxValue;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCustomFloatSpinEditEx.ValueToStr(const AValue: Double): String;
|
||||
begin
|
||||
Result := FloatToStrF(GetLimitedValue(AValue), ffFixed, 20, DecimalPlaces, FFS);
|
||||
end;
|
||||
|
||||
function TCustomFloatSpinEditEx.StrToValue(const S: String): Double;
|
||||
var
|
||||
Def, D: Double;
|
||||
begin
|
||||
//debugln(['TCustomFloatSpinEditEx.StrToValue: S="',S,'"']);
|
||||
case FNullValueBehaviour of
|
||||
nvbShowTextHint: Def := FNullValue;
|
||||
nvbLimitedNullValue: Def := GetLimitedValue(FNullValue);
|
||||
nvbMinValue: Def := FMinValue;
|
||||
nvbMaxValue: Def := MaxValue;
|
||||
nvbInitialValue: Def := FInitialValue;
|
||||
end;
|
||||
try
|
||||
if (FNullValueBehaviour = nvbShowTextHint)then
|
||||
begin
|
||||
if TextIsNumber(S, D)
|
||||
then
|
||||
Result := D
|
||||
else
|
||||
Result := Def;
|
||||
end
|
||||
else
|
||||
Result := GetLimitedValue(StrToFloatDef(S, Def, FFS));
|
||||
except
|
||||
Result := Def;
|
||||
end;
|
||||
//debugln([' Result=',(Result)]);
|
||||
end;
|
||||
|
||||
procedure TCustomFloatSpinEditEx.FinalizeWnd;
|
||||
begin
|
||||
GetValue;
|
||||
inherited FinalizeWnd;
|
||||
end;
|
||||
|
||||
{ TCustomSpinEditEx }
|
||||
|
||||
function TCustomSpinEditEx.GetIncrement: integer;
|
||||
begin
|
||||
Result:=round(FIncrement);
|
||||
end;
|
||||
|
||||
function TCustomSpinEditEx.GetMaxValue: integer;
|
||||
begin
|
||||
Result:=round(FMaxValue);
|
||||
end;
|
||||
|
||||
function TCustomSpinEditEx.GetMinValue: integer;
|
||||
begin
|
||||
Result:=round(FMinValue);
|
||||
end;
|
||||
|
||||
function TCustomSpinEditEx.GetNullValue: integer;
|
||||
begin
|
||||
Result:=round(inherited GetNullValue);
|
||||
end;
|
||||
|
||||
function TCustomSpinEditEx.GetValue: integer;
|
||||
begin
|
||||
Result:=round(inherited GetValue);
|
||||
end;
|
||||
|
||||
|
||||
procedure TCustomSpinEditEx.SetIncrement(const AValue: integer);
|
||||
begin
|
||||
if Increment = AValue then exit;
|
||||
inherited SetIncrement(AValue);
|
||||
end;
|
||||
|
||||
procedure TCustomSpinEditEx.SetMaxValue(const AValue: integer);
|
||||
begin
|
||||
if MaxValue=AValue then exit;
|
||||
inherited SetMaxValue(AValue);
|
||||
end;
|
||||
|
||||
procedure TCustomSpinEditEx.SetMinValue(const AValue: integer);
|
||||
begin
|
||||
if MinValue=AValue then exit;
|
||||
inherited SetMinValue(AValue);
|
||||
end;
|
||||
|
||||
procedure TCustomSpinEditEx.SetValue(const AValue: integer);
|
||||
begin
|
||||
if Value=AValue then exit;
|
||||
inherited SetValue(AValue);
|
||||
end;
|
||||
|
||||
function TCustomSpinEditEx.TextIsNumber(const S: String; out D: Double): Boolean;
|
||||
var
|
||||
N: Integer;
|
||||
begin
|
||||
//DbgOut(['TCustomSpinEditEx.TextIsNumber: S = "',S,'" Result = ']);
|
||||
try
|
||||
Result := TryStrToInt(S, N);
|
||||
D := N;
|
||||
except
|
||||
Result := False;
|
||||
end;
|
||||
//debugln([Result]);
|
||||
end;
|
||||
|
||||
procedure TCustomSpinEditEx.SetNullValue(AValue: integer);
|
||||
begin
|
||||
if (GetNullValue = AValue) then Exit;
|
||||
inherited SetNullValue(AValue);
|
||||
end;
|
||||
|
||||
constructor TCustomSpinEditEx.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
NumbersOnly := True;
|
||||
FDecimals := 0;
|
||||
end;
|
366
components/lazcontrols/spinex.pp
Normal file
366
components/lazcontrols/spinex.pp
Normal file
@ -0,0 +1,366 @@
|
||||
{
|
||||
/***************************************************************************
|
||||
SpinEx.pp
|
||||
-----------
|
||||
|
||||
Provides a T(Float)SpinEdit like control that allows to have a NullValue and
|
||||
a text indicating the control does not have a valid Value whenever the
|
||||
control looses focus.
|
||||
|
||||
Initial implementation 2016 by Bart Broersma
|
||||
|
||||
***************************************************************************/
|
||||
|
||||
*****************************************************************************
|
||||
This file is part of the Lazarus Component Library (LCL)
|
||||
|
||||
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
||||
for details about the license.
|
||||
*****************************************************************************
|
||||
}
|
||||
|
||||
{ ----------------------------------------------------------------------------
|
||||
|
||||
++++++++++ Notes for developers ++++++++++
|
||||
|
||||
1. Why yet another (Float)SpinEdit control?
|
||||
(Which problems does it solve?)
|
||||
|
||||
The standard T(Float)SpinEdit does not support a NullValue mechanism.
|
||||
Also, it's impelementation is widgetset dependant. While this provides a
|
||||
control that, on widgetsets that have a native implementation of such a
|
||||
control, has the look and feel as users of this widgetset are acustomed to,
|
||||
the downside is that it's behaviour may also depend on the widgetset.
|
||||
This is especially the case if the text inside the control becomes invalid
|
||||
(empty or otherwise not a number).
|
||||
In such a case, when situation querying the control for it's Value, the results
|
||||
are not cross-platform consistent.
|
||||
|
||||
This difference in behaviour across widgetsets also prevents the implementation
|
||||
of a NullValue, especially the possibility to leave the control empty
|
||||
or display an informative text inside it in such a case.
|
||||
|
||||
Note: unlike T(Float)SpinEdit GetValue is always derived from the actual
|
||||
text in the control.
|
||||
This is by design, and it should not be altered.
|
||||
|
||||
|
||||
2. Why not simply associate a TUpDown with a TEdit instead?
|
||||
|
||||
This has several disadvantages:
|
||||
* It does not allow floating point values
|
||||
* It's range is limited to the range of SmallInt
|
||||
* It does not properly anchor and align
|
||||
|
||||
So, whilst the new implementation of T(Float)SpinEditEx uses a TUpDown
|
||||
control, it does not use it's Associate property.
|
||||
The 2 controls (an edit and an updown) are embedded in a TCustomControl
|
||||
(like TEditButton is) in oreder to have proper align and anchor behaviour.
|
||||
|
||||
---------------------------------------------------------------------------- }
|
||||
|
||||
unit SpinEx;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, Controls, SysUtils, LCLType, LCLProc, ClipBrd, ComCtrls,
|
||||
GroupedEdit;
|
||||
|
||||
type
|
||||
{ TCustomFloatSpinEdit }
|
||||
|
||||
TNullValueBehaviour = (
|
||||
//This applies when the Text in the control is not a number.
|
||||
//If the Text is a number then it will be bound by Min/MaxValue
|
||||
nvbShowTextHint, // Value becomes NullValue, Text becomes empty, TextHint will show when focus is lost
|
||||
nvbLimitedNullValue, // Value becomes GetLimitedValue(NullValue), Text becomes Value
|
||||
nvbMinValue, // Value becomes MinValue, Text becomes Value NOTE: Default, since this is how Delphi seems to work
|
||||
nvbMaxValue, // Value becomes MaxValue, Text becomes Value
|
||||
nvbInitialValue // Value becomes InitialValue (OnEnter), Text becomes Value
|
||||
);
|
||||
|
||||
{ TCustomFloatSpinEditEx }
|
||||
|
||||
TCustomFloatSpinEditEx = class(TCustomAbstractGroupedEdit)
|
||||
private
|
||||
FArrowKeys: Boolean;
|
||||
FIncrement: Double;
|
||||
FDecimals: Integer;
|
||||
FMaxValue: Double;
|
||||
FMinValue: Double;
|
||||
FInitialValue: Double;
|
||||
FNullValue: Double;
|
||||
FNullValueBehaviour: TNullValueBehaviour;
|
||||
//FNullValueText: String;
|
||||
FValue: Double;
|
||||
FUpdatePending: Boolean;
|
||||
FSettingValue: Boolean;
|
||||
//FValueChanged: Boolean;
|
||||
FFS: TFormatSettings;
|
||||
function GetDecimalSeparator: Char;
|
||||
function GetEdit: TGEEdit;
|
||||
procedure SpinUpDown(Up: Boolean);
|
||||
function GetNullValue: Double;
|
||||
function GetUpDown: TUpDown;
|
||||
function GetValue: Double;
|
||||
function IsLimited: Boolean;
|
||||
function IsOutOfLimits(AValue: Double): Boolean;
|
||||
procedure SetDecimalSeparator(AValue: Char);
|
||||
procedure UpdateControl;
|
||||
procedure UpDownChangingEx(Sender: TObject; var {%H-}AllowChange: Boolean;
|
||||
{%H-}NewValue: SmallInt; Direction: TUpDownDirection);
|
||||
procedure UpDownClick(Sender: TObject; {%H-}Button: TUDBtnType);
|
||||
protected
|
||||
function GetBuddyClassType: TControlClass; override;
|
||||
procedure DoEnter; override;
|
||||
function GetText: TCaption; override;
|
||||
procedure Reset; override;
|
||||
procedure EditChange; override;
|
||||
procedure EditKeyDown(var Key: word; Shift: TShiftState); override;
|
||||
procedure EditKeyPress(var Key: char); override;
|
||||
procedure SetDecimals(ADecimals: Integer); virtual;
|
||||
procedure SetValue(const AValue: Double); virtual;
|
||||
procedure SetNullValue(AValue: Double); virtual;
|
||||
procedure SetMaxValue(const AValue: Double); virtual;
|
||||
procedure SetMinValue(const AValue: Double); virtual;
|
||||
procedure SetIncrement(const AIncrement: Double); virtual;
|
||||
function TextIsNumber(const S: String; out D: Double): Boolean; virtual;
|
||||
procedure InitializeWnd; override;
|
||||
procedure FinalizeWnd; override;
|
||||
procedure Loaded; override;
|
||||
|
||||
property ArrowKeys: Boolean read FArrowKeys write FArrowKeys default True;
|
||||
property DecimalSeparator: Char read GetDecimalSeparator write SetDecimalSeparator default '.';
|
||||
property Edit: TGEEdit read GetEdit;
|
||||
property UpDown: TUpDown read GetUpDown;
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
function GetLimitedValue(const AValue: Double): Double; virtual;
|
||||
function ValueToStr(const AValue: Double): String; virtual;
|
||||
function StrToValue(const S: String): Double; virtual;
|
||||
procedure EditEditingDone; override;
|
||||
public
|
||||
property DecimalPlaces: Integer read FDecimals write SetDecimals default 2;
|
||||
property Increment: Double read FIncrement write SetIncrement;
|
||||
property MinValue: Double read FMinValue write SetMinValue;
|
||||
property MaxValue: Double read FMaxValue write SetMaxValue;
|
||||
property NullValue: Double read GetNullValue write SetNullValue;
|
||||
property NullValueBehaviour: TNullValueBehaviour read FNullValueBehaviour write FNullValueBehaviour default nvbMinValue;
|
||||
//property NullValueText: String read FNullValueText write FNullValueText;
|
||||
property Value: Double read GetValue write SetValue;
|
||||
end;
|
||||
|
||||
{ TFloatSpinEdit }
|
||||
|
||||
TFloatSpinEditEx = class(TCustomFloatSpinEditEx)
|
||||
public
|
||||
property AutoSelected;
|
||||
published
|
||||
//From TCustomEdit
|
||||
property AutoSelect;
|
||||
property AutoSizeHeightIsEditHeight;
|
||||
property AutoSize default True;
|
||||
property Action;
|
||||
property Align;
|
||||
property Alignment default taRightJustify;
|
||||
property Anchors;
|
||||
property BiDiMode;
|
||||
property BorderSpacing;
|
||||
property BorderStyle default bsNone;
|
||||
property CharCase;
|
||||
property Color;
|
||||
property Constraints;
|
||||
property Cursor;
|
||||
property DirectInput;
|
||||
property EchoMode;
|
||||
property Enabled;
|
||||
property FocusOnBuddyClick;
|
||||
property Font;
|
||||
property Hint;
|
||||
property Layout;
|
||||
property MaxLength;
|
||||
property NumbersOnly;
|
||||
property ParentBiDiMode;
|
||||
property ParentColor;
|
||||
property ParentFont;
|
||||
property ParentShowHint;
|
||||
//property PasswordChar;
|
||||
property PopupMenu;
|
||||
property ReadOnly;
|
||||
property ShowHint;
|
||||
property TabOrder;
|
||||
property TabStop;
|
||||
//property Text;
|
||||
property TextHint;
|
||||
property TextHintFontColor;
|
||||
property TextHintFontStyle;
|
||||
property Visible;
|
||||
|
||||
property OnChange;
|
||||
property OnClick;
|
||||
property OnDblClick;
|
||||
property OnDragDrop;
|
||||
property OnDragOver;
|
||||
property OnContextPopup;
|
||||
property OnEditingDone;
|
||||
property OnEndDrag;
|
||||
property OnEnter;
|
||||
property OnExit;
|
||||
property OnKeyDown;
|
||||
property OnKeyPress;
|
||||
property OnKeyUp;
|
||||
property OnMouseDown;
|
||||
property OnMouseEnter;
|
||||
property OnMouseLeave;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnMouseWheel;
|
||||
property OnMouseWheelDown;
|
||||
property OnMouseWheelUp;
|
||||
property OnStartDrag;
|
||||
property OnUTF8KeyPress;
|
||||
|
||||
//From TCustomFloatSpinEdit
|
||||
property ArrowKeys;
|
||||
property DecimalSeparator;
|
||||
property DecimalPlaces;
|
||||
property Increment;
|
||||
property MaxValue;
|
||||
property MinValue;
|
||||
property NullValue;
|
||||
property NullValueBehaviour;
|
||||
//property NullValueText;
|
||||
property Spacing;
|
||||
property Value;
|
||||
end;
|
||||
|
||||
|
||||
{ TCustomSpinEdit }
|
||||
|
||||
TCustomSpinEditEx = class(TCustomFloatSpinEditEx)
|
||||
private
|
||||
function GetIncrement: integer;
|
||||
function GetMaxValue: integer;
|
||||
function GetMinValue: integer;
|
||||
function GetNullValue: integer;
|
||||
function GetValue: integer;
|
||||
protected
|
||||
procedure SetMaxValue(const AValue: integer); overload; virtual;
|
||||
procedure SetMinValue(const AValue: integer); overload; virtual;
|
||||
procedure SetIncrement(const AValue: integer); overload; virtual;
|
||||
procedure SetNullValue(AValue: integer); overload; virtual;
|
||||
procedure SetValue(const AValue: integer); overload; virtual;
|
||||
function TextIsNumber(const S: String; out D: Double): Boolean; override;
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
public
|
||||
property Value: integer read GetValue write SetValue default 0;
|
||||
property MinValue: integer read GetMinValue write SetMinValue default 0;
|
||||
property MaxValue: integer read GetMaxValue write SetMaxValue default 100;
|
||||
property NullValue: integer read GetNullValue write SetNullValue;
|
||||
property NullValueBehaviour;
|
||||
//property NullValueText;
|
||||
property Increment: integer read GetIncrement write SetIncrement default 1;
|
||||
end;
|
||||
|
||||
|
||||
{ TSpinEdit }
|
||||
|
||||
TSpinEditEx = class(TCustomSpinEditEx)
|
||||
public
|
||||
property AutoSelected;
|
||||
published
|
||||
//From TCustomEdit
|
||||
property AutoSelect;
|
||||
property AutoSizeHeightIsEditHeight;
|
||||
property AutoSize default True;
|
||||
property Action;
|
||||
property Align;
|
||||
property Alignment default taRightJustify;
|
||||
property Anchors;
|
||||
property BiDiMode;
|
||||
property BorderSpacing;
|
||||
property BorderStyle default bsNone;
|
||||
property CharCase;
|
||||
property Color;
|
||||
property Constraints;
|
||||
property Cursor;
|
||||
property DirectInput;
|
||||
property EchoMode;
|
||||
property Enabled;
|
||||
property FocusOnBuddyClick;
|
||||
property Font;
|
||||
property Hint;
|
||||
property Layout;
|
||||
property MaxLength;
|
||||
property NumbersOnly default True;
|
||||
property ParentBiDiMode;
|
||||
property ParentColor;
|
||||
property ParentFont;
|
||||
property ParentShowHint;
|
||||
//property PasswordChar;
|
||||
property PopupMenu;
|
||||
property ReadOnly;
|
||||
property ShowHint;
|
||||
property TabOrder;
|
||||
property TabStop;
|
||||
//property Text;
|
||||
property TextHint;
|
||||
property TextHintFontColor;
|
||||
property TextHintFontStyle;
|
||||
property Visible;
|
||||
|
||||
property OnChange;
|
||||
property OnClick;
|
||||
property OnDblClick;
|
||||
property OnDragDrop;
|
||||
property OnDragOver;
|
||||
property OnContextPopup;
|
||||
property OnEditingDone;
|
||||
property OnEndDrag;
|
||||
property OnEnter;
|
||||
property OnExit;
|
||||
property OnKeyDown;
|
||||
property OnKeyPress;
|
||||
property OnKeyUp;
|
||||
property OnMouseDown;
|
||||
property OnMouseEnter;
|
||||
property OnMouseLeave;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnMouseWheel;
|
||||
property OnMouseWheelDown;
|
||||
property OnMouseWheelUp;
|
||||
property OnStartDrag;
|
||||
property OnUTF8KeyPress;
|
||||
|
||||
//From TCustomFloatSpinEdit
|
||||
property ArrowKeys;
|
||||
property Increment;
|
||||
property MaxValue;
|
||||
property MinValue;
|
||||
property NullValue;
|
||||
property NullValueBehaviour;
|
||||
//property NullValueText;
|
||||
property Spacing;
|
||||
property Value;
|
||||
end;
|
||||
|
||||
function DbgS(ANvb: TNullValueBehaviour): String; overload;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('LazControls', [TSpinEditEx, TFloatSpinEditEx]);
|
||||
end;
|
||||
|
||||
{$I spinex.inc}
|
||||
|
||||
end.
|
||||
|
@ -27,7 +27,7 @@ uses
|
||||
CustomDrawnControls, CustomDrawnDrawers, LazDeviceApis, LDockTree,
|
||||
LazFreeTypeIntfDrawer, CustomDrawn_WinXP, CustomDrawn_Android, Arrow,
|
||||
EditBtn, ComboEx, DBExtCtrls, CustomDrawn_Mac, CalcForm, LCLTranslator,
|
||||
LazarusPackageIntf;
|
||||
GroupedEdit, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
|
1287
lcl/groupededit.pp
Normal file
1287
lcl/groupededit.pp
Normal file
File diff suppressed because it is too large
Load Diff
@ -27,7 +27,7 @@
|
||||
<License Value="modified LGPL-2
|
||||
"/>
|
||||
<Version Major="1" Minor="7"/>
|
||||
<Files Count="285">
|
||||
<Files Count="286">
|
||||
<Item1>
|
||||
<Filename Value="checklst.pas"/>
|
||||
<UnitName Value="CheckLst"/>
|
||||
@ -1172,6 +1172,10 @@
|
||||
<Filename Value="include/clipbrd_html.inc"/>
|
||||
<Type Value="Include"/>
|
||||
</Item285>
|
||||
<Item286>
|
||||
<Filename Value="groupededit.pp"/>
|
||||
<UnitName Value="GroupedEdit"/>
|
||||
</Item286>
|
||||
</Files>
|
||||
<LazDoc Paths="../docs/xml/lcl"/>
|
||||
<i18n>
|
||||
|
Loading…
Reference in New Issue
Block a user