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. +