You've already forked lazarus-ccr
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:
@ -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"/>
|
||||
|
@ -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;
|
||||
|
||||
|
@ -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.
|
||||
|
||||
|
Reference in New Issue
Block a user