jvcl: Add TJvCalcEdit and TJvDBCalcEdit (issue #34013, patch by Michal Gawrycki)

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6562 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/jvcllaz/design/JvDB/JvDBReg.pas

@@ -16,7 +16,7 @@ implementation
 
 uses
   Classes, JvDsgnConsts, //JvDBSearchCombobox,
-  JvDBSearchEdit, JvDBTreeView, JvDBHTLabel;
+  JvDBSearchEdit, JvDBTreeView, JvDBControls, JvDBHTLabel;
 
 procedure Register;
 const
@@ -38,10 +38,11 @@ const
 
 begin
   RegisterComponents(RsPaletteJvclDB, [     // was: TsPaletteDBVisual
+    TJvDBCalcEdit,
     TJvDBSearchEdit,
 //    TJvDBSearchCombobox,
     TJvDBTreeView,
-    TJvDBHtLabel
+    TJvDBHTLabel
   ]);
                 
   RegisterPropertyEditor(TypeInfo(string), TJvDBTreeView, cItemField, TFieldProperty); //TJvDataFieldProperty);

components/jvcllaz/design/JvDB/images/images.txt

@@ -1,3 +1,4 @@
+tjvdbcalcedit.bmp
 tjvdbhtlabel.bmp
 tjvdbsearchcombobox.bmp
 tjvdbsearchedit.bmp

components/jvcllaz/design/JvStdCtrls/JvStdCtrlsReg.pas

@@ -11,13 +11,15 @@ procedure Register;
 
 implementation
 
+{$R ../../resource/jvstdctrlsreg.res}
+
 uses
-  Classes, JvDsgnConsts, JvButton,
+  Classes, Controls, JvDsgnConsts, JvButton, JvBaseEdits;
-  Controls;
 
 procedure Register;
 begin
   //RegisterComponents(RsPaletteButton, [TJvButton]);
+  RegisterComponents(RsPaletteJvcl, [TJvCalcEdit]);
 end;
 
 end.

components/jvcllaz/design/JvStdCtrls/images/images.txt

@@ -0,0 +1 @@
+tjvcalcedit.bmp

components/jvcllaz/design/JvStdCtrls/images/make_res.bat

@@ -0,0 +1 @@
+lazres ../../../resource/jvstdctrlsreg.res @images.txt

components/jvcllaz/packages/JvCtrlsLazD.lpk

@@ -15,10 +15,10 @@
       </SearchPaths>
     </CompilerOptions>
     <Description Value="Controls of the JVCL library (https://sourceforge.net/projects/jvcl/) (designtime code):
-- Buttons
+- Movable bevel and panel
+- Ruler
 - Hypertext components 
-- Labels
+"/>
-- Listboxes, Comboboxes, TreeViews"/>
     <License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
     <Version Major="1" Release="4"/>
     <Files Count="3">

components/jvcllaz/packages/JvCtrlsLazR.lpk

@@ -13,10 +13,10 @@
       </SearchPaths>
     </CompilerOptions>
     <Description Value="Controls of the JVCL library (https://sourceforge.net/projects/jvcl/) (runtime code):
-- Buttons
+- Movable bevel and panel
+- Ruler
 - Hypertext components 
-- Labels
+"/>
-- Listboxes, Comboboxes, TreeViews"/>
     <License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
     <Version Major="1" Release="4"/>
     <Files Count="4">

components/jvcllaz/packages/JvDBLazD.lpk

@@ -14,8 +14,10 @@
       </SearchPaths>
     </CompilerOptions>
     <Description Value="Database controls of the JVCL library (https://sourceforge.net/projects/jvcl/) (designtime code):
-- Search edit
+- Search edit, Calc edit
-- Hypertext components "/>
+- DB treeview
+- Hypertext components 
+"/>
     <License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
     <Version Major="1" Release="4"/>
     <Files Count="1">
@@ -25,19 +27,22 @@
         <UnitName Value="JvDBReg"/>
       </Item1>
     </Files>
-    <RequiredPkgs Count="4">
+    <RequiredPkgs Count="5">
       <Item1>
-        <PackageName Value="IDEIntf"/>
+        <PackageName Value="JvStdCtrlsLazR"/>
       </Item1>
       <Item2>
-        <PackageName Value="JvCoreLazD"/>
+        <PackageName Value="IDEIntf"/>
       </Item2>
       <Item3>
-        <PackageName Value="JvDBLazR"/>
+        <PackageName Value="JvCoreLazD"/>
       </Item3>
       <Item4>
-        <PackageName Value="FCL"/>
+        <PackageName Value="JvDBLazR"/>
       </Item4>
+      <Item5>
+        <PackageName Value="FCL"/>
+      </Item5>
     </RequiredPkgs>
     <UsageOptions>
       <UnitPath Value="$(PkgOutDir)"/>

components/jvcllaz/packages/JvDBLazR.lpk

@@ -13,11 +13,13 @@
       </SearchPaths>
     </CompilerOptions>
     <Description Value="Database controls of the JVCL library (https://sourceforge.net/projects/jvcl/) (runtime code):
-- Search edit
+- Search edit, Calc edit
-- Hypertext components "/>
+- DB treeview
+- Hypertext components 
+"/>
     <License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
     <Version Major="1" Release="4"/>
-    <Files Count="3">
+    <Files Count="4">
       <Item1>
         <Filename Value="..\run\JvDB\JvDBHTLabel.pas"/>
         <UnitName Value="JvDBHTLabel"/>
@@ -30,17 +32,24 @@
         <Filename Value="..\run\JvDB\JvDBTreeView.pas"/>
         <UnitName Value="JvDBTreeView"/>
       </Item3>
+      <Item4>
+        <Filename Value="..\run\JvDB\JvDBControls.pas"/>
+        <UnitName Value="JvDBControls"/>
+      </Item4>
     </Files>
-    <RequiredPkgs Count="3">
+    <RequiredPkgs Count="4">
       <Item1>
-        <PackageName Value="JvCtrlsLazR"/>
+        <PackageName Value="JvStdCtrlsLazR"/>
       </Item1>
       <Item2>
-        <PackageName Value="JvCoreLazR"/>
+        <PackageName Value="JvCtrlsLazR"/>
       </Item2>
       <Item3>
-        <PackageName Value="FCL"/>
+        <PackageName Value="JvCoreLazR"/>
       </Item3>
+      <Item4>
+        <PackageName Value="FCL"/>
+      </Item4>
     </RequiredPkgs>
     <UsageOptions>
       <UnitPath Value="$(PkgOutDir)"/>

components/jvcllaz/packages/JvStdCtrlsLazD.lpk

@@ -13,7 +13,8 @@
         <UnitOutputDirectory Value="..\lib\$(TargetCPU)-$(TargetOS)\design\JvStdCtrls"/>
       </SearchPaths>
     </CompilerOptions>
-    <Description Value="Standard controls of the JVCL library (https://sourceforge.net/projects/jvcl/) (designtime code)"/>
+    <Description Value="Standard controls of the JVCL library (https://sourceforge.net/projects/jvcl/) (designtime code)
+- CalcEdit"/>
     <License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
     <Version Major="1" Release="4"/>
     <Files Count="1">

components/jvcllaz/packages/JvStdCtrlsLazR.lpk

@@ -13,17 +13,19 @@
       </SearchPaths>
     </CompilerOptions>
     <Description Value="Standard controls of the JVCL library (https://sourceforge.net/projects/jvcl/) (runtime code):
-- Buttons
+- CalcEdit
-- Hypertext components 
+"/>
-- Labels
-- Listboxes, Comboboxes, TreeViews"/>
     <License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
     <Version Major="1" Release="4"/>
-    <Files Count="1">
+    <Files Count="2">
       <Item1>
         <Filename Value="..\run\JvStdCtrls\JvButton.pas"/>
         <UnitName Value="JvButton"/>
       </Item1>
+      <Item2>
+        <Filename Value="..\run\JvStdCtrls\JvBaseEdits.pas"/>
+        <UnitName Value="JvBaseEdits"/>
+      </Item2>
     </Files>
     <RequiredPkgs Count="2">
       <Item1>

components/jvcllaz/run/JvCore/JvJCLUtils.pas

@@ -546,13 +546,18 @@ function OemToAnsiStr(const OemStr: string): string;
 function IsEmptyStr(const S: string; const EmptyChars: TSysCharSet): Boolean;
 { EmptyStr returns True if the given string contains only character
   from the EmptyChars. }
+***************** NOT CONVERTED *)
+
 function ReplaceStr(const S, Srch, Replace: string): string;
 { Returns string with every occurrence of Srch string replaced with
   Replace string. }
 function DelSpace(const S: string): string;
 { DelSpace return a string with all white spaces removed. }
+
 function DelChars(const S: string; Chr: Char): string;
 { DelChars return a string with all Chr characters removed. }
+
+(*************** NOT CONVERTED ***********
 function DelBSpace(const S: string): string;
 { DelBSpace trims leading spaces from the given string. }
 function DelESpace(const S: string): string;
@@ -1034,12 +1039,13 @@ procedure CopyRectDIBits(ACanvas: TCanvas; const DestRect: TRect;
   ABitmap: TBitmap; const SourceRect: TRect);
 {$ENDIF !CLR}
 function IsTrueType(const FontName: string): Boolean;
-
+************************ NOT CONVERTED *)
 
 // Removes all non-numeric characters from AValue and returns
 // the resulting string
 function TextToValText(const AValue: string): string;
 
+(******************** NOT CONVERTED
 // VisualCLX compatibility functions
 function DrawText(DC: HDC; const Text: TCaption; Len: Integer; var R: TRect; WinFlags: Integer): Integer; overload;
 ******************** NOT CONVERTED *)
@@ -5606,6 +5612,7 @@ begin
   end;
   Result := True;
 end;
+************************ NOT CONVERTED *)
 
 function ReplaceStr(const S, Srch, Replace: string): string;
 var
@@ -5633,16 +5640,28 @@ end;
 
 function DelChars(const S: string; Chr: Char): string;
 var
-  I: Integer;
+  I, J: Integer;
 begin
   Result := S;
+  J := 0;
+  for I := 1 to Length(S) do
+  begin
+    if S[I] <> Chr then begin
+      inc(J);
+      Result[J] := S[I];
+    end;
+  end;
+  SetLength(Result, J);
+{
   for I := Length(Result) downto 1 do
   begin
     if Result[I] = Chr then
       Delete(Result, I, 1);
   end;
+  }
 end;
 
+(*************************** NOT CONVERTED
 function DelBSpace(const S: string): string;
 var
   I, L: Integer;
@@ -9199,31 +9218,31 @@ begin
     Canvas.Free;
   end;
 end;
-
+******************** NOT CONVERTED *)
-
 
 function TextToValText(const AValue: string): string;
 var
   I, J: Integer;
+  fs: TFormatSettings absolute DefaultFormatSettings;  // less typing...
 begin
-  Result := DelRSpace(AValue);
+//  Result := DelRSpace(AValue);
-  if DecimalSeparator <> ThousandSeparator then
+  Result := Trim(AValue);
-    Result := DelChars(Result, ThousandSeparator{$IFDEF CLR}[1]{$ENDIF});
+  if fs.DecimalSeparator <> fs.ThousandSeparator then
+    Result := DelChars(Result, fs.ThousandSeparator);
 
-  if (DecimalSeparator <> '.') and (ThousandSeparator <> '.') then
+  if (fs.DecimalSeparator <> '.') and (fs.ThousandSeparator <> '.') then
-    Result := ReplaceStr(Result, '.', DecimalSeparator);
+    Result := ReplaceStr(Result, '.', fs.DecimalSeparator);
-  if (DecimalSeparator <> ',') and (ThousandSeparator <> ',') then
+  if (fs.DecimalSeparator <> ',') and (fs.ThousandSeparator <> ',') then
-    Result := ReplaceStr(Result, ',', DecimalSeparator);
+    Result := ReplaceStr(Result, ',', fs.DecimalSeparator);
 
-  J := 1;
+  J := 0;
   for I := 1 to Length(Result) do
-    if Result[I] in ['0'..'9', '-', '+',
+    if Result[I] in ['0'..'9', '-', '+', fs.DecimalSeparator, fs.ThousandSeparator] then
-        AnsiChar(DecimalSeparator{$IFDEF CLR}[1]{$ENDIF}), AnsiChar(ThousandSeparator{$IFDEF CLR}[1]{$ENDIF})] then
     begin
-      Result[J] := Result[I];
       Inc(J);
+      Result[J] := Result[I];
     end;
-  SetLength(Result, J - 1);
+  SetLength(Result, J);
 
   if Result = '' then
     Result := '0'
@@ -9232,8 +9251,6 @@ begin
     Result := '-0';
 end;
 
-******************** NOT CONVERTED *)
-
 function DrawText(Canvas: TCanvas; const Text: string; Len: Integer; var R: TRect; WinFlags: Integer): Integer; overload;
 begin
   Result := DrawText(Canvas, PChar(Text), Len, R, WinFlags and not DT_MODIFYSTRING);

components/jvcllaz/run/JvCtrls/JvHtControls.pas

@@ -1059,3 +1059,16 @@ end;
 
 
 end.
+
+[Window Title]
+Ambiguous unit found
+
+[Content]
+The unit JvDBHTLabel exists twice in the unit path of the IDE:
+
+1. "D:\Prog_Lazarus\svn\lazarus-ccr\components\jvcllaz\lib\i386-win32\run\JvDB\JvDBHTLabel.ppu"
+2. "D:\Prog_Lazarus\svn\lazarus-ccr\components\jvcllaz\lib\i386-win32\design\JvDB\JvDBHTLabel.ppu"
+
+Hint: Check if two packages contain a unit with the same name.
+
+[Ignore] [Ignore all] [Abort]

components/jvcllaz/run/JvDB/JvDBControls.pas

@@ -0,0 +1,597 @@
+{-----------------------------------------------------------------------------
+The contents of this file are subject to the Mozilla Public License
+Version 1.1 (the "License"); you may not use this file except in compliance
+with the License. You may obtain a copy of the License at
+http://www.mozilla.org/MPL/MPL-1.1.html
+
+Software distributed under the License is distributed on an "AS IS" basis,
+WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
+the specific language governing rights and limitations under the License.
+
+The Original Code is: JvDBCtrl.PAS, released on 2002-07-04.
+
+The Initial Developers of the Original Code are: Fedor Koshevnikov, Igor Pavluk and Serge Korolev
+Copyright (c) 1997, 1998 Fedor Koshevnikov, Igor Pavluk and Serge Korolev
+Copyright (c) 2001,2002 SGB Software
+All Rights Reserved.
+
+Contributor(s):
+  Polaris Software
+
+  Lazarus port: Michal Gawrycki
+
+You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
+located at http://jvcl.delphi-jedi.org
+
+Known Issues:
+
+    === NEW IN JVCL 3.0 ==
+        TJvDBMaskEdit is a new control, added by Warren Postma.
+
+    Major Issues:
+        EditMask property enables operation as masked edit, which doesn't
+        work properly in a Control Grid, yet, if you set the EditMask.
+        You can use it as a generic editor control inside a control grid.
+          -- Warren Postma (warrenpstma att hotmail dott com)
+-----------------------------------------------------------------------------}
+// $Id$
+
+unit JvDBControls;
+
+interface
+
+uses
+  JvBaseEdits, DB, DBCtrls, Classes, LMessages, GroupedEdit;
+
+type
+
+  { TJvDBEbEdit }
+
+  TJvDBEbEdit = class(TJvEbEdit)
+    procedure WMCut(var Msg: TLMessage); message LM_CUT;
+    procedure WMPaste(var Msg: TLMessage); message LM_PASTE;
+  end;
+
+  { TJvDBCalcEdit }
+
+  TJvDBCalcEdit = class(TJvCalcEdit)
+  private
+    FDataLink: TFieldDataLink;
+    FDefaultParams: Boolean;
+    //Polaris
+    FLEmptyIsNull: Boolean;
+    FEmptyIsNull: Boolean;
+    procedure SetEmptyIsNull(AValue: Boolean);
+    function GetZeroEmpty: Boolean;
+    procedure SetZeroEmpty(AValue: Boolean);
+    function StoreEmptyIsNull: Boolean;
+    //Polaris
+    procedure DataChange(Sender: TObject);
+    procedure EditingChange(Sender: TObject);
+    function GetDataField: string;
+    function GetDataSource: TDataSource;
+    function GetField: TField;
+    procedure SetDataField(const AValue: string);
+    procedure SetDataSource(AValue: TDataSource);
+    procedure SetDefaultParams(AValue: Boolean);
+    procedure UpdateFieldData(Sender: TObject);
+    procedure CMGetDataLink(var Msg: TLMessage); message CM_GETDATALINK;
+    function GetReadOnly: Boolean; reintroduce;
+    procedure SetReadOnly(AValue: Boolean); reintroduce;
+  protected
+    function GetEditorClassType: TGEEditClass; override;
+    procedure AcceptValue(AValue: Double); override;
+    procedure DoExit; override;
+    function GetDisplayText: string; override;
+    procedure EditChange; override;
+    procedure SetText(const AValue: string); override;
+
+    procedure DataChanged; override; //Polaris
+
+    function EditCanModify: Boolean; override;
+    function IsValidChar(Key: Char): Boolean; override;
+    procedure EditKeyDown(var Key: Word; Shift: TShiftState); override;
+    procedure EditKeyPress(var Key: Char); override;
+    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+    procedure Reset; override;
+    //Polaris
+    procedure Loaded; override;
+    //Polaris
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure UpdateFieldParams;
+    function ExecuteAction(AAction: TBasicAction): Boolean; override;
+    function UpdateAction(AAction: TBasicAction): Boolean; override;
+    property Field: TField read GetField;
+    property Value;
+  published
+    property Align;
+    property DecimalPlaceRound;
+
+    property Action;
+    property AutoSize;
+    property DataField: string read GetDataField write SetDataField;
+    property DataSource: TDataSource read GetDataSource write SetDataSource;
+    property DefaultParams: Boolean read FDefaultParams write SetDefaultParams default False;
+    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
+    property Alignment;
+    property AutoSelect;
+    property BorderStyle;
+    property ButtonHint;
+    property CheckOnExit;
+    property Color;
+    property DecimalPlaces;
+    property DirectInput;
+    property DisplayFormat;
+    property DragCursor;
+    property DragMode;
+    property Enabled;
+    property Font;
+    property FormatOnEditing;
+    property ImageIndex;
+    property Images;
+    property ButtonWidth;
+    property HideSelection;
+    property Anchors;
+    property BiDiMode;
+    property Constraints;
+    property DragKind;
+    property ParentBiDiMode;
+    property MaxLength;
+    property MaxValue;
+    property MinValue;
+    property ParentColor;
+    property ParentFont;
+    property ParentShowHint;
+    property PopupMenu;
+    property ShowHint;
+    property TabOrder;
+    property TabStop;
+    property Visible;
+    //Polaris
+    property EmptyIsNull: Boolean read FEmptyIsNull write SetEmptyIsNull stored StoreEmptyIsNull;
+    property ZeroEmpty: Boolean read GetZeroEmpty write SetZeroEmpty default True;
+    //Polaris
+    property OnButtonClick;
+    property OnChange;
+    property OnClick;
+    property OnDblClick;
+    property OnDragDrop;
+    property OnDragOver;
+    property OnEndDrag;
+    property OnEnter;
+    property OnExit;
+    property OnKeyDown;
+    property OnKeyPress;
+    property OnKeyUp;
+    property OnMouseDown;
+    property OnMouseMove;
+    property OnMouseUp;
+    property OnStartDrag;
+    property OnContextPopup;
+    property OnEndDock;
+    property OnStartDock;
+  end;
+
+implementation
+
+uses
+  SysUtils, LCLType, JvConsts, JvJCLUtils, Math, FmtBCD, Variants;
+
+function IsNullOrEmptyStringField(Field: TField): Boolean;
+begin
+  Result := Field.IsNull or ((Field is TStringField) and (Trim(Field.AsString) = ''));
+end;
+
+{ TJvDBEbEdit }
+
+procedure TJvDBEbEdit.WMCut(var Msg: TLMessage);
+begin
+  if Owner is TJvDBCalcEdit then
+    with Owner as TJvDBCalcEdit do
+      FDataLink.Edit;
+  inherited;
+end;
+
+procedure TJvDBEbEdit.WMPaste(var Msg: TLMessage);
+begin
+  if Owner is TJvDBCalcEdit then
+    with Owner as TJvDBCalcEdit do
+      FDataLink.Edit;
+  inherited;
+end;
+
+//=== { TJvDBCalcEdit } ======================================================
+
+constructor TJvDBCalcEdit.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  //Polaris
+  FEmptyIsNull := ZeroEmpty;
+  FLEmptyIsNull := True;
+  //Polaris
+  FDataLink := TFieldDataLink.Create;
+  FDataLink.Control := Self;
+  FDataLink.OnDataChange := @DataChange;
+  FDataLink.OnEditingChange := @EditingChange;
+  FDataLink.OnUpdateData := @UpdateFieldData;
+  inherited ReadOnly := True;
+end;
+
+destructor TJvDBCalcEdit.Destroy;
+begin
+  FDataLink.Free;
+  FDataLink := nil;
+  inherited Destroy;
+end;
+
+procedure TJvDBCalcEdit.Loaded;
+begin
+  inherited Loaded;
+  FLEmptyIsNull := True;
+end;
+
+procedure TJvDBCalcEdit.SetEmptyIsNull(AValue: Boolean);
+begin
+  if AValue <> FEmptyIsNull then
+  begin
+    FEmptyIsNull := AValue;
+    if csLoading in ComponentState then
+      FLEmptyIsNull := False;
+  end;
+end;
+
+function TJvDBCalcEdit.GetZeroEmpty: Boolean;
+begin
+  Result := inherited ZeroEmpty;
+end;
+
+procedure TJvDBCalcEdit.SetZeroEmpty(AValue: Boolean);
+begin
+  inherited ZeroEmpty := AValue;
+  if FLEmptyIsNull then
+    SetEmptyIsNull(ZeroEmpty)
+end;
+
+function TJvDBCalcEdit.StoreEmptyIsNull: Boolean;
+begin
+  Result := FEmptyIsNull <> ZeroEmpty;
+end;
+
+//Polaris
+
+procedure TJvDBCalcEdit.Notification(AComponent: TComponent;
+  Operation: TOperation);
+begin
+  inherited Notification(AComponent, Operation);
+  if (Operation = opRemove) and (FDataLink <> nil) and
+    (AComponent = DataSource) then
+    DataSource := nil;
+end;
+
+procedure TJvDBCalcEdit.EditKeyDown(var Key: Word; Shift: TShiftState);
+begin
+  inherited KeyDown(Key, Shift);
+  if not ReadOnly and
+    ((Key = VK_DELETE) and (Shift * KeyboardShiftStates = [])) or
+    ((Key = VK_INSERT) and (Shift * KeyboardShiftStates = [ssShift])) then
+    FDataLink.Edit;
+end;
+
+procedure TJvDBCalcEdit.EditKeyPress(var Key: Char);
+begin
+  inherited EditKeyPress(Key);
+  case Key of
+    CtrlH, CtrlV, CtrlX, #32..High(Char):
+        FDataLink.Edit;
+    Cr: if FDataLink.CanModify then
+      FDataLink.UpdateRecord;
+    Esc:
+      begin
+        FDataLink.Reset;
+        SelectAll;
+        Key := #0;
+      end;
+  end;
+end;
+
+function TJvDBCalcEdit.IsValidChar(Key: Char): Boolean;
+begin
+  Result := inherited IsValidChar(Key);
+  if Result and (FDataLink.Field <> nil) then
+    Result := FDataLink.Field.IsValidChar(Key);
+end;
+
+function TJvDBCalcEdit.EditCanModify: Boolean;
+begin
+  Result := FDataLink.Edit;
+end;
+
+function TJvDBCalcEdit.GetDisplayText: string;
+begin
+  if FDataLink.Field = nil then
+  begin
+    if csDesigning in ComponentState then
+      Result := Format('(%s)', [Name])
+    else
+      Result := '';
+  end
+  else
+  //Polaris Result := inherited GetDisplayText;
+  if FDataLink.Field.IsNull then
+    Result := ''
+  else
+    Result := inherited GetDisplayText;
+  //Polaris
+end;
+
+procedure TJvDBCalcEdit.Reset;
+begin
+  FDataLink.Reset;
+  inherited Reset;
+end;
+
+procedure TJvDBCalcEdit.EditChange;
+begin
+  if not Formatting then
+    FDataLink.Modified;
+  inherited EditChange;
+end;
+
+procedure TJvDBCalcEdit.SetText(const AValue: string);
+begin
+  if not ReadOnly then
+    inherited SetText(AValue);
+end;
+
+//Polaris
+procedure TJvDBCalcEdit.DataChanged;
+begin
+  inherited;
+  if Assigned(FDataLink) and Assigned(FDataLink.Field) {and DecimalPlaceRound} then
+  begin
+    EditText := DisplayText;
+    try
+      if EditText <> '' then
+        if (StrToFloat(TextToValText(EditText)) = 0) and ZeroEmpty then
+          EditText := '';
+    except
+    end;
+  end;
+end;
+//Polaris
+
+function TJvDBCalcEdit.GetDataSource: TDataSource;
+begin
+  Result := FDataLink.DataSource;
+end;
+
+procedure TJvDBCalcEdit.SetDataSource(AValue: TDataSource);
+begin
+  if FDataLink.DataSource <> AValue then
+  begin
+    if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
+    begin
+      if FDataLink.DataSource <> nil then
+        FDataLink.DataSource.RemoveFreeNotification(Self);
+      FDataLink.DataSource := AValue;
+    end;
+    if AValue <> nil then
+      AValue.FreeNotification(Self);
+    UpdateFieldParams;
+  end;
+end;
+
+function TJvDBCalcEdit.GetDataField: string;
+begin
+  Result := FDataLink.FieldName;
+end;
+
+procedure TJvDBCalcEdit.SetDataField(const AValue: string);
+begin
+  if FDataLink.FieldName <> AValue then
+  begin
+    FDataLink.FieldName := AValue;
+    UpdateFieldParams;
+  end;
+end;
+
+procedure TJvDBCalcEdit.SetDefaultParams(AValue: Boolean);
+begin
+  if DefaultParams <> AValue then
+  begin
+    FDefaultParams := AValue;
+    if FDefaultParams then
+      UpdateFieldParams;
+  end;
+end;
+
+procedure TJvDBCalcEdit.UpdateFieldParams;
+begin
+  if FDataLink.Field <> nil then
+  begin
+    if FDataLink.Field is TNumericField then
+    begin
+      if TNumericField(FDataLink.Field).DisplayFormat <> '' then
+        DisplayFormat := TNumericField(FDataLink.Field).DisplayFormat;
+      Alignment := TNumericField(FDataLink.Field).Alignment;
+    end;
+    if FDataLink.Field is TLargeintField then
+    begin
+      MaxValue := TLargeintField(FDataLink.Field).MaxValue;
+      MinValue := TLargeintField(FDataLink.Field).MinValue;
+      DecimalPlaces := 0;
+      if DisplayFormat = '' then
+        DisplayFormat := ',#';
+    end
+    else
+    if FDataLink.Field is TIntegerField then
+    begin
+      MaxValue := TIntegerField(FDataLink.Field).MaxValue;
+      MinValue := TIntegerField(FDataLink.Field).MinValue;
+      DecimalPlaces := 0;
+      if DisplayFormat = '' then
+        DisplayFormat := ',#';
+    end
+    else
+    if FDataLink.Field is TBCDField then
+    begin
+      MaxValue := TBCDField(FDataLink.Field).MaxValue;
+      MinValue := TBCDField(FDataLink.Field).MinValue;
+    end
+    else
+    if FDataLink.Field is TFloatField then
+    begin
+      MaxValue := TFloatField(FDataLink.Field).MaxValue;
+      MinValue := TFloatField(FDataLink.Field).MinValue;
+        //Polaris      DecimalPlaces := TFloatField(FDataLink.Field).Precision;
+      DecimalPlaces := Min(DecimalPlaces, TFloatField(FDataLink.Field).Precision);
+    end
+    else
+    if FDataLink.Field is TBooleanField then
+    begin
+      MinValue := 0;
+      MaxValue := 1;
+      DecimalPlaces := 0;
+      if DisplayFormat = '' then
+        DisplayFormat := ',#';
+    end;
+  end;
+end;
+
+function TJvDBCalcEdit.GetReadOnly: Boolean;
+begin
+  Result := FDataLink.ReadOnly;
+end;
+
+procedure TJvDBCalcEdit.SetReadOnly(AValue: Boolean);
+begin
+  FDataLink.ReadOnly := AValue;
+end;
+
+function TJvDBCalcEdit.GetEditorClassType: TGEEditClass;
+begin
+  Result := TJvDBEbEdit;
+end;
+
+procedure TJvDBCalcEdit.AcceptValue(AValue: Double);
+begin
+  FDataLink.Field.Value := CheckValue(AValue, False);
+  DataChange(nil);
+end;
+
+function TJvDBCalcEdit.GetField: TField;
+begin
+  Result := FDataLink.Field;
+end;
+
+procedure TJvDBCalcEdit.DataChange(Sender: TObject);
+begin
+  if FDefaultParams then
+    UpdateFieldParams;
+  if FDataLink.Field <> nil then
+  begin
+    if FDataLink.Field.IsNull then
+    begin
+      Self.Value := 0.0;
+      EditText := '';
+    end
+    else
+    if FDataLink.Field.DataType in [ftSmallint, ftInteger, ftWord] then
+      Self.AsInteger := FDataLink.Field.AsInteger
+    else
+    if FDataLink.Field.DataType = ftBoolean then
+      Self.AsInteger := Ord(FDataLink.Field.AsBoolean)
+    else
+    if FDataLink.Field is TLargeintField then
+      Self.Value := TLargeintField(FDataLink.Field).AsLargeInt
+    else
+      Self.Value := FDataLink.Field.AsFloat;
+    DataChanged;
+  end
+  else
+  begin
+    if csDesigning in ComponentState then
+    begin
+      Self.Value := 0;
+      EditText := Format('(%s)', [Name]);
+    end
+    else
+      Self.Value := 0;
+  end;
+end;
+
+procedure TJvDBCalcEdit.EditingChange(Sender: TObject);
+begin
+  inherited ReadOnly := not FDataLink.Editing;
+end;
+
+procedure TJvDBCalcEdit.UpdateFieldData(Sender: TObject);
+begin
+  inherited UpdateData;
+  //Polaris  if (Value = 0) and ZeroEmpty then FDataLink.Field.Clear
+  if (Trim(Text) = '') and FEmptyIsNull then
+    FDataLink.Field.Clear
+      //if (Value = 0) and ZeroEmpty then
+//  FDataLink.Field.Clear
+  else
+
+  case FDataLink.Field.DataType of
+    ftSmallint,
+    ftInteger,
+    ftWord:
+      begin
+        FDataLink.Field.AsInteger := Self.AsInteger;
+      end;
+    ftBoolean:
+      begin
+        FDataLink.Field.AsBoolean := Boolean(Self.AsInteger);
+      end;
+    ftFMTBcd,
+    ftBCD:
+      begin
+        FDataLink.Field.AsBCD := DoubleToBCD(Self.Value)
+      end;
+    else
+      begin
+        FDataLink.Field.AsFloat := Self.Value;
+      end;
+  end;
+end;
+
+procedure TJvDBCalcEdit.CMGetDataLink(var Msg: TLMessage);
+begin
+  Msg.Result := LRESULT(FDataLink);
+end;
+
+// Polaris
+procedure TJvDBCalcEdit.DoExit;
+begin
+  if Modified then
+  try
+    CheckRange;
+    FDataLink.UpdateRecord;
+  except
+    SelectAll;
+    if CanFocus then
+      SetFocus;
+    raise;
+  end;
+  inherited DoExit;
+end;
+
+function TJvDBCalcEdit.ExecuteAction(AAction: TBasicAction): Boolean;
+begin
+  Result := inherited ExecuteAction(AAction) or (FDataLink <> nil) and
+    FDataLink.ExecuteAction(AAction);
+end;
+
+function TJvDBCalcEdit.UpdateAction(AAction: TBasicAction): Boolean;
+begin
+  Result := inherited UpdateAction(AAction) or (FDataLink <> nil) and
+    FDataLink.UpdateAction(AAction);
+end;
+
+end.
+

components/jvcllaz/run/JvStdCtrls/JvBaseEdits.pas

@@ -0,0 +1,959 @@
+{-----------------------------------------------------------------------------
+The contents of this file are subject to the Mozilla Public License
+Version 1.1 (the "License"); you may not use this file except in compliance
+with the License. You may obtain a copy of the License at
+http://www.mozilla.org/MPL/MPL-1.1.html
+
+Software distributed under the License is distributed on an "AS IS" basis,
+WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
+the specific language governing rights and limitations under the License.
+
+The Original Code is: JvCurrEdit.PAS, released on 2002-07-04.
+
+The Initial Developers of the Original Code are: Fedor Koshevnikov, Igor Pavluk and Serge Korolev
+Copyright (c) 1997, 1998 Fedor Koshevnikov, Igor Pavluk and Serge Korolev
+Copyright (c) 2001,2002 SGB Software
+All Rights Reserved.
+
+Contributor(s):
+  Polaris Software
+  Andreas Hausladen
+
+Lazarus port: Michal Gawrycki
+
+You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
+located at http://jvcl.delphi-jedi.org
+
+Known Issues:
+  (rb) Compare property names with those of TJvSpinEdit, JvValidateEdit, for
+       example DecimalPlaces/Decimal, CheckMinValue (name indicates action?
+       maybe better: TJvValidateEdit's HasMinValue) etc.
+-----------------------------------------------------------------------------}
+
+unit JvBaseEdits;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, EditBtn, LMessages, CalcForm, Forms, GroupedEdit;
+
+type
+
+  { TJvEbEdit }
+
+  TJvEbEdit = class(TEbEdit)
+  protected
+    procedure WMPaste(var Msg: TLMessage); message LM_PASTE;
+  end;
+
+  { TJvCustomNumEdit }
+
+  TJvCustomNumEdit = class(TCustomEditButton)
+  private
+    FFocused: Boolean;
+    FValue: Double;
+    FMinValue: Double;
+    FMaxValue: Double;
+    FDecimalPlaces: Cardinal;
+    FDecimalPlacesAlwaysShown: Boolean; // WAP Added. True means Use 0 instead of # in FormatFloat picture (ie 0.000 versus 0.####). NEW.
+    FCheckOnExit: Boolean;
+    FZeroEmpty: Boolean;
+    FFormatOnEditing: Boolean;
+    FFormatting: Boolean;
+    FDisplayFormat: string;
+    FDecimalPlaceRound: Boolean;
+    function GetEditFormat: string; // WAP added.
+    procedure SetDecimalPlaceRound(Value: Boolean);
+    procedure SetFocused(Value: Boolean);
+    procedure SetDisplayFormat(const Value: string);
+    function GetDisplayFormat: string;
+    procedure SetDecimalPlaces(Value: Cardinal);
+    procedure SetDecimalPlacesAlwaysShown( Value:Boolean );
+    function GetValue: Double;
+    procedure SetValue(AValue: Double);
+    function GetAsInteger: Longint;
+    procedure SetAsInteger(AValue: Longint);
+    procedure SetMaxValue(AValue: Double);
+    procedure SetMinValue(AValue: Double);
+    procedure SetZeroEmpty(Value: Boolean);
+    procedure SetFormatOnEditing(Value: Boolean);
+    function GetText: string;
+    function IsFormatStored: Boolean;
+  protected
+    function GetEditorClassType: TGEEditClass; override;
+    procedure SetText(const AValue: string); virtual;
+    procedure EnabledChanged; override;
+    procedure DoEnter; override;
+    procedure DoExit; override;
+    procedure FontChanged(Sender: TObject); override;
+    //Polaris up to protected
+    function CheckValue(NewValue: Double; RaiseOnError: Boolean): Double;
+    procedure EditChange; override;
+    procedure ReformatEditText; dynamic;
+    procedure DataChanged; virtual;
+    function DefaultDisplayFormat: string; virtual;
+    procedure EditKeyPress(var Key: Char); override;
+    function IsValidChar(Key: Char): Boolean; virtual;
+    function FormatDisplayText(Value: Double): string;
+    function GetDisplayText: string; virtual;
+    procedure Reset; override;
+    procedure CheckRange;
+    procedure UpdateData;
+    property Formatting: Boolean read FFormatting;
+    property CheckOnExit: Boolean read FCheckOnExit write FCheckOnExit default False;
+    property DecimalPlaces: Cardinal read FDecimalPlaces write SetDecimalPlaces default 2;
+    // WAP Added. True means Use 0 instead of # in FormatFloat picture (ie 0.000 versus 0.####). NEW.
+    property DecimalPlacesAlwaysShown: Boolean read FDecimalPlacesAlwaysShown write SetDecimalPlacesAlwaysShown;
+    property DisplayFormat: string read GetDisplayFormat write SetDisplayFormat stored IsFormatStored;
+    property MaxValue: Double read FMaxValue write SetMaxValue;
+    property MinValue: Double read FMinValue write SetMinValue;
+    property FormatOnEditing: Boolean read FFormatOnEditing write SetFormatOnEditing default False;
+    property Text: string read GetText write SetText stored False;
+    property MaxLength default 0;
+    property ZeroEmpty: Boolean read FZeroEmpty write SetZeroEmpty default True;
+    //Polaris
+    property DecimalPlaceRound: Boolean read FDecimalPlaceRound write SetDecimalPlaceRound default False;
+  public
+    constructor Create(AOwner: TComponent); override;
+    procedure Clear;
+    property AsInteger: Longint read GetAsInteger write SetAsInteger;
+    property DisplayText: string read GetDisplayText;
+    property Value: Double read GetValue write SetValue;
+  end;
+
+  TJvxCurrencyEdit = class(TJvCustomNumEdit)
+  protected
+    function DefaultDisplayFormat: string; override;
+  published
+    property BiDiMode;
+    property DragCursor;
+    property DragKind;
+    property Flat;
+    property ParentBiDiMode;
+    property OnEndDock;
+    property OnStartDock;
+    property Align; //Polaris
+    property Alignment;
+    property Anchors;
+    property AutoSelect;
+    property AutoSize;
+    property BorderStyle;
+    property CheckOnExit;
+    property Color;
+    property Constraints;
+    property DecimalPlaceRound; //Polaris
+    property DecimalPlaces;
+    property DisplayFormat;
+    property DragMode;
+    property Enabled;
+    property Font;
+    property FormatOnEditing;
+    property HideSelection;
+    property MaxLength;
+    property MaxValue;
+    property MinValue;
+    property ParentColor;
+    property ParentFont;
+    property ParentShowHint;
+    property PopupMenu;
+    property ReadOnly;
+    property ShowHint;
+    property TabOrder;
+    property TabStop;
+    property Text;
+    property Value;
+    property Visible;
+    property ZeroEmpty;
+    property ButtonCaption;
+    property ButtonCursor;
+    property ButtonHint;
+    property ButtonOnlyWhenFocused;
+    property ButtonWidth;
+    property Glyph;
+    property NumGlyphs;
+    property Images;
+    property ImageIndex;
+    property ImageWidth;
+    property Action;
+    property DirectInput;
+    property FocusOnButtonClick;
+    property BorderSpacing;
+    property Layout;
+    property Spacing;
+    property OnChange;
+    property OnClick;
+    property OnContextPopup;
+    property OnDblClick;
+    property OnDragDrop;
+    property OnDragOver;
+    property OnEndDrag;
+    property OnEnter;
+    property OnExit;
+    property OnKeyDown;
+    property OnKeyPress;
+    property OnKeyUp;
+    property OnMouseDown;
+    property OnMouseMove;
+    property OnMouseUp;
+    property OnStartDrag;
+    property OnButtonClick;
+    property OnEditingDone;
+    property OnMouseEnter;
+    property OnMouseLeave;
+    property OnMouseWheel;
+    property OnMouseWheelDown;
+    property OnMouseWheelUp;
+    property OnUTF8KeyPress;
+    property TextHint;
+  end;
+
+  { TJvCustomCalcEdit }
+
+  TJvCustomCalcEdit = class(TJvCustomNumEdit)
+  private
+    FDialogTitle: String;
+    FCalculatorLayout: TCalculatorLayout;
+    FDialogPosition: TPosition;
+    FDialogLeft: Integer;
+    FDialogTop: Integer;
+    FOnAcceptValue: TAcceptValueEvent;
+    function TitleStored: boolean;
+  protected
+    procedure AcceptValue(ANewValue: Double); virtual;
+    function GetDefaultGlyphName: string; override;
+    procedure ButtonClick; override;
+    property CalculatorLayout : TCalculatorLayout read FCalculatorLayout write FCalculatorLayout;
+    property DialogTitle : String read FDialogTitle write FDialogTitle stored TitleStored;
+    property DialogPosition: TPosition read FDialogPosition write FDialogPosition default poScreenCenter;
+    property DialogTop: Integer read FDialogTop write FDialogTop;
+    property DialogLeft: Integer read FDialogLeft write FDialogLeft;
+    property OnAcceptValue: TAcceptValueEvent read FOnAcceptValue write FOnAcceptValue;
+  public
+    constructor Create(AOwner: TComponent); override;
+    procedure RunDialog; virtual;
+  end;
+
+  TJvCalcEdit = class(TJvCustomCalcEdit)
+  published
+    property CalculatorLayout;
+    property OnAcceptValue;
+    property DialogTitle;
+    property DialogPosition;
+    property DialogTop;
+    property DialogLeft;
+    property ButtonCaption;
+    property ButtonCursor;
+    property ButtonHint;
+    property ButtonOnlyWhenFocused;
+    property ButtonWidth;
+    property Constraints;
+    property BiDiMode;
+    property DragCursor;
+    property DragKind;
+    property Glyph;
+    property NumGlyphs;
+    property Images;
+    property ImageIndex;
+    property ImageWidth;
+    property Flat;
+    property ParentBiDiMode;
+    property OnEndDock;
+    property OnStartDock;
+    property Action;
+    property Align; //Polaris
+    property Alignment;
+    property AutoSelect;
+    property AutoSize;
+    property BorderStyle;
+    property CheckOnExit;
+    property Color;
+    property DecimalPlaceRound; //Polaris
+    property DecimalPlaces;
+    property DirectInput;
+    property DisplayFormat;
+    property DragMode;
+    property Enabled;
+    property Font;
+    property FormatOnEditing;
+    property FocusOnButtonClick;
+    property HideSelection;
+    property BorderSpacing;
+    property Layout;
+    property Spacing;
+    property Anchors;
+    property MaxLength;
+    property MaxValue;
+    property MinValue;
+    property ParentColor;
+    property ParentFont;
+    property ParentShowHint;
+    property PopupMenu;
+    property ReadOnly;
+    property ShowHint;
+    property TabOrder;
+    property TabStop;
+    property Text;
+    property Value;
+    property Visible;
+    property ZeroEmpty;
+    property DecimalPlacesAlwaysShown;
+    property OnButtonClick;
+    property OnChange;
+    property OnClick;
+    property OnDblClick;
+    property OnDragDrop;
+    property OnDragOver;
+    property OnEndDrag;
+    property OnEnter;
+    property OnExit;
+    property OnKeyDown;
+    property OnKeyPress;
+    property OnKeyUp;
+    property OnMouseDown;
+    property OnMouseMove;
+    property OnMouseUp;
+    property OnContextPopup;
+    property OnStartDrag;
+    property OnEditingDone;
+    property OnMouseEnter;
+    property OnMouseLeave;
+    property OnMouseWheel;
+    property OnMouseWheelDown;
+    property OnMouseWheelUp;
+    property OnUTF8KeyPress;
+    property TextHint;
+  end;
+
+implementation
+
+uses
+  LCLIntf, LCLStrConsts, Math, StrUtils, Controls,
+  JvConsts, JvResources, JvJCLUtils;
+
+function IsValidFloat(const Value: string; var RetValue: Double): Boolean;
+var
+  I: Integer;
+begin
+  Result := False;
+  for I := 1 to Length(Value) do
+    if not CharInSet(Value[I], [FormatSettings.DecimalSeparator, '-', '+', '0'..'9', 'e', 'E']) then
+      Exit;
+  Result := TextToFloat(PChar(Value), RetValue, fvDouble);
+end;
+
+function FormatFloatStr(const S: string; Thousands: Boolean): string;
+var
+  I, MaxSym, MinSym, Group: Integer;
+  IsSign: Boolean;
+begin
+  Result := '';
+  MaxSym := Length(S);
+  IsSign := (MaxSym > 0) and CharInSet(S[1], SignSymbols);
+  if IsSign then
+    MinSym := 2
+  else
+    MinSym := 1;
+  I := Pos(FormatSettings.DecimalSeparator, S);
+  if I > 0 then
+    MaxSym := I - 1;
+  I := Pos('E', AnsiUpperCase(S));
+  if I > 0 then
+    MaxSym := Min(I - 1, MaxSym);
+  Result := Copy(S, MaxSym + 1, MaxInt);
+  Group := 0;
+  for I := MaxSym downto MinSym do
+  begin
+    Result := S[I] + Result;
+    Inc(Group);
+    if (Group = 3) and Thousands and (I > MinSym) then
+    begin
+      Group := 0;
+      Result := FormatSettings.ThousandSeparator + Result;
+    end;
+  end;
+  if IsSign then
+    Result := S[1] + Result;
+end;
+
+{ TJvEbEdit }
+
+procedure TJvEbEdit.WMPaste(var Msg: TLMessage);
+var
+  S: string;
+  WasModified: Boolean;
+begin
+  if Owner is TJvCustomNumEdit then
+    with Owner as TJvCustomNumEdit do
+    begin
+      WasModified := Modified;
+      S := EditText;
+      try
+        inherited;
+        UpdateData;
+      except
+        { Changing EditText sets Modified to false }
+        EditText := S;
+        Modified := WasModified;
+        SelectAll;
+        if Edit.CanFocus then
+          Edit.SetFocus;
+        //DoBeepOnError;
+      end;
+    end
+  else
+    inherited;
+end;
+
+//=== { TJvCustomNumEdit } ===================================================
+
+constructor TJvCustomNumEdit.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FDecimalPlaceRound := False; // Polaris
+  MaxLength := 0;
+  Alignment := taRightJustify;
+  FDisplayFormat := DefaultDisplayFormat;
+  FDecimalPlaces := 2;
+  FZeroEmpty := True;
+  inherited Text := '';
+  { forces update }
+  DataChanged;
+end;
+
+//Polaris
+
+procedure TJvCustomNumEdit.SetDecimalPlaceRound(Value: Boolean);
+begin
+  if FDecimalPlaceRound <> Value then
+  begin
+    FDecimalPlaceRound := Value;
+    SetValue(CheckValue(FValue, False));
+    Invalidate;
+    ReformatEditText;
+  end;
+end;
+
+function TJvCustomNumEdit.DefaultDisplayFormat: string;
+begin
+  Result := ',0.##';
+end;
+
+function TJvCustomNumEdit.IsFormatStored: Boolean;
+begin
+  Result := (DisplayFormat <> DefaultDisplayFormat);
+end;
+
+function TJvCustomNumEdit.GetEditorClassType: TGEEditClass;
+begin
+  Result := TJvEbEdit;
+end;
+
+
+{ (rb) This function works NOT the same as JvJCLUtils.TextToValText; for example
+       it does NOT remove 'a'..'z' chars.
+       Couldn't come up with a good name, so feel free to change it
+}
+function xTextToValText(const AValue: string): string;
+var
+  fs: TFormatSettings absolute DefaultFormatSettings;  // less typing...
+begin
+  Result := Trim(AValue);
+  if AnsiChar(fs.DecimalSeparator) <> AnsiChar(fs.ThousandSeparator) then
+    Result := DelChars(Result, fs.ThousandSeparator);
+  if (fs.DecimalSeparator <> '.') and (fs.ThousandSeparator <> '.') then
+    Result := ReplaceStr(Result, '.', fs.DecimalSeparator);
+  if (fs.DecimalSeparator <> ',') and (fs.ThousandSeparator <> ',') then
+    Result := ReplaceStr(Result, ',', fs.DecimalSeparator);
+  if Result = '' then
+    Result := '0'
+  else
+  if Result = '-' then
+    Result := '-0';
+end;
+
+function TJvCustomNumEdit.IsValidChar(Key: Char): Boolean;
+var
+  S: string;
+  FSelStart, SelStop, DecPos: Integer;
+  RetValue: Double;
+begin
+  Result := False;
+  S := EditText;
+  GetSel(FSelStart, SelStop);
+  Delete(S, FSelStart + 1, SelStop - FSelStart);
+  Insert(Key, S, FSelStart + 1);
+  S := xTextToValText(S);
+  DecPos := Pos(FormatSettings.DecimalSeparator, S);
+  if DecPos > 0 then
+  begin
+    FSelStart := Pos('E', UpperCase(S));
+    if FSelStart > DecPos then
+      DecPos := FSelStart - DecPos
+    else
+      DecPos := Length(S) - DecPos;
+    if DecPos > Integer(FDecimalPlaces) then
+      Exit;
+  end;
+  Result := IsValidFloat(S, RetValue);
+  if Result and (FMinValue >= 0) and (FMaxValue > 0) and (RetValue < 0) then
+    Result := False;
+end;
+
+procedure TJvCustomNumEdit.EditKeyPress(var Key: Char);
+begin
+  if CharInSet(Key, ['.', ','] - [FormatSettings.ThousandSeparator]) then
+    Key := FormatSettings.DecimalSeparator;
+  inherited KeyPress(Key);
+  if (Key >= #32) and not IsValidChar(Key) then
+  begin
+    //DoBeepOnError;
+    Key := #0;
+  end
+  else
+  if Key = Esc then
+  begin
+    Reset;
+    Key := #0;
+  end;
+end;
+
+procedure TJvCustomNumEdit.Reset;
+begin
+  DataChanged;
+  SelectAll;
+end;
+
+procedure TJvCustomNumEdit.SetZeroEmpty(Value: Boolean);
+begin
+  if FZeroEmpty <> Value then
+  begin
+    FZeroEmpty := Value;
+    DataChanged;
+  end;
+end;
+
+procedure TJvCustomNumEdit.SetDisplayFormat(const Value: string);
+begin
+  if DisplayFormat <> Value then
+  begin
+    FDisplayFormat := Value;
+    Invalidate;
+    DataChanged;
+  end;
+end;
+
+function TJvCustomNumEdit.GetDisplayFormat: string;
+begin
+  Result := FDisplayFormat;
+end;
+
+procedure TJvCustomNumEdit.SetFocused(Value: Boolean);
+begin
+  if FFocused <> Value then
+  begin
+    FFocused := Value;
+    Invalidate;
+    FFormatting := True;
+    try
+      DataChanged;
+    finally
+      FFormatting := False;
+    end;
+  end;
+end;
+
+procedure TJvCustomNumEdit.SetFormatOnEditing(Value: Boolean);
+begin
+  if FFormatOnEditing <> Value then
+  begin
+    FFormatOnEditing := Value;
+    if FFormatOnEditing then
+      inherited Alignment := Alignment
+    else
+      inherited Alignment := taLeftJustify;
+    if FFormatOnEditing and FFocused then
+      ReformatEditText
+    else
+    if FFocused then
+    begin
+      UpdateData;
+      DataChanged;
+    end;
+  end;
+end;
+
+procedure TJvCustomNumEdit.SetDecimalPlaces(Value: Cardinal);
+begin
+  if FDecimalPlaces <> Value then
+  begin
+    FDecimalPlaces := Value;
+    // WAP Added. Changes to decimal places formerly did not EditChange
+    // FDisplayFormat, which causes both designtime and runtime problems!
+    SetDisplayFormat(GetEditFormat);
+    SetValue(CheckValue(FValue, False)); // Polaris (?)
+    DataChanged;
+    Invalidate;
+  end;
+end;
+
+{WAP added this new property: Switches between using 0.000
+     and 0.### as a FormatFloat picture. }
+procedure TJvCustomNumEdit.SetDecimalPlacesAlwaysShown( Value:Boolean );
+begin
+  if FDecimalPlacesAlwaysShown <> Value then
+  begin
+    FDecimalPlacesAlwaysShown := Value;
+    SetDisplayFormat(GetEditFormat); // Redo format picture
+    SetValue(CheckValue(FValue, False)); // Polaris (?)
+    DataChanged;
+    Invalidate;
+  end;
+end;
+
+function TJvCustomNumEdit.FormatDisplayText(Value: Double): string;
+begin
+  if DisplayFormat <> '' then
+    Result := FormatFloat(DisplayFormat, Value)
+  else
+    Result := FloatToStr(Value);
+end;
+
+function TJvCustomNumEdit.GetDisplayText: string;
+begin
+  Result := FormatDisplayText(FValue);
+end;
+
+procedure TJvCustomNumEdit.Clear;
+begin
+  Text := '';
+end;
+
+{WAP added GetEditFormat, this code used to be ininline inside DataChanged.}
+function TJvCustomNumEdit.GetEditFormat: string;
+begin
+  Result := ',0';  // must put the thousands separator by default to allow direct edit of value (paste for example)
+  if FDecimalPlaces > 0 then
+    if FDecimalPlacesAlwaysShown then
+       Result  := Result + '.' + StringOfChar('0', FDecimalPlaces)
+    else
+       Result  := Result + '.' + StringOfChar('#', FDecimalPlaces);
+end;
+
+procedure TJvCustomNumEdit.DataChanged;
+var
+  EditFormat: string;
+  WasModified: Boolean;
+begin
+  EditFormat := GetEditFormat;
+  { Changing EditText sets Modified to false }
+  WasModified := Modified;
+  try
+    if (FValue = 0.0) and FZeroEmpty then
+      EditText := ''
+    else
+      if FFocused then
+        EditText := FormatFloat(EditFormat, CheckValue(FValue, False))
+      else
+        EditText := GetDisplayText;
+  finally
+    Modified := WasModified;
+  end;
+end;
+
+function TJvCustomNumEdit.CheckValue(NewValue: Double;
+  RaiseOnError: Boolean): Double;
+var
+  DP: Integer;
+begin
+  if FDecimalPlaceRound then
+  begin //Polaris
+    DP := FDecimalPlaces;
+    { (rb) Probably: Round to the nearest, and if two are equally near, away from zero
+           Ln, Exp are slow; make more generic (why only this one?), see
+           http://www.merlyn.demon.co.uk/pas-chop.htm
+    }
+    NewValue := Int(NewValue * Exp(DP * Ln(10)) + Sign(NewValue) * 0.50000001) * Exp(-DP * Ln(10));
+  end;
+  Result := NewValue;
+  if FMaxValue <> FMinValue then
+  begin
+    if FMaxValue > FMinValue then
+    begin
+      if NewValue < FMinValue then
+        Result := FMinValue
+      else
+      if NewValue > FMaxValue then
+        Result := FMaxValue;
+    end
+    else
+    begin
+      if FMaxValue = 0 then
+      begin
+        if NewValue < FMinValue then
+          Result := FMinValue;
+      end
+      else
+      if FMinValue = 0 then
+      begin
+        if NewValue > FMaxValue then
+          Result := FMaxValue;
+      end;
+    end;
+    if RaiseOnError and (Result <> NewValue) then
+      raise ERangeError.CreateResFmt(@RsEOutOfRangeXFloat,
+        [DecimalPlaces, FMinValue, DecimalPlaces, FMaxValue]);
+  end;
+end;
+
+procedure TJvCustomNumEdit.CheckRange;
+begin
+  if not (csDesigning in ComponentState) and CheckOnExit then
+    CheckValue(StrToFloat(TextToValText(EditText)), True);
+end;
+
+procedure TJvCustomNumEdit.UpdateData;
+begin
+  ValidateEdit;
+  FValue := CheckValue(StrToFloat(TextToValText(EditText)), False);
+end;
+
+function TJvCustomNumEdit.GetValue: Double;
+begin
+  if not (csDesigning in ComponentState) then
+  try
+    UpdateData;
+  except
+    FValue := FMinValue;
+  end;
+  Result := FValue;
+end;
+
+procedure TJvCustomNumEdit.SetValue(AValue: Double);
+begin
+  FValue := CheckValue(AValue, False);
+  DataChanged;
+  Invalidate;
+end;
+
+function TJvCustomNumEdit.GetAsInteger: Longint;
+begin
+  Result := trunc(Value);
+end;
+
+procedure TJvCustomNumEdit.SetAsInteger(AValue: Longint);
+begin
+  SetValue(AValue);
+end;
+
+procedure TJvCustomNumEdit.SetMinValue(AValue: Double);
+begin
+  if FMinValue <> AValue then
+  begin
+    FMinValue := AValue;
+    Value := FValue;
+  end;
+end;
+
+procedure TJvCustomNumEdit.SetMaxValue(AValue: Double);
+begin
+  if FMaxValue <> AValue then
+  begin
+    FMaxValue := AValue;
+    Value := FValue;
+  end;
+end;
+
+function TJvCustomNumEdit.GetText: string;
+begin
+  Result := inherited Text;
+end;
+
+procedure TJvCustomNumEdit.SetText(const AValue: string);
+begin
+  if not (csReading in ComponentState) then
+  begin
+    FValue := CheckValue(StrToFloat(TextToValText(AValue)), False);
+    DataChanged;
+    Invalidate;
+  end;
+end;
+
+procedure TJvCustomNumEdit.ReformatEditText;
+var
+  S: string;
+  IsEmpty: Boolean;
+  OldLen, ASelStart, SelStop: Integer;
+  WasModified: Boolean;
+begin
+  FFormatting := True;
+  { Changing Text sets Modified to false }
+  WasModified := Modified;
+  try
+    S := inherited Text;
+    OldLen := Length(S);
+    IsEmpty := (OldLen = 0) or (S = '-');
+    if Edit.HandleAllocated then
+      GetSel(ASelStart, SelStop);
+    if not IsEmpty then
+      S := TextToValText(S);
+    S := FormatFloatStr(S, Pos(',', DisplayFormat) > 0);
+    inherited Text := S;
+    if Edit.HandleAllocated and (GetFocus = Edit.Handle) and
+      not (csDesigning in ComponentState) then
+    begin
+      Inc(ASelStart, Length(S) - OldLen);
+      SetSel(ASelStart, ASelStart);
+    end;
+  finally
+    FFormatting := False;
+    Modified := WasModified;
+  end;
+end;
+
+procedure TJvCustomNumEdit.EditChange;
+begin
+  if not FFormatting then
+  begin
+    if FFormatOnEditing and FFocused then
+      ReformatEditText;
+    inherited EditChange;
+  end;
+end;
+
+procedure TJvCustomNumEdit.DoEnter;
+begin
+  SetFocused(True);
+  if FFormatOnEditing then
+    ReformatEditText;
+  inherited DoEnter;
+end;
+
+procedure TJvCustomNumEdit.DoExit;
+begin
+  try
+    CheckRange;
+    UpdateData;
+  except
+    SelectAll;
+    if Edit.CanFocus then
+      Edit.SetFocus;
+    raise;
+  end;
+  SetFocused(False);
+  SetSel(0, 0);
+  inherited DoExit;
+end;
+
+procedure TJvCustomNumEdit.EnabledChanged;
+begin
+  inherited EnabledChanged;
+  if not FFocused then
+    Invalidate;
+end;
+
+procedure TJvCustomNumEdit.FontChanged(Sender: TObject);
+begin
+  inherited FontChanged(Sender);
+  Invalidate;
+end;
+
+//=== { TJvxCurrencyEdit } ===================================================
+
+function TJvxCurrencyEdit.DefaultDisplayFormat: string;
+var
+  CurrStr: string;
+  I: Integer;
+  C: Char;
+begin
+  Result := ',0.' + StringOfChar('0', FormatSettings.CurrencyDecimals);
+  CurrStr := '';
+  for I := 1 to Length(FormatSettings.CurrencyString) do
+  begin
+    C := FormatSettings.CurrencyString[I];
+    if CharInSet(C, [',', '.']) then
+      CurrStr := CurrStr + '''' + C + ''''
+    else
+      CurrStr := CurrStr + C;
+  end;
+  if Length(CurrStr) > 0 then
+    case FormatSettings.CurrencyFormat of
+      0:
+        Result := CurrStr + Result; { '$1' }
+      1:
+        Result := Result + CurrStr; { '1$' }
+      2:
+        Result := CurrStr + ' ' + Result; { '$ 1' }
+      3:
+        Result := Result + ' ' + CurrStr; { '1 $' }
+    end;
+  Result := Format('%s;-%s', [Result, Result]);
+end;
+
+//=== { TJvCustomCalcEdit } ==================================================
+
+function TJvCustomCalcEdit.TitleStored: boolean;
+begin
+  Result := FDialogTitle <> rsCalculator;
+end;
+
+procedure TJvCustomCalcEdit.AcceptValue(ANewValue: Double);
+begin
+  Value := ANewValue;
+end;
+
+function TJvCustomCalcEdit.GetDefaultGlyphName: string;
+begin
+  Result := ResBtnCalculator;
+end;
+
+procedure TJvCustomCalcEdit.ButtonClick;
+begin
+  inherited ButtonClick;
+  RunDialog;
+  //Do this after the dialog, otherwise it just looks silly
+  if FocusOnButtonClick then FocusAndMaybeSelectAll;
+end;
+
+constructor TJvCustomCalcEdit.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FDialogTitle := rsCalculator;
+  FDialogPosition := poScreenCenter;
+end;
+
+procedure TJvCustomCalcEdit.RunDialog;
+var
+  D: Double;
+  B: Boolean;
+  Dlg: TCalculatorForm;
+begin
+  D := Value;
+  Dlg := CreateCalculatorForm(Self, FCalculatorLayout, 0);
+  with Dlg do
+    try
+      Caption := DialogTitle;
+      Value := D;
+      Dlg.Top := FDialogTop;
+      Dlg.Left := FDialogLeft;
+      Dlg.Position := FDialogPosition;
+      if (ShowModal = mrOK) then
+      begin
+        D := Value;
+        B := True;
+        if Assigned(FOnAcceptValue) then
+          FOnAcceptValue(Self, D, B);
+        if B then
+        begin
+          AcceptValue(D);
+          Edit.SelectAll;
+        end;
+      end;
+    finally
+      Free;
+    end;
+end;
+
+end.
+