ExCtrls: Initial commit of new component TFloatSISpinEditEx, donated by bart.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7607 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-08-16 22:56:26 +00:00
parent f48d460f8f
commit b011df6850
3 changed files with 186 additions and 9 deletions

View File

@ -14,7 +14,7 @@
</SearchPaths>
</CompilerOptions>
<Description Value="Extended standard controls:
- CurrencyEdit
- CurrencyEdit, FloatSIEdit (supports SI units suffixes)
- TRadioButton, TCheckbox, TRadioGroup and TCheckGroup: drawn by ThemeServices/Canvas, not by widgetset, button/text layout, wordwrap, user-provided check images"/>
<License Value="LGPL with linking exception (like Lazarus LCL)."/>
<Files Count="4">
@ -24,7 +24,7 @@
</Item1>
<Item2>
<Filename Value="source\exeditctrls.pas"/>
<UnitName Value="exeditctrls"/>
<UnitName Value="ExEditCtrls"/>
</Item2>
<Item3>
<Filename Value="source\exctrlsreg.pas"/>
@ -33,9 +33,10 @@
</Item3>
<Item4>
<Filename Value="source\exbuttons.pas"/>
<UnitName Value="exbuttons"/>
<UnitName Value="ExButtons"/>
</Item4>
</Files>
<CompatibilityMode Value="True"/>
<RequiredPkgs Count="2">
<Item1>
<PackageName Value="LazControls"/>

View File

@ -19,10 +19,8 @@ uses
procedure Register;
begin
RegisterComponents('ExCtrls', [
TButtonEx, TCheckboxEx, TRadioButtonEx, TCheckGroupEx, TRadioGroupEx
]);
RegisterComponents('LazControls', [
TCurrSpinEditEx
TButtonEx, TCheckboxEx, TRadioButtonEx, TCheckGroupEx, TRadioGroupEx,
TFloatSISpinEditEx, TCurrSpinEditEx
]);
end;

View File

@ -1,13 +1,14 @@
unit ExEditCtrls;
{$mode objfpc}{$H+}
{$codepage utf8} //because of the µ-sign
{.$define debug_editctrls}
interface
uses
Classes, SysUtils, Controls, SpinEx;
Classes, SysUtils, LCLVersion, Controls, SpinEx, Math;
type
{ TCustomCurrEditEx }
@ -167,10 +168,102 @@ type
property Value;
end;
{ TCustomFloatSISpinEdit (Author: Bart Broersma) }
TSIPrefix = (Yotta,Zetta,Exa,Peta,Tera,Giga,Mega,Kilo,mili,micro,microalt,nano,pico,femto,atto,zepto,yocto);
TCustomFloatSISpinEditEx = class(TCustomFloatSpinEditEx)
private
function EndsWithSIPrefix(var S: String; out APrefix: TSIPrefix): Boolean;
protected
procedure EditKeyPress(var Key: char); override;
function TextIsNumber(const S: String; out ANumber: Double): Boolean; override;
public
function ValueToStr(const AValue: Double): String; override;
end;
TFloatSISpinEditEx = class(TCustomFloatSISpinEditEx)
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 PopupMenu;
property ReadOnly;
property ShowHint;
property TabOrder;
property TabStop;
property TextHint;
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 TCustomFloatSpinEditEx
property ArrowKeys;
property DecimalSeparator;
property DecimalPlaces;
property Increment;
property MaxValue;
property MinValue;
property MinRepeatValue;
property NullValue;
property NullValueBehaviour;
property Spacing;
property UpDownVisible;
property Value;
end;
implementation
uses
LCLProc;
LCLProc, LazUTF8;
resourcestring
RsDecSepMustNotMatchThSep = 'Decimal and thousand separators most not be equal.';
@ -179,6 +272,24 @@ const
Digits = ['0'..'9'];
AllowedControlChars = [#8, #9, ^C, ^X, ^V, ^Z];
SIPrefixes: array[TSIPrefix] of String = ('Y', 'Z','E','P','T','G','M','k','m','µ','mc','n','p','f','a','z','y');
SIFactors: array[TSIPrefix] of Double = (1E+24, 1E+21, 1E+18, 1E+15, 1E+12, 1E+9, 1E+6, 1E+3,
1E-3,1E-6,1E-6,1E-9,1E-12,1E-15,1E-18,1E-21,1E-24);
function UTF8EndsStr(const ASubStr, AStr: string): Boolean;
var
TextLen, SubTextLen: PtrInt;
begin
Result := False;
if (ASubStr <> '') then
begin
TextLen := Utf8Length(AStr);
SubTextLen := Utf8Length(ASubStr);
if (TextLen >= SubTextLen) then
Result := Utf8Copy(AStr,TextLen-SubTextLen+1,SubTextLen) = ASubStr;
end;
end;
{ TCustomCurrSpinEditEx }
constructor TCustomCurrSpinEditEx.Create(AOwner: TComponent);
@ -400,5 +511,72 @@ begin
end;
{ TCustomFloatSISpinEditEx }
function TCustomFloatSISpinEditEx.EndsWithSIPrefix(var S: String; out APrefix: TSIPrefix): Boolean;
var
PrefixStr: String;
begin
Result := False;
for APrefix in TSIPrefix do
begin
PrefixStr := SIPrefixes[APrefix];
if UTF8EndsStr(PrefixStr, S) then
begin
System.Delete(S, Length(S)-Length(PrefixStr)+1, Length(PrefixStr));
Exit(True);
end;
end;
end;
procedure TCustomFloatSISpinEditEx.EditKeyPress(var Key: char);
begin
//allow anything for the moment
end;
function TCustomFloatSISpinEditEx.TextIsNumber(const S: String; out ANumber: Double): Boolean;
var
ValueStr: String;
Factor: Double;
APrefix: TSIPrefix;
begin
ValueStr := S;
Factor := 1.0;
if not EndsWithSIPrefix(ValueStr, APrefix) then
Exit(inherited TextIsNumber(S, ANumber));
Factor := SIFactors[APrefix];
Result := inherited TextIsNumber(ValueStr, ANumber);
if Result then
ANumber := Factor * ANumber;
end;
function TCustomFloatSISpinEditEx.ValueToStr(const AValue: Double): String;
var
Prefix: TSIPrefix;
LValue, Factor: Double;
{$IF LCL_FullVersion >= 2010000}
fs: TFormatSettings;
{$IFEND}
begin
LValue := GetLimitedValue(AValue);
for Prefix := Low(SIFactors) to High(SIFactors) do
begin
Factor := SIFactors[Prefix];
if (AValue >= Factor) then
begin
{$IF LCL_FullVersion >= 2010000}
fs := DefaultFormatSettings;
fs.DecimalSeparator := DecimalSeparator;
//fs.ThousandSeparator := ThousandSeparator;
{$ELSE}
fs := GetFormatSettings;
{$IFEND}
//since Ord(micro) < Ord(micoralt) this will alway render with a decent mu ('µ') and not with 'mc'
Result := FloatToStrF(LValue/Factor, ffFixed, 20, DecimalPlaces, fs) + SIPrefixes[Prefix];
Exit;
end;
end;
end;
end.