diff --git a/components/jvcllaz/design/JvDB/JvDBReg.pas b/components/jvcllaz/design/JvDB/JvDBReg.pas
index 3eaa16512..dfd349702 100644
--- a/components/jvcllaz/design/JvDB/JvDBReg.pas
+++ b/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);
diff --git a/components/jvcllaz/design/JvDB/images/images.txt b/components/jvcllaz/design/JvDB/images/images.txt
index d41b912a5..0b2a1a335 100644
--- a/components/jvcllaz/design/JvDB/images/images.txt
+++ b/components/jvcllaz/design/JvDB/images/images.txt
@@ -1,3 +1,4 @@
+tjvdbcalcedit.bmp
tjvdbhtlabel.bmp
tjvdbsearchcombobox.bmp
tjvdbsearchedit.bmp
diff --git a/components/jvcllaz/design/JvDB/images/tjvdbcalcedit.bmp b/components/jvcllaz/design/JvDB/images/tjvdbcalcedit.bmp
new file mode 100644
index 000000000..aa99dcbe6
Binary files /dev/null and b/components/jvcllaz/design/JvDB/images/tjvdbcalcedit.bmp differ
diff --git a/components/jvcllaz/design/JvStdCtrls/JvStdCtrlsReg.pas b/components/jvcllaz/design/JvStdCtrls/JvStdCtrlsReg.pas
index 590b82d85..e35dd8015 100644
--- a/components/jvcllaz/design/JvStdCtrls/JvStdCtrlsReg.pas
+++ b/components/jvcllaz/design/JvStdCtrls/JvStdCtrlsReg.pas
@@ -11,13 +11,15 @@ procedure Register;
implementation
+{$R ../../resource/jvstdctrlsreg.res}
+
uses
- Classes, JvDsgnConsts, JvButton,
- Controls;
+ Classes, Controls, JvDsgnConsts, JvButton, JvBaseEdits;
procedure Register;
begin
//RegisterComponents(RsPaletteButton, [TJvButton]);
+ RegisterComponents(RsPaletteJvcl, [TJvCalcEdit]);
end;
end.
diff --git a/components/jvcllaz/design/JvStdCtrls/images/images.txt b/components/jvcllaz/design/JvStdCtrls/images/images.txt
new file mode 100644
index 000000000..a1a182a25
--- /dev/null
+++ b/components/jvcllaz/design/JvStdCtrls/images/images.txt
@@ -0,0 +1 @@
+tjvcalcedit.bmp
diff --git a/components/jvcllaz/design/JvStdCtrls/images/make_res.bat b/components/jvcllaz/design/JvStdCtrls/images/make_res.bat
new file mode 100644
index 000000000..c699b009d
--- /dev/null
+++ b/components/jvcllaz/design/JvStdCtrls/images/make_res.bat
@@ -0,0 +1 @@
+lazres ../../../resource/jvstdctrlsreg.res @images.txt
diff --git a/components/jvcllaz/design/JvStdCtrls/images/tjvcalcedit.bmp b/components/jvcllaz/design/JvStdCtrls/images/tjvcalcedit.bmp
new file mode 100644
index 000000000..5fdcb1c21
Binary files /dev/null and b/components/jvcllaz/design/JvStdCtrls/images/tjvcalcedit.bmp differ
diff --git a/components/jvcllaz/packages/JvCtrlsLazD.lpk b/components/jvcllaz/packages/JvCtrlsLazD.lpk
index e530ccbea..282ee9b78 100644
--- a/components/jvcllaz/packages/JvCtrlsLazD.lpk
+++ b/components/jvcllaz/packages/JvCtrlsLazD.lpk
@@ -15,10 +15,10 @@
+"/>
diff --git a/components/jvcllaz/packages/JvCtrlsLazR.lpk b/components/jvcllaz/packages/JvCtrlsLazR.lpk
index ebfd0aa9c..09aa6d0e5 100644
--- a/components/jvcllaz/packages/JvCtrlsLazR.lpk
+++ b/components/jvcllaz/packages/JvCtrlsLazR.lpk
@@ -13,10 +13,10 @@
+"/>
diff --git a/components/jvcllaz/packages/JvDBLazD.lpk b/components/jvcllaz/packages/JvDBLazD.lpk
index eb483b0ab..e3dff654b 100644
--- a/components/jvcllaz/packages/JvDBLazD.lpk
+++ b/components/jvcllaz/packages/JvDBLazD.lpk
@@ -14,8 +14,10 @@
+- Search edit, Calc edit
+- DB treeview
+- Hypertext components
+"/>
@@ -25,19 +27,22 @@
-
+
-
+
-
+
-
+
-
+
+
+
+
diff --git a/components/jvcllaz/packages/JvDBLazR.lpk b/components/jvcllaz/packages/JvDBLazR.lpk
index 4de6a5855..1a13cd9c2 100644
--- a/components/jvcllaz/packages/JvDBLazR.lpk
+++ b/components/jvcllaz/packages/JvDBLazR.lpk
@@ -13,11 +13,13 @@
+- Search edit, Calc edit
+- DB treeview
+- Hypertext components
+"/>
-
+
@@ -30,17 +32,24 @@
+
+
+
+
-
+
-
+
-
+
-
+
+
+
+
diff --git a/components/jvcllaz/packages/JvStdCtrlsLazD.lpk b/components/jvcllaz/packages/JvStdCtrlsLazD.lpk
index 3d7c2293b..a073ec127 100644
--- a/components/jvcllaz/packages/JvStdCtrlsLazD.lpk
+++ b/components/jvcllaz/packages/JvStdCtrlsLazD.lpk
@@ -13,7 +13,8 @@
-
+
diff --git a/components/jvcllaz/packages/JvStdCtrlsLazR.lpk b/components/jvcllaz/packages/JvStdCtrlsLazR.lpk
index 8cea008b4..7a64aca97 100644
--- a/components/jvcllaz/packages/JvStdCtrlsLazR.lpk
+++ b/components/jvcllaz/packages/JvStdCtrlsLazR.lpk
@@ -13,17 +13,19 @@
+- CalcEdit
+"/>
-
+
+
+
+
+
diff --git a/components/jvcllaz/resource/JvStdCtrlsReg.res b/components/jvcllaz/resource/JvStdCtrlsReg.res
new file mode 100644
index 000000000..9e69e405b
Binary files /dev/null and b/components/jvcllaz/resource/JvStdCtrlsReg.res differ
diff --git a/components/jvcllaz/resource/jvdbreg.res b/components/jvcllaz/resource/jvdbreg.res
index 6c52bef04..c1deb5bb5 100644
Binary files a/components/jvcllaz/resource/jvdbreg.res and b/components/jvcllaz/resource/jvdbreg.res differ
diff --git a/components/jvcllaz/run/JvCore/JvJCLUtils.pas b/components/jvcllaz/run/JvCore/JvJCLUtils.pas
index e4b62cac2..ea55072f0 100644
--- a/components/jvcllaz/run/JvCore/JvJCLUtils.pas
+++ b/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);
- if DecimalSeparator <> ThousandSeparator then
- Result := DelChars(Result, ThousandSeparator{$IFDEF CLR}[1]{$ENDIF});
+// Result := DelRSpace(AValue);
+ Result := Trim(AValue);
+ if fs.DecimalSeparator <> fs.ThousandSeparator then
+ Result := DelChars(Result, fs.ThousandSeparator);
- if (DecimalSeparator <> '.') and (ThousandSeparator <> '.') then
- Result := ReplaceStr(Result, '.', DecimalSeparator);
- if (DecimalSeparator <> ',') and (ThousandSeparator <> ',') then
- Result := ReplaceStr(Result, ',', DecimalSeparator);
+ if (fs.DecimalSeparator <> '.') and (fs.ThousandSeparator <> '.') then
+ Result := ReplaceStr(Result, '.', fs.DecimalSeparator);
+ if (fs.DecimalSeparator <> ',') and (fs.ThousandSeparator <> ',') then
+ Result := ReplaceStr(Result, ',', fs.DecimalSeparator);
- J := 1;
+ J := 0;
for I := 1 to Length(Result) do
- if Result[I] in ['0'..'9', '-', '+',
- AnsiChar(DecimalSeparator{$IFDEF CLR}[1]{$ENDIF}), AnsiChar(ThousandSeparator{$IFDEF CLR}[1]{$ENDIF})] then
+ if Result[I] in ['0'..'9', '-', '+', fs.DecimalSeparator, fs.ThousandSeparator] 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);
diff --git a/components/jvcllaz/run/JvCtrls/JvHtControls.pas b/components/jvcllaz/run/JvCtrls/JvHtControls.pas
index 3c72190c3..dfaa4f027 100644
--- a/components/jvcllaz/run/JvCtrls/JvHtControls.pas
+++ b/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]
diff --git a/components/jvcllaz/run/JvDB/JvDBControls.pas b/components/jvcllaz/run/JvDB/JvDBControls.pas
new file mode 100644
index 000000000..9c1782a93
--- /dev/null
+++ b/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.
+
diff --git a/components/jvcllaz/run/JvStdCtrls/JvBaseEdits.pas b/components/jvcllaz/run/JvStdCtrls/JvBaseEdits.pas
new file mode 100644
index 000000000..6c2acfd20
--- /dev/null
+++ b/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.
+