You've already forked lazarus-ccr
5296af1508
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6969 8e941d3f-bd1b-0410-a28a-d453659cc2b4
1781 lines
56 KiB
ObjectPascal
1781 lines
56 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
|
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 JvValidateEdit, released on 20 February 2003,
|
|
by Christopher Latta
|
|
Portions created by Christopher Latta are Copyright (C) 2003 Christopher Latta.
|
|
All Rights Reserved.
|
|
Contributor(s): Peter Thornqvist
|
|
Peter Schraut (http://www.console-dev.de)
|
|
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:
|
|
TJvValidateFormat uses the SysUtils.Format function to format numeric values.
|
|
While this uses the Windows regional settings for the currency symbol, decimal
|
|
separator and thousands separator, it does not format using the negative symbol,
|
|
negative number format, negative currency format and positive currency format.
|
|
This could be rectified by a custom-written formatting routine.
|
|
-----------------------------------------------------------------------------}
|
|
// $Id$
|
|
|
|
unit JvValidateEdit;
|
|
|
|
{$MODE OBJFPC}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
LCLIntf, LCLType, LMessages,
|
|
Controls, Graphics, SysUtils, Classes, StdCtrls, FMTBcd;
|
|
// JvEdit, JvDataSourceIntf;
|
|
|
|
type
|
|
TJvValidateEditDisplayFormat = (dfAlphabetic, dfAlphaNumeric, dfBinary,
|
|
dfCheckChars, dfCurrency, dfCustom, dfFloat, dfFloatGeneral, dfHex, dfInteger,
|
|
dfNonCheckChars, dfNone, dfOctal, dfPercent, dfScientific, dfYear, dfDecimal,
|
|
dfIdentifier, dfFloatFixed, dfBcd);
|
|
|
|
TJvValidateEditCriticalPointsCheck = (cpNone, cpMinValue, cpMaxValue, cpBoth);
|
|
|
|
TJvCustomValidateEdit = class;
|
|
|
|
(******************* NOT CONVERTED ***
|
|
TJvValidateEditDataConnector = class(TJvFieldDataConnector)
|
|
private
|
|
FEdit: TJvCustomValidateEdit;
|
|
FNullValue: Variant;
|
|
procedure SetNullValue(const Value: Variant);
|
|
function IsNullValueStored: Boolean;
|
|
protected
|
|
procedure RecordChanged; override;
|
|
procedure UpdateData; override;
|
|
public
|
|
constructor Create(AEdit: TJvCustomValidateEdit);
|
|
procedure Assign(Source: TPersistent); override;
|
|
property Control: TJvCustomValidateEdit read FEdit;
|
|
published
|
|
property NullValue: Variant read FNullValue write SetNullValue stored IsNullValueStored;
|
|
end;
|
|
**********************************)
|
|
|
|
TJvValidateEditCriticalPoints = class(TPersistent)
|
|
private
|
|
FCheckPoints: TJvValidateEditCriticalPointsCheck;
|
|
FColorAbove: TColor;
|
|
FColorBelow: TColor;
|
|
FMaxValue: Double;
|
|
FMinValue: Double;
|
|
FMaxValueIncluded: Boolean;
|
|
FMinValueIncluded: Boolean;
|
|
FOnChange: TNotifyEvent;
|
|
FDefCheckPoints: TJvValidateEditCriticalPointsCheck;
|
|
FDefColorAbove: TColor;
|
|
FDefColorBelow: TColor;
|
|
procedure DoChanged;
|
|
procedure SetMinValue(NewValue: Double);
|
|
procedure SetMaxValue(NewValue: Double);
|
|
procedure SetColorAbove(NewValue: TColor);
|
|
procedure SetColorBelow(NewValue: TColor);
|
|
procedure SetCheckPoints(NewValue: TJvValidateEditCriticalPointsCheck);
|
|
function IsCheckPointsStored: Boolean;
|
|
function IsColorAboveStored: Boolean;
|
|
function IsColorBelowStored: Boolean;
|
|
public
|
|
procedure Assign(Source: TPersistent); override;
|
|
procedure SetDefaults(ACheckPoints: TJvValidateEditCriticalPointsCheck;
|
|
AColorAbove, AColorBelow: TColor);
|
|
constructor Create;
|
|
published
|
|
property CheckPoints: TJvValidateEditCriticalPointsCheck read FCheckPoints
|
|
write SetCheckPoints stored IsCheckPointsStored;
|
|
property ColorAbove: TColor read FColorAbove write SetColorAbove stored IsColorAboveStored;
|
|
property ColorBelow: TColor read FColorBelow write SetColorBelow stored IsColorBelowStored;
|
|
property MaxValue: Double read FMaxValue write SetMaxValue;
|
|
property MinValue: Double read FMinValue write SetMinValue;
|
|
property MaxValueIncluded: Boolean read FMaxValueIncluded write FMaxValueIncluded;
|
|
property MinValueIncluded: Boolean read FMinValueIncluded write FMinValueIncluded;
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
end;
|
|
|
|
TJvCustomTextValidateEvent = procedure(Sender: TObject; Key: Char;
|
|
const AText: string; const Pos: Integer; var IsValid: Boolean) of object;
|
|
TJvCustomIsValidEvent = procedure(Sender: TObject; var IsValid: Boolean) of object;
|
|
TJvCustomDecimalRoundingEvent = procedure(Sender: TObject; var DecimalRoundedValue: Double;
|
|
const Value: Double) of object;
|
|
|
|
TJvCustomValidateEdit = class(TCustomEdit) //TJvCustomEdit)
|
|
private
|
|
FSelfChange: Boolean;
|
|
FCheckChars: string;
|
|
FDecimalPlaces: Cardinal;
|
|
FDisplayFormat: TJvValidateEditDisplayFormat;
|
|
FEditText: string;
|
|
FHasMaxValue: Boolean;
|
|
FHasMinValue: Boolean;
|
|
FMaxValue: Double;
|
|
FMinValue: Double;
|
|
FOnCustomValidate: TJvCustomTextValidateEvent;
|
|
FOnValueChanged: TNotifyEvent;
|
|
FZeroEmpty: Boolean;
|
|
FEmptyValue: string;
|
|
FIsEmptyValue: Boolean;
|
|
FEnterText: string;
|
|
FDisplayPrefix: string;
|
|
FDisplaySuffix: string;
|
|
FCriticalPoints: TJvValidateEditCriticalPoints;
|
|
FStandardFontColor: TColor;
|
|
FAutoAlignment: Boolean;
|
|
FTrimDecimals: Boolean;
|
|
FOldFontChange: TNotifyEvent;
|
|
FOnIsValid: TJvCustomIsValidEvent;
|
|
FOnDecimalRounding: TJvCustomDecimalRoundingEvent;
|
|
FAllowEmpty: Boolean;
|
|
FEnforcingMinMaxValue: Boolean;
|
|
FForceDecimalSeparatorInput: Boolean;
|
|
FKeepPrefixSuffixIntact: Boolean;
|
|
FHidePrefixSuffixIfEmpty: Boolean;
|
|
FLastDownKey: Word;
|
|
FIsLoaded: Boolean;
|
|
procedure DisplayText;
|
|
function ScientificStrToFloat(SciString: string): Double;
|
|
procedure SetHasMaxValue(NewValue: Boolean);
|
|
procedure SetHasMinValue(NewValue: Boolean);
|
|
procedure SetMaxValue(NewValue: Double);
|
|
procedure SetMinValue(NewValue: Double);
|
|
procedure SetDecimalPlaces(NewValue: Cardinal);
|
|
procedure SetDisplayFormat(NewValue: TJvValidateEditDisplayFormat);
|
|
procedure SetZeroEmpty(NewValue: Boolean);
|
|
function GetAsInteger: Int64;
|
|
procedure SetAsInteger(NewValue: Int64);
|
|
function GetAsCurrency: Currency;
|
|
procedure SetAsCurrency(NewValue: Currency);
|
|
function GetAsFloat: Double;
|
|
procedure SetAsFloat(NewValue: Double);
|
|
function GetAsBcd: TBcd;
|
|
procedure SetAsBcd(const NewValue: TBcd);
|
|
function GetValue: Variant;
|
|
procedure SetValue(NewValue: Variant);
|
|
procedure SetCheckChars(const NewValue: string);
|
|
function IsCheckCharsStored: Boolean;
|
|
function CurrRangeValue(CheckValue: Currency): Currency;
|
|
function FloatRangeValue(CheckValue: Double): Double;
|
|
function IntRangeValue(CheckValue: Int64): Int64;
|
|
function BcdRangeValue(const CheckValue: TBcd): TBcd;
|
|
function GetEditText: string;
|
|
procedure SetEditText(const NewValue: string);
|
|
procedure ChangeText(const NewValue: string);
|
|
function BaseToInt(const BaseValue: string; Base: Byte): Int64;
|
|
function IntToBase(NewValue: Int64; Base: Byte): string;
|
|
procedure DoValueChanged;
|
|
procedure SetDisplayPrefix(const NewValue: string);
|
|
procedure SetDisplaySuffix(const NewValue: string);
|
|
procedure CriticalPointsChange(Sender: TObject);
|
|
procedure SetFontColor;
|
|
procedure FontChange(Sender: TObject);
|
|
procedure EnforceMaxValue;
|
|
procedure EnforceMinValue;
|
|
procedure SetTrimDecimals(const Value: Boolean);
|
|
function GetUnprefixedUnsuffixedText(const Value: string): string;
|
|
|
|
function GetText: TCaption;
|
|
procedure SetText(const NewValue: TCaption);
|
|
procedure SetEmptyValue(const AValue: String);
|
|
|
|
protected
|
|
function IsValidChar(const S: string; var Key: Char; Posn: Integer): Boolean; virtual;
|
|
function MakeValid(const ParseString: string): string;virtual;
|
|
procedure Change; override;
|
|
procedure DoEnter; override;
|
|
procedure DoExit; override;
|
|
function DoValidate(const Key: Char; const AText: string; const Posn: Integer): Boolean;
|
|
procedure Loaded; override;
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
procedure KeyPress(var Key: Char); override;
|
|
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
|
|
procedure WMPaste(var Msg: TLMessage); message LM_PASTE;
|
|
|
|
procedure DoEmptyValueEnter; virtual;
|
|
procedure DoEmptyValueExit; virtual;
|
|
|
|
(************************** NOT CONVERTED ***
|
|
function CreateDataConnector: TJvFieldDataConnector; override;
|
|
********************************************)
|
|
|
|
property CheckChars: string read FCheckChars write SetCheckChars stored IsCheckCharsStored;
|
|
property TrimDecimals: Boolean read FTrimDecimals write SetTrimDecimals;
|
|
property DecimalPlaces: Cardinal read FDecimalPlaces write SetDecimalPlaces;
|
|
property DisplayFormat: TJvValidateEditDisplayFormat read FDisplayFormat write SetDisplayFormat;
|
|
property EditText: string read GetEditText write SetEditText;
|
|
property HasMaxValue: Boolean read FHasMaxValue write SetHasMaxValue;
|
|
property HasMinValue: Boolean read FHasMinValue write SetHasMinValue;
|
|
property MaxValue: Double read FMaxValue write SetMaxValue;
|
|
property MinValue: Double read FMinValue write SetMinValue;
|
|
property Text: TCaption read GetText write SetText;
|
|
property OnCustomValidate: TJvCustomTextValidateEvent read FOnCustomValidate write FOnCustomValidate;
|
|
property OnValueChanged: TNotifyEvent read FOnValueChanged write FOnValueChanged;
|
|
property OnDecimalRounding: TJvCustomDecimalRoundingEvent read FOnDecimalRounding write FOnDecimalRounding;
|
|
property Value: Variant read GetValue write SetValue stored False;
|
|
property AllowEmpty: Boolean read FAllowEmpty write FAllowEmpty;
|
|
property ZeroEmpty: Boolean read FZeroEmpty write SetZeroEmpty;
|
|
property EmptyValue: string read FEmptyValue write SetEmptyValue;
|
|
property DisplayPrefix: string read FDisplayPrefix write SetDisplayPrefix;
|
|
property DisplaySuffix: string read FDisplaySuffix write SetDisplaySuffix;
|
|
property KeepPrefixSuffixIntact: Boolean read FKeepPrefixSuffixIntact write FKeepPrefixSuffixIntact default False;
|
|
property HidePrefixSuffixIfEmpty: Boolean read FHidePrefixSuffixIfEmpty write FHidePrefixSuffixIfEmpty default True;
|
|
property CriticalPoints: TJvValidateEditCriticalPoints read FCriticalPoints write FCriticalPoints;
|
|
property AutoAlignment: Boolean read FAutoAlignment write FAutoAlignment;
|
|
property OnIsValid: TJvCustomIsValidEvent read FOnIsValid write FOnIsValid;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
function IsValid: Boolean; virtual; // fires OnIsValid if assigned
|
|
function IsEmpty: Boolean; virtual; // override;
|
|
|
|
// When the DecimalSeparator variable has changed, one should call
|
|
// RecalcCheckChars to ensure that it contains the new value (Mantis 4682)
|
|
procedure RecalcCheckChars;
|
|
|
|
procedure Assign(Source: TPersistent); override;
|
|
property AsInteger: Int64 read GetAsInteger write SetAsInteger;
|
|
property AsCurrency: Currency read GetAsCurrency write SetAsCurrency;
|
|
property AsFloat: Double read GetAsFloat write SetAsFloat;
|
|
property AsBcd: TBcd read GetAsBcd write SetAsBcd;
|
|
|
|
// If true and the user presses the VK_DECIMAL key, the key read in KeyPress
|
|
// will always be replaced by the value of DecimalSeparator. This is made
|
|
// to overcome the problem where some keyboard layouts send "." instead of
|
|
// the decimal separator when using the decimal key on the numerical keypad.
|
|
// The most commonly encountered layout is the French AZERTY one.
|
|
// Note that this property will be set automatically to True by the
|
|
// constructor when the conversion of VK_DECIMAL into a character does not
|
|
// return the DecimalSeparator value
|
|
property ForceDecimalSeparatorInput: Boolean read FForceDecimalSeparatorInput write FForceDecimalSeparatorInput;
|
|
end;
|
|
|
|
TJvValidateEdit = class(TJvCustomValidateEdit)
|
|
published
|
|
property AllowEmpty default False;
|
|
property Align;
|
|
property Alignment default taRightJustify;
|
|
property Anchors;
|
|
property AutoAlignment default True;
|
|
|
|
property AutoSelect;
|
|
property AutoSize;
|
|
property BiDiMode;
|
|
property DragCursor;
|
|
property DragKind;
|
|
property ParentBiDiMode;
|
|
property OnEndDock;
|
|
property OnStartDock;
|
|
property BorderSpacing;
|
|
property BorderStyle;
|
|
property CheckChars;
|
|
property CharCase;
|
|
property Color;
|
|
property Constraints;
|
|
property CriticalPoints;
|
|
property TrimDecimals default False;
|
|
property DisplayFormat default dfInteger;
|
|
property DecimalPlaces default 0;
|
|
property DisplayPrefix;
|
|
property DisplaySuffix;
|
|
property DragMode;
|
|
property EditText;
|
|
property Enabled;
|
|
property Font;
|
|
property HasMaxValue default False;
|
|
property HasMinValue default False;
|
|
property HideSelection;
|
|
property MaxLength;
|
|
property MaxValue;
|
|
property MinValue;
|
|
property ParentColor;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PasswordChar;
|
|
property PopupMenu;
|
|
property ReadOnly;
|
|
property ShowHint;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property Text stored False;
|
|
property Value;
|
|
property Visible;
|
|
property ZeroEmpty default False;
|
|
property OnChange;
|
|
property OnClick;
|
|
property OnContextPopup;
|
|
property OnCustomValidate;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnStartDrag;
|
|
property OnValueChanged;
|
|
property OnIsValid;
|
|
property OnDecimalRounding;
|
|
property KeepPrefixSuffixIntact;
|
|
property HidePrefixSuffixIfEmpty;
|
|
|
|
{$IFDEF COMPILER12_UP}
|
|
//property NumbersOnly;
|
|
{$ENDIF}
|
|
{$IFDEF COMPILER14_UP}
|
|
property Touch;
|
|
{$ENDIF COMPILER14_UP}
|
|
property TextHint;
|
|
|
|
(************ NOT CONVERTED ***
|
|
property Flat;
|
|
property ImeMode;
|
|
property ImeName;
|
|
property OEMConvert;
|
|
property ParentFlat;
|
|
property BevelEdges;
|
|
property BevelInner;
|
|
property BevelKind default bkNone;
|
|
property BevelOuter;
|
|
property Caret;
|
|
property ClipboardCommands;
|
|
property DisabledColor;
|
|
property DisabledTextColor;
|
|
property DataConnector;
|
|
****************************)
|
|
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
Math, StrUtils, Variants,
|
|
JvJCLUtils, JvResources;
|
|
|
|
// JclStrings, JvJCLUtils, JvResources, JclSysUtils;
|
|
|
|
function IsGreater(Value, MaxValue: Double; MaxValueIncluded: Boolean): Boolean;
|
|
begin
|
|
if MaxValueIncluded then
|
|
Result := Value >= MaxValue
|
|
else
|
|
Result := Value > MaxValue;
|
|
end;
|
|
|
|
function IsLower(Value, MinValue: Double; MinValueIncluded: Boolean): Boolean;
|
|
begin
|
|
if MinValueIncluded then
|
|
Result := Value <= MinValue
|
|
else
|
|
Result := Value < MinValue;
|
|
end;
|
|
|
|
function BcdToStrFDefault(const Bcd: TBcd; DecimalPlaces: Integer): string;
|
|
begin
|
|
Result := BcdToStrF(Bcd, ffNumber, 64, DecimalPlaces);
|
|
end;
|
|
|
|
function BcdToInt64(const Bcd: TBcd; Truncate: Boolean = False): Int64;
|
|
var
|
|
ABcd: TBcd;
|
|
begin
|
|
if Truncate and (BcdScale(Bcd) > 0) then
|
|
NormalizeBcd(Bcd, ABcd{%H-}, Bcd.Precision, 0)
|
|
else
|
|
ABcd := Bcd;
|
|
Result := StrToInt64(BcdToStr(ABcd));
|
|
end;
|
|
|
|
function IsBcdZero(const Bcd: TBcd): Boolean;
|
|
var
|
|
I, Precision: Integer;
|
|
begin
|
|
Result := False;
|
|
I := 0;
|
|
Precision := Bcd.Precision;
|
|
while I < Precision div 2 do
|
|
begin
|
|
if Byte(Bcd.Fraction[I]) <> 0 then
|
|
Exit;
|
|
Inc(I);
|
|
end;
|
|
Result := (Precision mod 2 = 0) or (Byte(Bcd.Fraction[I]) shr 4 = 0);
|
|
end;
|
|
|
|
procedure ZeroBcd(var Bcd: TBcd);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Bcd.Precision := 10;
|
|
Bcd.SignSpecialPlaces := 2;
|
|
for I := 0 to 31 do
|
|
Bcd.Fraction[I] := 0;
|
|
end;
|
|
|
|
(************************** NOT CONVERTED ***
|
|
//=== { TJvValidateEditDataConnector } =======================================
|
|
|
|
procedure TJvValidateEditDataConnector.Assign(Source: TPersistent);
|
|
begin
|
|
inherited Assign(Source);
|
|
if Source is TJvFieldDataConnector then
|
|
begin
|
|
NullValue := TJvValidateEditDataConnector(Source).NullValue;
|
|
end;
|
|
end;
|
|
|
|
constructor TJvValidateEditDataConnector.Create(AEdit: TJvCustomValidateEdit);
|
|
begin
|
|
inherited Create;
|
|
FEdit := AEdit;
|
|
VarClear(FNullValue);
|
|
end;
|
|
|
|
function TJvValidateEditDataConnector.IsNullValueStored: Boolean;
|
|
begin
|
|
Result := not VarIsClear(NullValue);
|
|
end;
|
|
|
|
procedure TJvValidateEditDataConnector.RecordChanged;
|
|
begin
|
|
if Field.IsValid then
|
|
begin
|
|
FEdit.ReadOnly := not Field.CanModify;
|
|
if not Field.IsNull then
|
|
FEdit.Value := Field.Value
|
|
else
|
|
if NullValue <> Null then
|
|
FEdit.Value := NullValue
|
|
else
|
|
FEdit.Text := '';
|
|
end
|
|
else
|
|
begin
|
|
FEdit.Text := '';
|
|
FEdit.ReadOnly := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvValidateEditDataConnector.SetNullValue(const Value: Variant);
|
|
begin
|
|
if Value <> FNullValue then
|
|
begin
|
|
FNullValue := Value;
|
|
Reset;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvValidateEditDataConnector.UpdateData;
|
|
begin
|
|
if Field.CanModify and Field.IsValid then
|
|
begin
|
|
if FEdit.Value <> Null then
|
|
Field.Value := FEdit.Value
|
|
else
|
|
if NullValue <> Null then
|
|
Field.Value := FNullValue
|
|
else
|
|
RecordChanged;
|
|
end;
|
|
end;
|
|
*************************************)
|
|
|
|
//=== { TJvCustomValidateEdit } ==============================================
|
|
|
|
constructor TJvCustomValidateEdit.Create(AOwner: TComponent);
|
|
{
|
|
var
|
|
MappedDecimal: Cardinal;
|
|
const
|
|
MAPVK_VK_TO_CHAR = 2;
|
|
}
|
|
begin
|
|
inherited Create(AOwner);
|
|
FSelfChange := False;
|
|
FAutoAlignment := True;
|
|
FCriticalPoints := TJvValidateEditCriticalPoints.Create;
|
|
FCriticalPoints.OnChange := @CriticalPointsChange;
|
|
FDisplayFormat := dfInteger;
|
|
FCheckChars := '01234567890';
|
|
Alignment := taRightJustify;
|
|
FEditText := '';
|
|
Text := ''; // doesn't trigger OnChange because FEnterText = ''. That's what we want.
|
|
AutoSize := True;
|
|
FMinValue := 0;
|
|
FMaxValue := 0;
|
|
FHasMinValue := False;
|
|
FHasMaxValue := False;
|
|
FZeroEmpty := False;
|
|
FHidePrefixSuffixIfEmpty := True;
|
|
FStandardFontColor := Font.Color;
|
|
FOldFontChange := Font.OnChange;
|
|
Font.OnChange := @FontChange;
|
|
|
|
(******************** To DO ***********
|
|
MappedDecimal := MapVirtualKey(VK_DECIMAL, MAPVK_VK_TO_CHAR);
|
|
if MappedDecimal <> 0 then
|
|
FForceDecimalSeparatorInput := Char(MappedDecimal) <> JclFormatSettings.DecimalSeparator;
|
|
**********************************)
|
|
end;
|
|
|
|
destructor TJvCustomValidateEdit.Destroy;
|
|
begin
|
|
FreeAndNil(FCriticalPoints);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.Assign(Source: TPersistent);
|
|
var
|
|
lcSource: TJvCustomValidateEdit;
|
|
begin
|
|
if Source is TJvCustomValidateEdit then
|
|
begin
|
|
lcSource := TJvCustomValidateEdit(Source);
|
|
CriticalPoints.Assign(lcSource.CriticalPoints);
|
|
DisplayFormat := lcSource.DisplayFormat;
|
|
DecimalPlaces := lcSource.DecimalPlaces;
|
|
MinValue := lcSource.MinValue;
|
|
MaxValue := lcSource.MaxValue;
|
|
HasMinValue := lcSource.HasMinValue;
|
|
HasMaxValue := lcSource.HasMaxValue;
|
|
ZeroEmpty := lcSource.ZeroEmpty;
|
|
AllowEmpty := lcSource.AllowEmpty;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.Loaded;
|
|
begin
|
|
EditText := FEditText;
|
|
inherited Loaded;
|
|
FIsLoaded := True;
|
|
(**************** NOT CONVERTED ***
|
|
FOldFontColor := Font.Color;
|
|
SelStart := FStreamedSelStart;
|
|
SelLength := FStreamedSelLength;
|
|
**********************)
|
|
end;
|
|
|
|
(****************************** NOT CONVERTED ***
|
|
function TJvCustomValidateEdit.CreateDataConnector: TJvFieldDataConnector;
|
|
begin
|
|
Result := TJvValidateEditDataConnector.Create(Self);
|
|
end;
|
|
*******************************************************)
|
|
|
|
procedure TJvCustomValidateEdit.SetHasMaxValue(NewValue: Boolean);
|
|
begin
|
|
if FHasMaxValue <> NewValue then
|
|
begin
|
|
FHasMaxValue := NewValue;
|
|
if not (csLoading in ComponentState) then
|
|
EnforceMaxValue;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.SetHasMinValue(NewValue: Boolean);
|
|
begin
|
|
if FHasMinValue <> NewValue then
|
|
begin
|
|
FHasMinValue := NewValue;
|
|
if not (csLoading in ComponentState) then
|
|
EnforceMinValue;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.SetMaxValue(NewValue: Double);
|
|
begin
|
|
if FMaxValue <> NewValue then
|
|
begin
|
|
FMaxValue := NewValue;
|
|
{ make MinValue consistent }
|
|
if FMinValue > FMaxValue then
|
|
FMinValue := FMaxValue;
|
|
if not (csLoading in ComponentState) then
|
|
EnforceMaxValue;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.SetMinValue(NewValue: Double);
|
|
begin
|
|
if FMinValue <> NewValue then
|
|
begin
|
|
FMinValue := NewValue;
|
|
{ make MaxValue consistent }
|
|
if FMaxValue < FMinValue then
|
|
FMaxValue := FMinValue;
|
|
if not (csLoading in ComponentState) then
|
|
EnforceMinValue;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.SetTrimDecimals(const Value: Boolean);
|
|
begin
|
|
if Value <> FTrimDecimals then
|
|
begin
|
|
FTrimDecimals := Value;
|
|
if not (csLoading in ComponentState) then
|
|
EditText := FEditText;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.SetDecimalPlaces(NewValue: Cardinal);
|
|
begin
|
|
if ControlState = [csReadingState] then
|
|
FDecimalPlaces := NewValue
|
|
else
|
|
if FDisplayFormat in [dfCurrency, dfFloat, dfFloatGeneral, dfScientific, dfPercent, dfFloatFixed, dfBcd] then
|
|
FDecimalPlaces := NewValue;
|
|
if not (csLoading in ComponentState) then
|
|
EditText := FEditText;
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.SetDisplayFormat(NewValue: TJvValidateEditDisplayFormat);
|
|
var
|
|
OldFormat: TJvValidateEditDisplayFormat;
|
|
begin
|
|
if FDisplayFormat <> NewValue then
|
|
begin
|
|
OldFormat := FDisplayFormat;
|
|
FDisplayFormat := NewValue;
|
|
|
|
RecalcCheckChars;
|
|
|
|
case FDisplayFormat of
|
|
dfAlphabetic, dfAlphaNumeric, dfIdentifier,
|
|
dfCheckChars, dfNonCheckChars, dfCustom, dfNone:
|
|
if FAutoAlignment then
|
|
Alignment := taLeftJustify;
|
|
dfCurrency:
|
|
begin
|
|
if FAutoAlignment then
|
|
Alignment := taRightJustify;
|
|
if not (csLoading in ComponentState) then
|
|
if FDecimalPlaces = 0 then
|
|
FDecimalPlaces := FormatSettings.CurrencyDecimals;
|
|
end;
|
|
dfBinary, dfFloat, dfFloatGeneral, dfPercent, dfDecimal, dfHex,
|
|
dfInteger, dfOctal, dfScientific, dfFloatFixed, dfBcd:
|
|
if FAutoAlignment then
|
|
Alignment := taRightJustify;
|
|
dfYear:
|
|
begin
|
|
if FAutoAlignment then
|
|
Alignment := taRightJustify;
|
|
MaxLength := 4;
|
|
end;
|
|
end;
|
|
|
|
if OldFormat = dfYear then
|
|
MaxLength := 0;
|
|
|
|
if not IsEmpty then
|
|
begin
|
|
// Convert non-base 10 numbers to base 10 and base-10 numbers to non-base 10
|
|
if (OldFormat = dfBinary) and
|
|
(NewValue in [dfCurrency, dfFloat, dfFloatGeneral, dfDecimal, dfHex, dfInteger, dfOctal, dfPercent, dfScientific, dfYear, dfFloatFixed, dfBcd]) then
|
|
SetAsInteger(BaseToInt(FEditText, 2))
|
|
else
|
|
if (OldFormat in [dfCurrency, dfFloat, dfFloatGeneral, dfDecimal, dfPercent, dfFloatFixed, dfBcd]) and
|
|
(NewValue in [dfBinary, dfHex, dfOctal])
|
|
then
|
|
SetAsfloat(StrToFloatDef(FEditText, 0))
|
|
// SetAsFloat(JvSafeStrToFloatDef(FEditText, 0))
|
|
else
|
|
if (OldFormat = dfHex) and
|
|
(NewValue in [dfBinary, dfCurrency, dfFloat, dfFloatGeneral, dfDecimal, dfInteger, dfOctal, dfPercent, dfScientific, dfYear, dfFloatFixed, dfBcd]) then
|
|
SetAsInteger(BaseToInt(FEditText, 16))
|
|
else
|
|
if (OldFormat in [dfInteger, dfYear]) and
|
|
(NewValue in [dfBinary, dfHex, dfOctal]) then
|
|
SetAsInteger(StrToIntDef(FEditText, 0))
|
|
else
|
|
if (OldFormat = dfOctal) and
|
|
(NewValue in [dfBinary, dfCurrency, dfFloat, dfFloatGeneral, dfDecimal, dfHex, dfInteger, dfPercent, dfScientific, dfYear, dfFloatFixed, dfBcd]) then
|
|
SetAsInteger(BaseToInt(FEditText, 8))
|
|
else
|
|
begin
|
|
// ...or just display the value
|
|
if not (csLoading in ComponentState) then
|
|
EditText := FEditText;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.SetZeroEmpty(NewValue: Boolean);
|
|
begin
|
|
if FZeroEmpty <> NewValue then
|
|
begin
|
|
FZeroEmpty := NewValue;
|
|
if not (csLoading in ComponentState) then
|
|
EditText := FEditText;
|
|
end;
|
|
end;
|
|
|
|
function TJvCustomValidateEdit.GetAsInteger: Int64;
|
|
begin
|
|
case FDisplayFormat of
|
|
dfBinary:
|
|
Result := BaseToInt(FEditText, 2);
|
|
dfHex:
|
|
Result := BaseToInt(FEditText, 16);
|
|
dfOctal:
|
|
Result := BaseToInt(FEditText, 8);
|
|
else
|
|
Result := StrToInt64Def(FEditText, 0);
|
|
end;
|
|
Result := IntRangeValue(Result);
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.SetAsInteger(NewValue: Int64);
|
|
begin
|
|
case FDisplayFormat of
|
|
dfAlphabetic, dfAlphaNumeric, dfCheckChars, dfIdentifier, dfCustom,
|
|
dfNonCheckChars, dfNone:
|
|
EditText := IntToStr(NewValue);
|
|
dfBinary:
|
|
EditText := IntToBase(NewValue, 2);
|
|
dfHex:
|
|
EditText := IntToBase(NewValue, 16);
|
|
dfOctal:
|
|
EditText := IntToBase(NewValue, 8);
|
|
dfCurrency, dfFloat, dfFloatGeneral, dfDecimal, dfInteger, dfPercent, dfScientific, dfYear, dfFloatFixed, dfBcd:
|
|
EditText := IntToStr(IntRangeValue(NewValue));
|
|
end;
|
|
end;
|
|
|
|
function TJvCustomValidateEdit.GetAsCurrency: Currency;
|
|
begin
|
|
case FDisplayFormat of
|
|
dfBinary:
|
|
Result := BaseToInt(FEditText, 2);
|
|
dfHex:
|
|
Result := BaseToInt(FEditText, 16);
|
|
dfOctal:
|
|
Result := BaseToInt(FEditText, 8);
|
|
else
|
|
Result := StrToCurrDef(FEditText, 0);
|
|
end;
|
|
Result := CurrRangeValue(Result);
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.SetAsCurrency(NewValue: Currency);
|
|
begin
|
|
case FDisplayFormat of
|
|
dfAlphabetic, dfAlphaNumeric, dfCheckChars, dfIdentifier, dfCustom,
|
|
dfNonCheckChars, dfNone:
|
|
EditText := CurrToStr(NewValue);
|
|
dfBinary:
|
|
EditText := IntToBase(Trunc(NewValue), 2);
|
|
dfHex:
|
|
EditText := IntToBase(Trunc(NewValue), 16);
|
|
dfOctal:
|
|
EditText := IntToBase(Trunc(NewValue), 8);
|
|
dfCurrency, dfFloat, dfFloatGeneral, dfDecimal, dfInteger, dfPercent, dfScientific, dfYear, dfFloatFixed, dfBcd:
|
|
EditText := CurrToStr(CurrRangeValue(NewValue));
|
|
end;
|
|
end;
|
|
|
|
function TJvCustomValidateEdit.GetAsFloat: Double;
|
|
//var
|
|
// Cur: Currency;
|
|
begin
|
|
case FDisplayFormat of
|
|
dfBinary:
|
|
Result := BaseToInt(FEditText, 2);
|
|
dfHex:
|
|
Result := BaseToInt(FEditText, 16);
|
|
dfOctal:
|
|
Result := BaseToInt(FEditText, 8);
|
|
dfScientific:
|
|
Result := ScientificStrToFloat(FEditText);
|
|
dfCurrency:
|
|
begin
|
|
// Mantis 3494: The Edit text may contain extra characters such as
|
|
// parenthesis that indicate the amount is negative. Using StrToFloatDef
|
|
// would not catch the negative part, hence the need to use a function
|
|
// that knows how to do the conversion.
|
|
|
|
//VarCyFromStr({$IFDEF RTL240_UP}PChar{$ENDIF RTL240_UP}(FEditText), LOCALE_USER_DEFAULT, 0, Cur);
|
|
//Result := Cur;
|
|
|
|
{ Laz workaround...}
|
|
Result := StrToCurrDef(FEditText, 0);
|
|
end;
|
|
dfBcd:
|
|
Result := BcdToDouble(AsBcd);
|
|
else
|
|
Result := StrToFloatDef(FEditText, 0); //, JvSafeStrToFloatDef(FEditText, 0);
|
|
end;
|
|
Result := FloatRangeValue(Result);
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.SetAsFloat(NewValue: Double);
|
|
begin
|
|
case FDisplayFormat of
|
|
dfAlphabetic, dfAlphaNumeric, dfCheckChars, dfIdentifier, dfCustom,
|
|
dfNonCheckChars, dfNone:
|
|
EditText := FloatToStr(NewValue);
|
|
dfBinary:
|
|
EditText := IntToBase(Trunc(NewValue), 2);
|
|
dfHex:
|
|
EditText := IntToBase(Trunc(NewValue), 16);
|
|
dfOctal:
|
|
EditText := IntToBase(Trunc(NewValue), 8);
|
|
dfInteger, dfYear:
|
|
EditText := IntToStr(IntRangeValue(Trunc(NewValue)));
|
|
dfCurrency:
|
|
EditText := Format('%.*m', [FDecimalPlaces, FloatRangeValue(NewValue)]);
|
|
dfFloat, dfPercent:
|
|
EditText := Format('%.*n', [FDecimalPlaces, FloatRangeValue(NewValue)]);
|
|
dfFloatGeneral:
|
|
EditText := Format('%.*g', [FDecimalPlaces, FloatRangeValue(NewValue)]);
|
|
dfFloatFixed:
|
|
EditText := Format('%.*f', [FDecimalPlaces, FloatRangeValue(NewValue)]);
|
|
dfDecimal:
|
|
EditText := FloatToStr(FloatRangeValue(NewValue));
|
|
dfScientific:
|
|
EditText := Format('%e', [FloatRangeValue(NewValue)]);
|
|
dfBcd:
|
|
EditText := BcdToStrFDefault(DoubleToBcd(FloatRangeValue(NewValue)), FDecimalPlaces);
|
|
end;
|
|
end;
|
|
|
|
function TJvCustomValidateEdit.GetAsBcd: TBcd;
|
|
var
|
|
IntValue: Int64;
|
|
begin
|
|
case FDisplayFormat of
|
|
dfBinary, dfHex, dfOctal:
|
|
begin
|
|
IntValue := GetAsInteger;
|
|
if Abs(IntValue) < MaxInt then
|
|
Result := IntegerToBcd(IntValue)
|
|
else
|
|
Result := StrToBcd(IntToStr(IntValue));
|
|
end;
|
|
dfScientific:
|
|
Result := DoubleToBcd(ScientificStrToFloat(FEditText));
|
|
dfCurrency:
|
|
CurrToBCD(GetAsCurrency, Result);
|
|
dfFloat, dfFloatGeneral, dfFloatFixed:
|
|
Result := DoubleToBcd(AsFloat);
|
|
else
|
|
if not TryStrToBcd(FEditText, Result) then
|
|
ZeroBcd(Result);
|
|
end;
|
|
Result := BcdRangeValue(Result);
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.SetAsBcd(const NewValue: TBcd);
|
|
begin
|
|
case FDisplayFormat of
|
|
dfAlphabetic, dfAlphaNumeric, dfCheckChars, dfIdentifier, dfCustom,
|
|
dfNonCheckChars, dfNone:
|
|
EditText := BcdToStrFDefault(NewValue, FDecimalPlaces);
|
|
dfBinary:
|
|
EditText := IntToBase(BcdToInt64(NewValue), 2);
|
|
dfHex:
|
|
EditText := IntToBase(BcdToInt64(NewValue), 16);
|
|
dfOctal:
|
|
EditText := IntToBase(BcdToInt64(NewValue), 8);
|
|
dfInteger, dfYear:
|
|
EditText := IntToStr(IntRangeValue(BcdToInt64(NewValue)));
|
|
dfCurrency:
|
|
EditText := Format('%.*m', [FDecimalPlaces, FloatRangeValue(BcdToDouble(NewValue))]);
|
|
dfFloat, dfPercent:
|
|
EditText := Format('%.*n', [FDecimalPlaces, FloatRangeValue(BcdToDouble(NewValue))]);
|
|
dfFloatGeneral:
|
|
EditText := Format('%.*g', [FDecimalPlaces, FloatRangeValue(BcdToDouble(NewValue))]);
|
|
dfFloatFixed:
|
|
EditText := Format('%.*f', [FDecimalPlaces, FloatRangeValue(BcdToDouble(NewValue))]);
|
|
dfDecimal:
|
|
EditText := FloatToStr(FloatRangeValue(BcdToDouble(NewValue)));
|
|
dfScientific:
|
|
EditText := Format('%e', [FloatRangeValue(BcdToDouble(NewValue))]);
|
|
dfBcd:
|
|
EditText := BcdToStrFDefault(BcdRangeValue(NewValue), FDecimalPlaces);
|
|
end;
|
|
end;
|
|
|
|
function TJvCustomValidateEdit.GetValue: Variant;
|
|
var
|
|
DisplayedText: string;
|
|
//Cur: Currency;
|
|
Bcd: TBcd;
|
|
begin
|
|
case FDisplayFormat of
|
|
dfCurrency:
|
|
begin
|
|
// Mantis 3494: The Edit text may contain extra characters such as
|
|
// parenthesis that indicate the amount is negative. Using StrToFloatDef
|
|
// would not catch the negative part, hence the need to use a function
|
|
// that knows how to do the conversion.
|
|
//VarCyFromStr({$IFDEF RTL240_UP}PChar{$ENDIF RTL240_UP}(FEditText), LOCALE_USER_DEFAULT, 0, Cur);
|
|
//Result := CurrRangeValue(Cur);
|
|
|
|
// Laz work-around
|
|
Result := CurrRangeValue(StrToCurrDef(FEditText, 0));
|
|
end;
|
|
dfFloat, dfFloatGeneral, dfDecimal, dfPercent, dfScientific, dfFloatFixed:
|
|
Result := FloatRangeValue(StrToFloatDef(FEditText, 0));
|
|
// Result := FloatRangeValue(JvSafeStrToFloatDef(FEditText, 0));
|
|
dfInteger, dfYear:
|
|
Result := IntRangeValue(StrToIntDef(FEditText, 0));
|
|
dfHex:
|
|
Result := IntRangeValue(StrToIntDef('$' + FEditText, 0));
|
|
dfBcd:
|
|
if TryStrToBcd(FEditText, Bcd{%H-}) then
|
|
Result := VarFMTBcdCreate(Bcd)
|
|
else
|
|
Result := VarFMTBcdCreate; // Null
|
|
else
|
|
DisplayedText := inherited Text;
|
|
|
|
// Remove DisplayPrefix and DisplaySuffix
|
|
DisplayedText := StrEnsureNoPrefix(DisplayPrefix, DisplayedText);
|
|
DisplayedText := StrEnsureNoSuffix(DisplaySuffix, DisplayedText);
|
|
Result := DisplayedText;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.SetValue(NewValue: Variant);
|
|
begin
|
|
if AllowEmpty and (VarIsNull(NewValue) or VarIsEmpty(NewValue)) then
|
|
Clear
|
|
else
|
|
case FDisplayFormat of
|
|
dfAlphabetic, dfAlphaNumeric, dfCheckChars, dfNonCheckChars, dfIdentifier, dfNone, dfCustom:
|
|
EditText := NewValue;
|
|
dfBinary, dfHex, dfInteger, dfOctal, dfYear:
|
|
SetAsInteger(NewValue);
|
|
dfCurrency, dfFloat, dfDecimal, dfFloatGeneral, dfPercent, dfScientific, dfFloatFixed:
|
|
SetAsFloat(NewValue);
|
|
dfBcd:
|
|
if VarIsFMTBcd(NewValue) then
|
|
SetAsBcd(VarToBcd(NewValue))
|
|
else
|
|
SetAsBcd(StrToBcd(VarToStr(NewValue)));
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.SetCheckChars(const NewValue: string);
|
|
begin
|
|
if (csLoading in ComponentState) or
|
|
((FDisplayFormat in [dfNone, dfCheckChars, dfNonCheckChars]) and
|
|
(FCheckChars <> NewValue)) then
|
|
begin
|
|
FCheckChars := NewValue;
|
|
EditText := MakeValid(FEditText);
|
|
end;
|
|
end;
|
|
|
|
function TJvCustomValidateEdit.IsCheckCharsStored: Boolean;
|
|
begin
|
|
Result := (FDisplayFormat in [dfNone, dfCheckChars, dfNonCheckChars]);
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.KeyPress(var Key: Char);
|
|
var
|
|
StrippedText: string;
|
|
begin
|
|
// Mantis 4952:
|
|
// - Must not take the prefix/suffix into account when checking a character's validity
|
|
// - Must not take into account the CurrencyString into account when checking a character's validity
|
|
StrippedText := GetUnprefixedUnsuffixedText(Text);
|
|
|
|
if not IsValidChar(StrippedText, Key, SelStart + 1) and (Key >= #32) then
|
|
Key := #0;
|
|
inherited KeyPress(Key);
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.KeyUp(var Key: Word; Shift: TShiftState);
|
|
begin
|
|
FLastDownKey := 0;
|
|
inherited KeyUp(Key, Shift);
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.WMPaste(var Msg: TLMessage);
|
|
begin
|
|
inherited;
|
|
EditText := MakeValid(GetUnprefixedUnsuffixedText(inherited Text));
|
|
end;
|
|
|
|
function TJvCustomValidateEdit.MakeValid(const ParseString: string): string;
|
|
var
|
|
C: Char;
|
|
I: Integer;
|
|
L: Integer;
|
|
begin
|
|
SetLength(Result, Length(ParseString));
|
|
L := 0;
|
|
for I := 1 to Length(ParseString) do
|
|
begin
|
|
C := ParseString[I];
|
|
if IsValidChar(Copy(ParseString, 1, I - 1), C, I) then
|
|
begin
|
|
Result[L + 1] := C;
|
|
Inc(L);
|
|
end;
|
|
end;
|
|
SetLength(Result, L);
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.RecalcCheckChars;
|
|
const
|
|
Alphabet = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
|
|
Numbers = '0123456789';
|
|
begin
|
|
case FDisplayFormat of
|
|
dfAlphabetic:
|
|
FCheckChars := Alphabet;
|
|
dfAlphaNumeric:
|
|
FCheckChars := Alphabet + Numbers;
|
|
dfIdentifier:
|
|
FCheckChars := Alphabet + Numbers + '_';
|
|
dfBinary:
|
|
FCheckChars := '01';
|
|
dfCustom, dfNone:
|
|
if (FDisplayFormat = dfCustom) or not (csLoading in ComponentState) then
|
|
FCheckChars := '';
|
|
dfCurrency,
|
|
dfFloat, dfFloatGeneral, dfPercent, dfDecimal, dfFloatFixed, dfBcd:
|
|
FCheckChars := Numbers + FormatSettings.DecimalSeparator;
|
|
dfHex:
|
|
FCheckChars := Numbers + 'ABCDEFabcdef';
|
|
dfInteger, dfYear:
|
|
FCheckChars := Numbers;
|
|
dfOctal:
|
|
FCheckChars := '01234567';
|
|
dfScientific:
|
|
FCheckChars := Numbers + 'Ee' + FormatSettings.DecimalSeparator;
|
|
end;
|
|
end;
|
|
|
|
function TJvCustomValidateEdit.IsValidChar(const S: string;
|
|
var Key: Char; Posn: Integer): Boolean;
|
|
var
|
|
iPosE: Integer;
|
|
ExpectedNegPos: Integer;
|
|
ExpectedNegChar: Char;
|
|
begin
|
|
if (FLastDownKey = VK_DECIMAL) and ForceDecimalSeparatorInput then
|
|
Key := FormatSettings.DecimalSeparator;
|
|
|
|
case FDisplayFormat of
|
|
dfBinary, dfCheckChars, dfHex, dfOctal, dfYear:
|
|
Result := Pos(Key, FCheckChars) > 0;
|
|
dfAlphabetic:
|
|
Result := IsCharAlpha(Key);
|
|
dfAlphaNumeric:
|
|
Result := IsCharAlphaNumeric(Key);
|
|
dfCustom:
|
|
Result := DoValidate(Key, S, Posn);
|
|
dfInteger:
|
|
Result := (Pos(Key, FCheckChars) > 0) or
|
|
((Key = '+') and (Posn = 1) and ((Pos('+', S) = 0) or (SelLength > 0))) or
|
|
((Key = '-') and (Posn = 1) and ((Pos('-', S) = 0) or (SelLength > 0)));
|
|
dfFloat, dfFloatGeneral, dfDecimal, dfPercent, dfFloatFixed, dfBcd:
|
|
Result := ((Pos(Key, FCheckChars) > 0) and
|
|
(((Key = FormatSettings.DecimalSeparator) and (Pos(FormatSettings.DecimalSeparator, S) = 0)) or (Key <> FormatSettings.DecimalSeparator))) or
|
|
((Key = '+') and (Posn = 1) and ((Pos('+', S) = 0) or (SelLength > 0))) or
|
|
((Key = '-') and (Posn = 1) and ((Pos('-', S) = 0) or (SelLength > 0)));
|
|
dfCurrency:
|
|
begin
|
|
// The currency negative format can be quite complicated. The current
|
|
// one is indicated by the value of NegCurrFormat, and can have any
|
|
// value from 0 to 15 according to the MSDN and Delphi's help.
|
|
// So we must take into account that some format require the negative
|
|
// sign to be at the end, while some others replace it by parenthesis.
|
|
// See http://www.delphibasics.co.uk/RTL.asp?Name=NegCurrFormat for
|
|
// an online version of Delphi's help.
|
|
// If we were not to use this, it would trigger Mantis 3494, where
|
|
// the number would go from negative to positive simply by focusing out
|
|
// of the control.
|
|
ExpectedNegChar := '-';
|
|
ExpectedNegPos := 1;
|
|
case FormatSettings.NegCurrFormat of
|
|
0, 4, 14, 15:
|
|
begin
|
|
ExpectedNegPos := 1;
|
|
ExpectedNegChar := '(';
|
|
end;
|
|
1, 5, 8, 9:
|
|
ExpectedNegPos := 1;
|
|
2:
|
|
ExpectedNegPos := 2;
|
|
3, 7, 10, 11:
|
|
ExpectedNegPos := Length(S);
|
|
6:
|
|
ExpectedNegPos := Length(S) - 1;
|
|
12:
|
|
ExpectedNegPos := 3;
|
|
13:
|
|
ExpectedNegPos := Length(S) - 2;
|
|
end;
|
|
|
|
if (Key = '(') and (Posn = 1) and (FormatSettings.NegCurrFormat in [0, 4, 14, 15]) then
|
|
Key := '-';
|
|
|
|
Result := ((Pos(Key, FCheckChars) > 0) and
|
|
(((Key = FormatSettings.DecimalSeparator) and (Pos(FormatSettings.DecimalSeparator, S) = 0)) or
|
|
(Key <> FormatSettings.DecimalSeparator))) or
|
|
((Key = '+') and (Posn = 1) and ((Pos('+', S) = 0) or (SelLength > 0))) or
|
|
((Key = '-') and (Posn = ExpectedNegPos) and ((Pos(ExpectedNegChar, S) = 0) or
|
|
(SelLength > 0)));
|
|
end;
|
|
dfNonCheckChars:
|
|
Result := Pos(Key, FCheckChars) = 0;
|
|
dfNone:
|
|
Result := True;
|
|
dfScientific:
|
|
begin
|
|
Result := (Pos(Key, FCheckChars) > 0) or CharInSet(Key, ['+', '-']);
|
|
if Result then
|
|
begin
|
|
iPosE := Pos('e', LowerCase(S));
|
|
if Key = FormatSettings.DecimalSeparator then
|
|
begin
|
|
if iPosE = 0 then
|
|
Result := (Pos(FormatSettings.DecimalSeparator, S) = 0)
|
|
else
|
|
Result := ((Posn <= iPosE) and (Pos(FormatSettings.DecimalSeparator, Copy(S, 1, iPosE - 1)) = 0));
|
|
//or ((Posn > iPosE) and (Pos(DecimalSeparator, Copy(S, iPosE + 1, Length(S))) = 0));
|
|
// (outchy) XXXeY,YY are not valid scientific numbers, Y must be an integer value
|
|
end
|
|
else
|
|
if CharInSet(Key, ['E', 'e']) then
|
|
Result := (iPosE = 0) and (Posn > 1)
|
|
else
|
|
if Key = '+' then
|
|
Result := (Posn = 1) or (Posn = iPosE + 1)
|
|
else
|
|
if Key = '-' then
|
|
Result := (Posn = 1) or (Posn = iPosE + 1);
|
|
end;
|
|
end;
|
|
dfIdentifier:
|
|
begin
|
|
if Posn = 1 then
|
|
Result := (Key = '_') or (IsCharAlpha(Key))
|
|
else
|
|
Result := Pos(Key, FCheckChars) > 0;
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
function TJvCustomValidateEdit.DoValidate(const Key: Char;
|
|
const AText: string; const Posn: Integer): Boolean;
|
|
begin
|
|
Result := True;
|
|
if Assigned(FOnCustomValidate) then
|
|
FOnCustomValidate(Self, Key, AText, Posn, Result);
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.KeyDown(var Key: Word; Shift: TShiftState);
|
|
begin
|
|
FLastDownKey := Key;
|
|
// if Key = VK_DELETE then EditText := MakeValid(inherited Text);
|
|
if Key = VK_ESCAPE then
|
|
begin
|
|
Key := 0;
|
|
EditText := FEnterText;
|
|
SelStart := 0;
|
|
SelLength := Length(FEditText);
|
|
end;
|
|
inherited KeyDown(Key, Shift);
|
|
end;
|
|
|
|
function TJvCustomValidateEdit.CurrRangeValue(CheckValue: Currency): Currency;
|
|
begin
|
|
Result := CheckValue;
|
|
if FHasMaxValue and (CheckValue > FMaxValue) then
|
|
Result := FMaxValue
|
|
else
|
|
if FHasMinValue and (CheckValue < FMinValue) then
|
|
Result := FMinValue;
|
|
end;
|
|
|
|
function TJvCustomValidateEdit.FloatRangeValue(CheckValue: Double): Double;
|
|
begin
|
|
Result := CheckValue;
|
|
if FHasMaxValue and (CheckValue > FMaxValue) then
|
|
Result := FMaxValue
|
|
else
|
|
if FHasMinValue and (CheckValue < FMinValue) then
|
|
Result := FMinValue;
|
|
end;
|
|
|
|
function TJvCustomValidateEdit.IntRangeValue(CheckValue: Int64): Int64;
|
|
begin
|
|
Result := CheckValue;
|
|
if FHasMaxValue and (CheckValue > FMaxValue) then
|
|
Result := Trunc(FMaxValue)
|
|
else
|
|
if FHasMinValue and (CheckValue < FMinValue) then
|
|
Result := Trunc(FMinValue);
|
|
end;
|
|
|
|
function TJvCustomValidateEdit.BcdRangeValue(const CheckValue: TBcd): TBcd;
|
|
begin
|
|
Result := CheckValue;
|
|
if FHasMaxValue and (BcdCompare(CheckValue, DoubleToBcd(FMaxValue)) = 1) then // CheckValue > FMaxValue
|
|
Result := DoubleToBcd(FMaxValue)
|
|
else
|
|
if FHasMinValue and (BcdCompare(CheckValue, DoubleToBcd(FMinValue)) = -1) then // CheckValue < FMinValue
|
|
Result := DoubleToBcd(FMinValue);
|
|
end;
|
|
|
|
function TJvCustomValidateEdit.GetEditText: string;
|
|
begin
|
|
Result := FEditText;
|
|
end;
|
|
|
|
function TJvCustomValidateEdit.GetUnprefixedUnsuffixedText(const Value: string): string;
|
|
begin
|
|
if not FKeepPrefixSuffixIntact then
|
|
begin
|
|
Result := StrEnsureNoPrefix(DisplayPrefix, StrEnsureNoSuffix(DisplaySuffix, Value));
|
|
Result := StrEnsureNoPrefix(FormatSettings.CurrencyString, StrEnsureNoSuffix(FormatSettings.CurrencyString, Result));
|
|
end
|
|
else
|
|
Result := Value;
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.SetEditText(const NewValue: string);
|
|
begin
|
|
FEditText := MakeValid(GetUnprefixedUnsuffixedText(NewValue));
|
|
if (FDisplayFormat = dfYear) and ((not FHasMaxValue) or
|
|
(FHasMaxValue and (FMaxValue > 2000 + FormatSettings.TwoDigitYearCenturyWindow))) and
|
|
((MaxLength = 0) or (MaxLength > 3)) then
|
|
FEditText := IntToStr(MakeYear4Digit(StrToIntDef(FEditText, 0), FormatSettings.TwoDigitYearCenturyWindow));
|
|
if (FDisplayFormat in [dfBinary, dfCurrency, dfFloat, dfFloatGeneral, dfDecimal, dfHex, dfInteger,
|
|
dfOctal, dfPercent, dfScientific, dfYear, dfFloatFixed, dfBcd]) then
|
|
begin
|
|
EnforceMaxValue;
|
|
EnforceMinValue;
|
|
end;
|
|
// ChangeText(FEditText);
|
|
DisplayText;
|
|
DoValueChanged;
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.DoEnter;
|
|
//procedure TJvCustomValidateEdit.FocusSet(PrevWnd: THandle);
|
|
begin
|
|
DisplayText;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.DoExit;
|
|
//procedure TJvCustomValidateEdit.FocusKilled(NextWnd: THandle);
|
|
var
|
|
DisplayedText: string;
|
|
begin
|
|
if not (csDestroying in ComponentState) then
|
|
begin
|
|
DisplayedText := inherited Text;
|
|
EditText := GetUnprefixedUnsuffixedText(DisplayedText);
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.ChangeText(const NewValue: string);
|
|
var
|
|
S, Exponent, DisplayValue: string;
|
|
Ps, I: Integer;
|
|
begin
|
|
FSelfChange := True;
|
|
try
|
|
Ps := 0;
|
|
if TrimDecimals then
|
|
begin
|
|
I := Pos('e', LowerCase(NewValue));
|
|
if (DisplayFormat = dfScientific) and (I <> 0) then
|
|
begin
|
|
Exponent := Copy(NewValue, I, Length(NewValue));
|
|
Dec(I);
|
|
end
|
|
else
|
|
begin
|
|
Exponent := '';
|
|
I := Length(NewValue);
|
|
end;
|
|
Ps := Pos(FormatSettings.DecimalSeparator, NewValue);
|
|
if Ps > 0 then
|
|
begin
|
|
while (I > Ps) and (NewValue[I] = '0') do
|
|
Dec(I);
|
|
if Ps = I then
|
|
Dec(I); // skip decimal separator (Ivo Bauer)
|
|
S := FDisplayPrefix + Copy(NewValue, 1, I) + Exponent + FDisplaySuffix;
|
|
|
|
DisplayValue := Copy(NewValue, 1, I);
|
|
if HidePrefixSuffixIfEmpty and (DisplayValue = '') and (Exponent = '') then
|
|
S := ''
|
|
else
|
|
S := FDisplayPrefix + DisplayValue + Exponent + FDisplaySuffix;
|
|
end;
|
|
end;
|
|
if Ps = 0 then
|
|
begin
|
|
if HidePrefixSuffixIfEmpty and (NewValue = '') and (Exponent = '') then
|
|
S := ''
|
|
else
|
|
S := FDisplayPrefix + NewValue + FDisplaySuffix;
|
|
end;
|
|
if S <> inherited Text then
|
|
SetText(S);
|
|
// inherited SetText(S);
|
|
finally
|
|
FSelfChange := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.DisplayText;
|
|
|
|
function FormatedValue(Value: Double): Double;
|
|
begin
|
|
Result := Value;
|
|
if Assigned(FOnDecimalRounding) then
|
|
FOnDecimalRounding(Self, Result, Value);
|
|
end;
|
|
|
|
begin
|
|
// The number types need to be formatted
|
|
if FAllowEmpty and (FEditText = '') then
|
|
ChangeText('')
|
|
else
|
|
if (FDisplayFormat in [dfBinary, dfCurrency, dfFloat, dfFloatGeneral, dfDecimal, dfInteger, dfOctal,
|
|
dfPercent, dfScientific, dfYear, dfFloatFixed]) and
|
|
(AsFloat = 0) and FZeroEmpty then
|
|
ChangeText('')
|
|
else if (FDisplayFormat = dfBcd) and FZeroEmpty and IsBcdZero(AsBcd) then
|
|
ChangeText('')
|
|
else
|
|
begin
|
|
case FDisplayFormat of
|
|
dfCurrency:
|
|
ChangeText(Format('%.*m', [FDecimalPlaces, AsCurrency]));
|
|
dfInteger:
|
|
ChangeText(IntToStr(AsInteger));
|
|
dfFloat:
|
|
ChangeText(Format('%.*n', [FDecimalPlaces, FormatedValue(AsFloat)]));
|
|
dfFloatGeneral:
|
|
ChangeText(Format('%.*g', [FDecimalPlaces, FormatedValue(AsFloat)]));
|
|
dfFloatFixed:
|
|
ChangeText(Format('%.*f', [FDecimalPlaces, FormatedValue(AsFloat)]));
|
|
dfScientific:
|
|
ChangeText(Format('%.*e', [FDecimalPlaces, FormatedValue(AsFloat)]));
|
|
dfPercent:
|
|
ChangeText(Format('%.*n%', [FDecimalPlaces, FormatedValue(AsFloat)]));
|
|
dfBcd:
|
|
ChangeText(BcdToStrFDefault(AsBcd, FDecimalPlaces));
|
|
else
|
|
ChangeText(FEditText);
|
|
end;
|
|
|
|
// This needs to be done AFTER the text has been changed so that the color
|
|
// is directly shown correctly. (Mantis 3493)
|
|
if (FCriticalPoints.CheckPoints <> cpNone) and
|
|
(FDisplayFormat in [dfBinary, dfCurrency, dfFloat, dfFloatGeneral, dfDecimal, dfHex, dfInteger,
|
|
dfOctal, dfPercent, dfScientific, dfYear, dfFloatFixed, dfBcd]) then
|
|
SetFontColor;
|
|
end;
|
|
end;
|
|
|
|
function TJvCustomValidateEdit.ScientificStrToFloat(SciString: string): Double;
|
|
var
|
|
I: Cardinal;
|
|
sMantissa, sExponent: string;
|
|
bInExp: Boolean;
|
|
begin
|
|
if Pos('E', UpperCase(SciString)) = 0 then
|
|
Result := StrToFloatDef(SciString, 0)
|
|
// Result := JvSafeStrToFloatDef(SciString, 0)
|
|
else
|
|
begin
|
|
sMantissa := '';
|
|
sExponent := '';
|
|
bInExp := False;
|
|
for I := 1 to Length(SciString) do
|
|
begin
|
|
if UpperCase(SciString[I]) = 'E' then
|
|
bInExp := True
|
|
else
|
|
begin
|
|
if bInExp then
|
|
sExponent := sExponent + SciString[I]
|
|
else
|
|
sMantissa := sMantissa + SciString[I];
|
|
end;
|
|
end;
|
|
// NOTE: StrToFloatDefIgnoreInvalidCharacters now called JvSafeStrToFloatDef:
|
|
Result := StrToFloatDef(sMantissa, 0) * Power(10, StrToFloatDef(sExponent, 0));
|
|
// Result := JvSafeStrToFloatDef(sMantissa, 0) * Power(10, JvSafeStrToFloatDef(sExponent, 0));
|
|
end;
|
|
end;
|
|
|
|
function TJvCustomValidateEdit.BaseToInt(const BaseValue: string; Base: Byte): Int64;
|
|
begin
|
|
Assert(Base <= 36, RsEBaseTooBig);
|
|
Assert(Base > 1, RsEBaseTooSmall);
|
|
Result := Numb2Dec(BaseValue, Base);
|
|
end;
|
|
|
|
function TJvCustomValidateEdit.IntToBase(NewValue: Int64; Base: Byte): string;
|
|
begin
|
|
Assert(Base <= 36, RsEBaseTooBig);
|
|
Assert(Base > 1, RsEBaseTooSmall);
|
|
Result := Dec2Numb(NewValue, 0, Base);
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.DoValueChanged;
|
|
begin
|
|
try
|
|
if Assigned(FOnValueChanged) and not (csLoading in ComponentState) and (FEnterText <> FEditText) then
|
|
FOnValueChanged(Self);
|
|
finally
|
|
FEnterText := FEditText;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.Change;
|
|
var
|
|
DisplayedText: string;
|
|
begin
|
|
// Update FEditText for User changes, so that the AsInteger, etc,
|
|
// functions work while editing
|
|
if not FSelfChange then
|
|
begin
|
|
DisplayedText := inherited Text;
|
|
FEditText := GetUnprefixedUnsuffixedText(DisplayedText);
|
|
end;
|
|
inherited Change;
|
|
end;
|
|
|
|
function TJvCustomValidateEdit.GetText: TCaption;
|
|
begin
|
|
Result := inherited Text;
|
|
if (Result = EmptyValue) and (EmptyValue <> '') then
|
|
Result := '';
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.SetText(const NewValue: TCaption);
|
|
begin
|
|
// If we are actually changing our value ourselves, there is no need
|
|
// to do it again. This may even trigger an infinite recursion, especially
|
|
// when in a derived component the display format is set in the constructor.
|
|
// In that case, the recursion would kill Delphi almost instantly.
|
|
if not FSelfChange then
|
|
begin
|
|
EditText := NewValue;
|
|
DoValueChanged;
|
|
end else
|
|
inherited Text := NewValue;
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.SetEmptyValue(const AValue: string);
|
|
begin
|
|
FEmptyValue := AValue;
|
|
if HandleAllocated then
|
|
if Focused then
|
|
DoEmptyValueEnter
|
|
else
|
|
DoEmptyValueExit;
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.DoEmptyValueEnter;
|
|
begin
|
|
if (csDesigning in ComponentState) or not FIsLoaded or (EmptyValue = '') then
|
|
Exit;
|
|
if EmptyValue <> '' then
|
|
begin
|
|
if (inherited Text) = EmptyValue then
|
|
begin
|
|
inherited Text := '';
|
|
FIsEmptyValue := False;
|
|
(***************** NOT CONVERTED ****
|
|
if not (csDesigning in ComponentState) then
|
|
Font.Color := FOldFontColor;
|
|
*************************************)
|
|
end;
|
|
end
|
|
(****************** NOT CONVERTED ***
|
|
else
|
|
if not (csDesigning in ComponentState) then
|
|
Font.Color := FOldFontColor;
|
|
***********************************)
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.DoEmptyValueExit;
|
|
begin
|
|
if (csDesigning in ComponentState) or not FIsLoaded or (EmptyValue = '') then
|
|
Exit;
|
|
if EmptyValue <> '' then
|
|
begin
|
|
if Text = '' then
|
|
begin
|
|
Text := EmptyValue;
|
|
FIsEmptyValue := True;
|
|
(****************************** NOT CONVERTED **********
|
|
if not (csDesigning in ComponentState) then
|
|
begin
|
|
FOldFontColor := Font.Color;
|
|
Font.Color := FEmptyFontColor;
|
|
end;
|
|
*******************************************************)
|
|
end;
|
|
end
|
|
(**************************** NOT CONVERTED *************
|
|
else
|
|
if not (csDesigning in ComponentState) then
|
|
Font.Color := FOldFontColor;
|
|
*******************************************************)
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.SetDisplayPrefix(const NewValue: string);
|
|
begin
|
|
FDisplayPrefix := NewValue;
|
|
DisplayText;
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.SetDisplaySuffix(const NewValue: string);
|
|
begin
|
|
FDisplaySuffix := NewValue;
|
|
DisplayText;
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.CriticalPointsChange(Sender: TObject);
|
|
begin
|
|
SetFontColor;
|
|
Invalidate;
|
|
end;
|
|
|
|
function TJvCustomValidateEdit.IsValid: Boolean;
|
|
begin
|
|
Result := True;
|
|
case FCriticalPoints.CheckPoints of
|
|
cpMaxValue:
|
|
Result := IsLower(AsFloat, FCriticalPoints.MaxValue, FCriticalPoints.MaxValueIncluded);
|
|
cpMinValue:
|
|
Result := IsGreater(AsFloat, FCriticalPoints.MinValue, FCriticalPoints.MinValueIncluded);
|
|
cpBoth:
|
|
Result := IsLower(AsFloat, FCriticalPoints.MaxValue, FCriticalPoints.MaxValueIncluded) and
|
|
IsGreater(AsFloat, FCriticalPoints.MinValue, FCriticalPoints.MinValueIncluded);
|
|
end;
|
|
if Assigned(FOnIsValid) then
|
|
FOnIsValid(Self, Result);
|
|
end;
|
|
|
|
function TJvCustomValidateEdit.IsEmpty: Boolean;
|
|
var
|
|
s: String;
|
|
begin
|
|
s := GetUnprefixedUnsuffixedText(Text);
|
|
Result := s = '';
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.SetFontColor;
|
|
begin
|
|
if not (csDesigning in ComponentState) and not (csLoading in ComponentState) then
|
|
begin
|
|
Font.OnChange := nil;
|
|
case FCriticalPoints.CheckPoints of
|
|
cpNone:
|
|
Font.Color := FStandardFontColor;
|
|
cpMinValue:
|
|
if IsLower(AsFloat, FCriticalPoints.MinValue, not FCriticalPoints.MinValueIncluded) then
|
|
Font.Color := FCriticalPoints.ColorBelow
|
|
else
|
|
Font.Color := FStandardFontColor;
|
|
cpMaxValue:
|
|
if IsGreater(AsFloat, FCriticalPoints.MaxValue, not FCriticalPoints.MaxValueIncluded) then
|
|
Font.Color := FCriticalPoints.ColorAbove
|
|
else
|
|
Font.Color := FStandardFontColor;
|
|
cpBoth:
|
|
if IsGreater(AsFloat, FCriticalPoints.MaxValue, not FCriticalPoints.MaxValueIncluded) then
|
|
Font.Color := FCriticalPoints.ColorAbove
|
|
else if IsLower(AsFloat, FCriticalPoints.MinValue, not FCriticalPoints.MinValueIncluded) then
|
|
Font.Color := FCriticalPoints.ColorBelow
|
|
else
|
|
Font.Color := FStandardFontColor;
|
|
end;
|
|
Font.OnChange := @FontChange;
|
|
end;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.FontChange(Sender: TObject);
|
|
begin
|
|
FStandardFontColor := Font.Color;
|
|
if Assigned(FOldFontChange) then
|
|
FOldFontChange(Sender);
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.EnforceMaxValue;
|
|
begin
|
|
{ Check the Value is within this range }
|
|
if FHasMaxValue and (FDisplayFormat in [dfBinary, dfCurrency, dfFloat, dfFloatGeneral,
|
|
dfDecimal, dfHex, dfInteger, dfOctal, dfPercent, dfScientific, dfYear, dfFloatFixed, dfBcd]) and
|
|
(AsFloat > FMaxValue) and not FEnforcingMinMaxValue then
|
|
begin
|
|
if not (AllowEmpty and IsEmpty) then
|
|
begin
|
|
FEnforcingMinMaxValue := True;
|
|
try
|
|
SetAsFloat(FMaxValue);
|
|
finally
|
|
FEnforcingMinMaxValue := False;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomValidateEdit.EnforceMinValue;
|
|
begin
|
|
{ Check the Value is within this range }
|
|
if FHasMinValue and (FDisplayFormat in [dfBinary, dfCurrency, dfFloat, dfFloatGeneral,
|
|
dfDecimal, dfHex, dfInteger, dfOctal, dfPercent, dfScientific, dfYear, dfFloatFixed, dfBcd]) and
|
|
(AsFloat < FMinValue) and not FEnforcingMinMaxValue then
|
|
begin
|
|
if not (AllowEmpty and IsEmpty) then
|
|
begin
|
|
FEnforcingMinMaxValue := True;
|
|
try
|
|
SetAsFloat(FMinValue);
|
|
finally
|
|
FEnforcingMinMaxValue := False;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//=== { TJvValidateEditCriticalPoints } ======================================
|
|
|
|
constructor TJvValidateEditCriticalPoints.Create;
|
|
begin
|
|
inherited Create;
|
|
SetDefaults(cpNone, clBlue, clRed);
|
|
FMaxValueIncluded := False;
|
|
FMinValueIncluded := False;
|
|
end;
|
|
|
|
procedure TJvValidateEditCriticalPoints.SetCheckPoints(NewValue: TJvValidateEditCriticalPointsCheck);
|
|
begin
|
|
if FCheckPoints <> NewValue then
|
|
begin
|
|
FCheckPoints := NewValue;
|
|
DoChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvValidateEditCriticalPoints.SetColorAbove(NewValue: TColor);
|
|
begin
|
|
if FColorAbove <> NewValue then
|
|
begin
|
|
FColorAbove := NewValue;
|
|
DoChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvValidateEditCriticalPoints.SetColorBelow(NewValue: TColor);
|
|
begin
|
|
if FColorBelow <> NewValue then
|
|
begin
|
|
FColorBelow := NewValue;
|
|
DoChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvValidateEditCriticalPoints.SetMaxValue(NewValue: Double);
|
|
begin
|
|
if FMaxValue <> NewValue then
|
|
begin
|
|
FMaxValue := NewValue;
|
|
DoChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvValidateEditCriticalPoints.SetMinValue(NewValue: Double);
|
|
begin
|
|
if FMinValue <> NewValue then
|
|
begin
|
|
FMinValue := NewValue;
|
|
DoChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvValidateEditCriticalPoints.DoChanged;
|
|
begin
|
|
if Assigned(FOnChange) then
|
|
FOnChange(Self);
|
|
end;
|
|
|
|
procedure TJvValidateEditCriticalPoints.Assign(Source: TPersistent);
|
|
var
|
|
LocalSource: TJvValidateEditCriticalPoints;
|
|
begin
|
|
if Source is TJvValidateEditCriticalPoints then
|
|
begin
|
|
LocalSource := TJvValidateEditCriticalPoints(Source);
|
|
CheckPoints := LocalSource.CheckPoints;
|
|
ColorAbove := LocalSource.ColorAbove;
|
|
ColorBelow := LocalSource.ColorBelow;
|
|
MaxValue := LocalSource.MaxValue;
|
|
MinValue := LocalSource.MinValue;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function TJvValidateEditCriticalPoints.IsCheckPointsStored: Boolean;
|
|
begin
|
|
Result := (FCheckPoints <> FDefCheckPoints);
|
|
end;
|
|
|
|
function TJvValidateEditCriticalPoints.IsColorAboveStored: Boolean;
|
|
begin
|
|
Result := (FColorAbove <> FDefColorAbove);
|
|
end;
|
|
|
|
function TJvValidateEditCriticalPoints.IsColorBelowStored: Boolean;
|
|
begin
|
|
Result := (FColorBelow <> FDefColorBelow);
|
|
end;
|
|
|
|
procedure TJvValidateEditCriticalPoints.SetDefaults(ACheckPoints: TJvValidateEditCriticalPointsCheck;
|
|
AColorAbove, AColorBelow: TColor);
|
|
begin
|
|
FDefCheckPoints := ACheckPoints;
|
|
FCheckPoints := ACheckPoints;
|
|
FDefColorAbove := AColorAbove;
|
|
FColorAbove := AColorAbove;
|
|
FDefColorBelow := AColorBelow;
|
|
FColorBelow := AColorBelow;
|
|
end;
|
|
|
|
|
|
end.
|