From b011df6850ff1eb22d140f363ae7ccab73665589 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sun, 16 Aug 2020 22:56:26 +0000 Subject: [PATCH] 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 --- components/exctrls/exctrlspkg.lpk | 7 +- components/exctrls/source/exctrlsreg.pas | 6 +- components/exctrls/source/exeditctrls.pas | 182 +++++++++++++++++++++- 3 files changed, 186 insertions(+), 9 deletions(-) diff --git a/components/exctrls/exctrlspkg.lpk b/components/exctrls/exctrlspkg.lpk index 6e1c8b27f..93dbdd1b7 100644 --- a/components/exctrls/exctrlspkg.lpk +++ b/components/exctrls/exctrlspkg.lpk @@ -14,7 +14,7 @@ @@ -24,7 +24,7 @@ - + @@ -33,9 +33,10 @@ - + + diff --git a/components/exctrls/source/exctrlsreg.pas b/components/exctrls/source/exctrlsreg.pas index 521990af1..7677337aa 100644 --- a/components/exctrls/source/exctrlsreg.pas +++ b/components/exctrls/source/exctrlsreg.pas @@ -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; diff --git a/components/exctrls/source/exeditctrls.pas b/components/exctrls/source/exeditctrls.pas index cc59d48e9..9eb483d74 100644 --- a/components/exctrls/source/exeditctrls.pas +++ b/components/exctrls/source/exeditctrls.pas @@ -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.