Componente para Delphi Win32
Código Delphi
[-]
unit NumCtrl;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, Menus;
type
TCustomStrEdit = class (TCustomEdit)
private
FAlignment: TAlignment;
FOldAlignment : TAlignment;
FTextMargin : integer;
function CalcTextMargin : integer;
procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure SetAlignment(Value: TAlignment);
protected
property Alignment: TAlignment read FAlignment write SetAlignment default taRightJustify;
public
constructor Create(AOwner: TComponent); override;
end;
TStrEdit = class (TCustomStrEdit)
published
property Alignment;
property Anchors;
property AutoSize;
property BorderStyle;
property Color;
property Ctl3D;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property ShowHint;
property TabOrder;
property Visible;
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;
end;
type
TNumericType = (ntGeneral, ntCurrency, ntPercentage);
TMaskString = string [25];
type
TMasks = class (TPersistent)
private
FPositiveMask : TMaskString;
FNegativeMask : TMaskString;
FZeroMask : TMaskString;
FOnChange: TNotifyEvent;
protected
procedure SetPositiveMask (Value : TMaskString);
procedure SetNegativeMask (Value : TMaskString);
procedure SetZeroMask (Value : TMaskString);
public
constructor Create;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
published
property PositiveMask : TMaskString read FPositiveMask write SetPositiveMask;
property NegativeMask : TMaskString read FNegativeMask write SetNegativeMask;
property ZeroMask : TMaskString read FZeroMask write SetZeroMask;
end;
type
TCustomNumEdit = class (TCustomStrEdit)
private
FDecimals : word;
FDigits : word;
FMasks : TMasks;
FMax : extended;
FMin : extended;
FNumericType : TNumericType;
FUseRounding : boolean;
FValue : extended;
FValidate : boolean;
procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure SetDecimals(Value : word);
procedure SetDigits(Value : word);
procedure SetMasks (Mask : TMasks);
procedure SetMax(Value : extended);
procedure SetMin(Value : extended);
procedure SetNumericType(Value : TNumericType);
procedure SetValue(Value : extended);
procedure SetValidate(Value : boolean);
protected
procedure FormatText; dynamic;
procedure KeyPress(var Key: Char); override;
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
procedure UnFormatText; dynamic;
property Decimals : word read FDecimals write SetDecimals;
property Digits : word read FDigits write SetDigits;
property Masks : TMasks read FMasks write SetMasks;
property Max : extended read FMax write SetMax;
property Min : extended read FMin write SetMin;
property NumericType : TNumericType read FNumericType write SetNumericType default ntCurrency;
property UseRounding : boolean read FUseRounding write FUseRounding;
property Value : extended read FValue write SetValue;
property Validate : boolean read FValidate write SetValidate;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function AsDouble : double; dynamic;
function AsInteger : integer; dynamic;
function AsLongint : longint; dynamic;
function AsReal : double; dynamic;
function AsString : string; dynamic;
procedure MaskChanged ( Sender : TObject );
function Valid ( Value : extended ) : boolean; dynamic;
end;
TNumEdit = class (TCustomNumEdit)
published
property AutoSize;
property Anchors;
property BorderStyle;
property Color;
property Ctl3D;
property Decimals;
property Digits;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property Masks;
property Max;
property Min;
property NumericType;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property ShowHint;
property TabOrder;
property UseRounding;
property Value;
property Validate;
property Visible;
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;
end;
procedure Register;
implementation
type
TSetOfChar = set of char;
var
OldMaxLength : integer;
function Power ( X, Y : integer ) : Double;
begin
Result := exp ( ln ( X ) * Y );
end;
function StripChars ( const Text : string; ValidChars : TSetOfChar ) : string;
var
S : string;
i : integer;
Negative : boolean;
Begin
if(Length(Text) > 0) then begin
Negative := false;
if (Text [ 1 ] = '-') or (Text [length (Text)] = '-' ) then
Negative := true;
S := '';
for i := 1 to length ( Text ) do
if Text [ i ] in ValidChars then
S := S + Text [ i ];
if Negative then
Result := '-' + S
else
Result := S;
end
else
Result := S;
End;
constructor TCustomStrEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FAlignment := taLeftJustify;
FTextMargin := CalcTextMargin;
end;
function TCustomStrEdit.CalcTextMargin : integer;
var
DC: HDC;
SaveFont: HFont;
I: Integer;
SysMetrics, Metrics: TTextMetric;
begin
DC := GetDC(0);
GetTextMetrics(DC, SysMetrics);
SaveFont := SelectObject(DC, Font.Handle);
GetTextMetrics(DC, Metrics);
SelectObject(DC, SaveFont);
ReleaseDC(0, DC);
I := SysMetrics.tmHeight;
if I > Metrics.tmHeight then
I := Metrics.tmHeight;
Result := I div 4;
end;
procedure TCustomStrEdit.SetAlignment(Value: TAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
Invalidate;
end;
end;
procedure TCustomStrEdit.CMEnter(var Message: TCMEnter);
begin
inherited;
FOldAlignment := FAlignment;
Alignment := taLeftJustify;
end;
procedure TCustomStrEdit.CMExit(var Message: TCMExit);
begin
inherited;
Alignment := FOldAlignment;
end;
procedure TCustomStrEdit.WMPaint(var Message: TWMPaint);
var
Width, Indent, Left: Integer;
R: TRect;
DC: HDC;
PS: TPaintStruct;
S: string;
Canvas: TControlCanvas;
begin
if (FAlignment = taLeftJustify) then
begin
inherited;
Exit;
end;
Canvas := TControlCanvas.Create;
Canvas.Control := Self;
try
DC := Message.DC;
if DC = 0 then
DC := BeginPaint(Handle, PS);
Canvas.Handle := DC;
Canvas.Font := Font;
with Canvas do
begin
R := ClientRect;
if (BorderStyle = bsSingle) then
begin
Brush.Color := clWindowFrame;
InflateRect(R, -1, -1);
end;
Brush.Color := Color;
S := Text;
Width := TextWidth(S);
if BorderStyle = bsNone then
Indent := 0
else
Indent := FTextMargin;
if FAlignment = taRightJustify then
Left := R.Right - Width - Indent
else
Left := (R.Left + R.Right - Width) div 2;
TextRect(R, Left, Indent, S);
end;
finally
Canvas.Handle := 0;
if Message.DC = 0 then
EndPaint(Handle, PS);
end;
end;
constructor TMasks.Create;
begin
inherited Create;
FPositiveMask := '#,##0';
FNegativeMask := '';
FZeroMask := '';
end;
procedure TMasks.SetPositiveMask (Value : TMaskString);
begin
if FPositiveMask <> Value then
begin
FPositiveMask := Value;
OnChange(Self);
end;
end;
procedure TMasks.SetNegativeMask (Value : TMaskString);
begin
if FNegativeMask <> Value then
begin
FNegativeMask := Value;
OnChange(Self);
end;
end;
procedure TMasks.SetZeroMask (Value : TMaskString);
begin
if FZeroMask <> Value then
begin
FZeroMask := Value;
OnChange(Self);
end;
end;
constructor TCustomNumEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 85;
FAlignment := taRightJustify;
FNumericType := ntCurrency;
FDigits := 12;
FDecimals := 2;
AutoSelect := true;
FMax := 0.0;
FMin := 0.0;
FValidate := false;
FValue := 0.0;
FormatText;
FTextMargin := CalcTextMargin;
FUseRounding := true;
FMasks := TMasks.Create;
FMasks.OnChange := MaskChanged;
end;
destructor TCustomNumEdit.Destroy;
begin
FMasks.Free;
inherited Destroy;
end;
function TCustomNumEdit.AsInteger : integer;
const
MaxInteger : integer = 32767;
MinInteger : integer = -32768;
begin
Result := 0;
if (FValue < MaxInteger) and (FValue > MinInteger) then
if FUseRounding then
Result := round ( FValue )
else
Result := trunc ( FValue );
end;
function TCustomNumEdit.AsLongint : longint;
const
MaxLongint : longint = 2147483647;
MinLongint : longint = -2147483647;
begin
Result := 0;
if (FValue < MaxLongint ) and (FValue > MinLongint) then
if FUseRounding then
Result := round ( FValue )
else
Result := trunc ( FValue );
end;
function TCustomNumEdit.AsReal : Double;
const
MaxReal : Double = 1.7E38;
MinReal : Double = -1.7E38;
begin
Result := 0;
if (FValue < MaxReal) and (FValue > MinReal) then
Result := FValue;
end;
function TCustomNumEdit.AsDouble : double;
const
MaxDouble : double = 1.7E308;
MinDouble : double = -1.7E308;
begin
Result := 0;
if (FValue < MaxDouble) and (FValue > MinDouble) then
Result := round ( FValue );
end;
function TCustomNumEdit.AsString : string;
const
ValidChars = [ '0'..'9', '.', ',' ];
begin
Result := StripChars ( Text, ValidChars );
if Value < 0 then
Result := '-' + Result;
end;
procedure TCustomNumEdit.SetMasks (Mask : TMasks);
begin
if fMasks <> Mask then
begin
fMasks := Masks;
Invalidate;
end;
end;
procedure TCustomNumEdit.SetMin(Value : extended);
begin
if FMin <> Value then
begin
FMin := Value;
if FValue < FMin then
FValue := FMin;
end;
end;
procedure TCustomNumEdit.SetMax(Value : extended);
begin
if FMax <> Value then
begin
FMax := Value;
if FValue > FMax then
FValue := FMax;
end;
end;
procedure TCustomNumEdit.SetValue(Value : extended);
begin
if ( FValue <> Value ) and ( Valid ( Value ) ) then
begin
FValue := Value;
FormatText;
end;
end;
procedure TCustomNumEdit.SetDigits(Value : word);
begin
if FDigits <> Value then
begin
FDigits := Value;
FormatText;
end;
end;
procedure TCustomNumEdit.SetDecimals (Value : word);
begin
if FDecimals <> Value then
begin
FDecimals := Value;
FormatText;
end;
end;
procedure TCustomNumEdit.SetNumericType(Value: TNumericType);
begin
if FNumericType <> Value then
begin
FNumericType := Value;
FormatText;
end;
end;
procedure TCustomNumEdit.SetValidate(Value : boolean);
begin
if FValidate <> Value then
begin
FValidate:= Value;
if FValidate and (( FValue < FMin ) or ( FValue > FMax )) then
begin
FValue := FMin;
FormatText;
end;
end;
end;
function TCustomNumEdit.Valid ( Value : extended ) : boolean;
var
S : string;
begin
Result := true;
if Validate and (( Value < FMin ) or ( Value > FMax )) then
begin
FmtStr( S, 'Value must be between %g and %g', [FMin, FMax]);
MessageDlg(S,mtError, [mbOk], 0);
Result := false;
end;
end;
procedure TCustomNumEdit.KeyPress(var Key: Char);
begin
if (Key = DecimalSeparator) and (Decimals > 0) and ((pos (DecimalSeparator, Text) = 0) or (SelLength = Length(Text))) then
begin
inherited KeyPress(Key);
MaxLength := MaxLength + 1;
end
else
if ( Key = '-' ) and ( pos ( '-', Text ) = 0 ) then
begin
inherited KeyPress(Key);
MaxLength := MaxLength + 1;
end
else
if Key in [ '0'..'9', ThousandSeparator, #8 ] then
inherited KeyPress(Key)
else
Key := #0;
end;
procedure TCustomNumEdit.CMEnter(var Message: TCMEnter);
begin
UnFormatText;
OldMaxLength := MaxLength;
MaxLength := FDigits;
inherited;
end;
procedure TCustomNumEdit.CMExit(var Message: TCMExit);
begin
FormatText;
inherited;
end;
procedure TCustomNumEdit.KeyUp(var Key: Word; Shift: TShiftState);
var
S : string [80];
X : extended;
begin
S := StripChars (Text, [ '0'..'9', DecimalSeparator ]);
if S = '' then
X := 0.0
else
X := StrToFloat ( S );
if Valid ( X ) then
FValue:= X;
inherited KeyUp(Key, Shift);
end;
procedure TCustomNumEdit.FormatText;
var
X : extended;
Multiplier : Double;
begin
try
Multiplier := Power ( 10, Decimals );
X := FValue;
if UseRounding then
X := round ( X * Multiplier ) / Multiplier
else
X := trunc ( X * Multiplier ) / Multiplier;
except
on ERangeError do
X := FValue;
end;
case FNumericType of
ntCurrency : Text := FloatToStrF ( X, ffCurrency, FDigits, FDecimals);
ntPercentage : Text := FloatToStrF ( X, ffFixed, FDigits, FDecimals) + '%';
ntGeneral : with Masks do
Text := FormatFloat( PositiveMask+';'+NegativeMask+';'+ZeroMask, X);
end;
end;
procedure TCustomNumEdit.MaskChanged ( Sender : TObject );
begin
FormatText;
end;
procedure TCustomNumEdit.UnFormatText;
Begin
Text := StripChars ( Text, [ '0'..'9', DecimalSeparator, ThousandSeparator ] );
if Value < 0 then
Text := '-' + Text;
End;
procedure Register;
begin
RegisterComponents ( 'Standard', [TNumEdit] );
RegisterComponents ( 'Standard', [TStrEdit] );
end;
end.
Componente para Delphi.NET
Código Delphi
[-]
unit uNumCtrl;
interface
uses
SysUtils, Classes, System.ComponentModel, Borland.Vcl.Controls,
Borland.Vcl.StdCtrls, Windows, Messages, Forms, Graphics, Dialogs;
type
TCustomStrEdit = class (TCustomEdit)
private
FAlignment: TAlignment;
FOldAlignment : TAlignment;
FTextMargin : integer;
function CalcTextMargin : integer;
procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure SetAlignment(Value: TAlignment);
protected
property Alignment: TAlignment read FAlignment write SetAlignment default taRightJustify;
public
constructor Create(AOwner: TComponent); override;
end;
TStrEdit = class (TCustomStrEdit)
published
property Alignment;
property Anchors;
property AutoSize;
property BorderStyle;
property Color;
property Ctl3D;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property ShowHint;
property TabOrder;
property Visible;
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;
end;
type
TNumericType = (ntGeneral, ntCurrency, ntPercentage);
TMaskString = string [25];
type
TMasks = class (TPersistent)
private
FPositiveMask : TMaskString;
FNegativeMask : TMaskString;
FZeroMask : TMaskString;
FOnChange: TNotifyEvent;
protected
procedure SetPositiveMask (Value : TMaskString);
procedure SetNegativeMask (Value : TMaskString);
procedure SetZeroMask (Value : TMaskString);
public
constructor Create;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
published
property PositiveMask : TMaskString read FPositiveMask write SetPositiveMask;
property NegativeMask : TMaskString read FNegativeMask write SetNegativeMask;
property ZeroMask : TMaskString read FZeroMask write SetZeroMask;
end;
type
TCustomNumEdit = class (TCustomStrEdit)
private
FDecimals : word;
FDigits : word;
FMasks : TMasks;
FMax : extended;
FMin : extended;
FNumericType : TNumericType;
FUseRounding : boolean;
FValue : extended;
FValidate : boolean;
procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure SetDecimals(Value : word);
procedure SetDigits(Value : word);
procedure SetMasks (Mask : TMasks);
procedure SetMax(Value : extended);
procedure SetMin(Value : extended);
procedure SetNumericType(Value : TNumericType);
procedure SetValue(Value : extended);
procedure SetValidate(Value : boolean);
protected
procedure FormatText; dynamic;
procedure KeyPress(var Key: Char); override;
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
procedure UnFormatText; dynamic;
property Decimals : word read FDecimals write SetDecimals;
property Digits : word read FDigits write SetDigits;
property Masks : TMasks read FMasks write SetMasks;
property Max : extended read FMax write SetMax;
property Min : extended read FMin write SetMin;
property NumericType : TNumericType read FNumericType write SetNumericType default ntCurrency;
property UseRounding : boolean read FUseRounding write FUseRounding;
property Value : extended read FValue write SetValue;
property Validate : boolean read FValidate write SetValidate;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function AsDouble : double; dynamic;
function AsInteger : integer; dynamic;
function AsLongint : longint; dynamic;
function AsReal : double; dynamic;
function AsString : string; dynamic;
procedure MaskChanged ( Sender : TObject );
function Valid ( Value : extended ) : boolean; dynamic;
end;
TNumEdit = class (TCustomNumEdit)
published
property AutoSize;
property Anchors;
property BorderStyle;
property Color;
property Ctl3D;
property Decimals;
property Digits;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property Masks;
property Max;
property Min;
property NumericType;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property ShowHint;
property TabOrder;
property UseRounding;
property Value;
property Validate;
property Visible;
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;
end;
procedure Register;
implementation
type
TSetOfChar = set of char;
var
OldMaxLength : integer;
function Power ( X, Y : integer ) : Double;
begin
Result := exp ( ln ( X ) * Y );
end;
function StripChars ( const Text : string; ValidChars : TSetOfChar ) : string;
var
S : string;
i : integer;
Negative : boolean;
Begin
if(Length(Text) > 0) then begin
Negative := false;
if (Text [ 1 ] = '-') or (Text [length (Text)] = '-' ) then
Negative := true;
S := '';
for i := 1 to length ( Text ) do
if Text [ i ] in ValidChars then
S := S + Text [ i ];
if Negative then
Result := '-' + S
else
Result := S;
end
else
Result := S;
End;
constructor TCustomStrEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FAlignment := taLeftJustify;
FTextMargin := CalcTextMargin;
end;
function TCustomStrEdit.CalcTextMargin : integer;
var
DC: HDC;
SaveFont: HFont;
I: Integer;
SysMetrics, Metrics: TTextMetric;
begin
DC := GetDC(0);
GetTextMetrics(DC, SysMetrics);
SaveFont := SelectObject(DC, Font.Handle);
GetTextMetrics(DC, Metrics);
SelectObject(DC, SaveFont);
ReleaseDC(0, DC);
I := SysMetrics.tmHeight;
if I > Metrics.tmHeight then
I := Metrics.tmHeight;
Result := I div 4;
end;
procedure TCustomStrEdit.SetAlignment(Value: TAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
Invalidate;
end;
end;
procedure TCustomStrEdit.CMEnter(var Message: TCMEnter);
begin
inherited;
FOldAlignment := FAlignment;
Alignment := taLeftJustify;
end;
procedure TCustomStrEdit.CMExit(var Message: TCMExit);
begin
inherited;
Alignment := FOldAlignment;
end;
procedure TCustomStrEdit.WMPaint(var Message: TWMPaint);
var
Width, Indent, Left: Integer;
R: TRect;
DC: HDC;
PS: TPaintStruct;
S: string;
Canvas: TControlCanvas;
begin
if (FAlignment = taLeftJustify) then
begin
inherited;
Exit;
end;
Canvas := TControlCanvas.Create;
Canvas.Control := Self;
try
DC := Message.DC;
if DC = 0 then
DC := BeginPaint(Handle, PS);
Canvas.Handle := DC;
Canvas.Font := Font;
with Canvas do
begin
R := ClientRect;
if (BorderStyle = bsSingle) then
begin
Brush.Color := clWindowFrame;
InflateRect(R, -1, -1);
end;
Brush.Color := Color;
S := Text;
Width := TextWidth(S);
if BorderStyle = bsNone then
Indent := 0
else
Indent := FTextMargin;
if FAlignment = taRightJustify then
Left := R.Right - Width - Indent
else
Left := (R.Left + R.Right - Width) div 2;
TextRect(R, Left, Indent, S);
end;
finally
Canvas.Handle := 0;
if Message.DC = 0 then
EndPaint(Handle, PS);
end;
end;
constructor TMasks.Create;
begin
inherited Create;
FPositiveMask := '#,##0';
FNegativeMask := '';
FZeroMask := '';
end;
procedure TMasks.SetPositiveMask (Value : TMaskString);
begin
if FPositiveMask <> Value then
begin
FPositiveMask := Value;
OnChange(Self);
end;
end;
procedure TMasks.SetNegativeMask (Value : TMaskString);
begin
if FNegativeMask <> Value then
begin
FNegativeMask := Value;
OnChange(Self);
end;
end;
procedure TMasks.SetZeroMask (Value : TMaskString);
begin
if FZeroMask <> Value then
begin
FZeroMask := Value;
OnChange(Self);
end;
end;
constructor TCustomNumEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 85;
FAlignment := taRightJustify;
FNumericType := ntCurrency;
FDigits := 12;
FDecimals := 2;
AutoSelect := true;
FMax := 0.0;
FMin := 0.0;
FValidate := false;
FValue := 0.0;
FormatText;
FTextMargin := CalcTextMargin;
FUseRounding := true;
FMasks := TMasks.Create;
FMasks.OnChange := MaskChanged;
end;
destructor TCustomNumEdit.Destroy;
begin
FMasks.Free;
inherited Destroy;
end;
function TCustomNumEdit.AsInteger : integer;
const
MaxInteger : integer = 32767;
MinInteger : integer = -32768;
begin
Result := 0;
if (FValue < MaxInteger) and (FValue > MinInteger) then
if FUseRounding then
Result := round ( FValue )
else
Result := trunc ( FValue );
end;
function TCustomNumEdit.AsLongint : longint;
const
MaxLongint : longint = 2147483647;
MinLongint : longint = -2147483647;
begin
Result := 0;
if (FValue < MaxLongint ) and (FValue > MinLongint) then
if FUseRounding then
Result := round ( FValue )
else
Result := trunc ( FValue );
end;
function TCustomNumEdit.AsReal : Double;
const
MaxReal : Double = 1.7E38;
MinReal : Double = -1.7E38;
begin
Result := 0;
if (FValue < MaxReal) and (FValue > MinReal) then
Result := FValue;
end;
function TCustomNumEdit.AsDouble : double;
const
MaxDouble : double = 1.7E308;
MinDouble : double = -1.7E308;
begin
Result := 0;
if (FValue < MaxDouble) and (FValue > MinDouble) then
Result := round ( FValue );
end;
function TCustomNumEdit.AsString : string;
const
ValidChars = [ '0'..'9', '.', ',' ];
begin
Result := StripChars ( Text, ValidChars );
if Value < 0 then
Result := '-' + Result;
end;
procedure TCustomNumEdit.SetMasks (Mask : TMasks);
begin
if fMasks <> Mask then
begin
fMasks := Masks;
Invalidate;
end;
end;
procedure TCustomNumEdit.SetMin(Value : extended);
begin
if FMin <> Value then
begin
FMin := Value;
if FValue < FMin then
FValue := FMin;
end;
end;
procedure TCustomNumEdit.SetMax(Value : extended);
begin
if FMax <> Value then
begin
FMax := Value;
if FValue > FMax then
FValue := FMax;
end;
end;
procedure TCustomNumEdit.SetValue(Value : extended);
begin
if ( FValue <> Value ) and ( Valid ( Value ) ) then
begin
FValue := Value;
FormatText;
end;
end;
procedure TCustomNumEdit.SetDigits(Value : word);
begin
if FDigits <> Value then
begin
FDigits := Value;
FormatText;
end;
end;
procedure TCustomNumEdit.SetDecimals (Value : word);
begin
if FDecimals <> Value then
begin
FDecimals := Value;
FormatText;
end;
end;
procedure TCustomNumEdit.SetNumericType(Value: TNumericType);
begin
if FNumericType <> Value then
begin
FNumericType := Value;
FormatText;
end;
end;
procedure TCustomNumEdit.SetValidate(Value : boolean);
begin
if FValidate <> Value then
begin
FValidate:= Value;
if FValidate and (( FValue < FMin ) or ( FValue > FMax )) then
begin
FValue := FMin;
FormatText;
end;
end;
end;
function TCustomNumEdit.Valid ( Value : extended ) : boolean;
var
S : string;
begin
Result := true;
if Validate and (( Value < FMin ) or ( Value > FMax )) then
begin
FmtStr( S, 'Value must be between %g and %g', [FMin, FMax]);
MessageDlg(S,mtError, [mbOk], 0);
Result := false;
end;
end;
procedure TCustomNumEdit.KeyPress(var Key: Char);
begin
if (Key = DecimalSeparator) and (Decimals > 0) and ((pos (DecimalSeparator, Text) = 0) or (SelLength = Length(Text))) then
begin
inherited KeyPress(Key);
MaxLength := MaxLength + 1;
end
else
if ( Key = '-' ) and ( pos ( '-', Text ) = 0 ) then
begin
inherited KeyPress(Key);
MaxLength := MaxLength + 1;
end
else
if Key in [ '0'..'9', ',', #8 ] then
inherited KeyPress(Key)
else
Key := #0;
end;
procedure TCustomNumEdit.CMEnter(var Message: TCMEnter);
begin
UnFormatText;
OldMaxLength := MaxLength;
MaxLength := FDigits;
inherited;
end;
procedure TCustomNumEdit.CMExit(var Message: TCMExit);
begin
FormatText;
inherited;
end;
procedure TCustomNumEdit.KeyUp(var Key: Word; Shift: TShiftState);
var
S : string [80];
X : extended;
begin
S := StripChars (Text, [ '0'..'9', '.' ]);
if S = '' then
X := 0.0
else
X := StrToFloat ( S );
if Valid ( X ) then
FValue:= X;
inherited KeyUp(Key, Shift);
end;
procedure TCustomNumEdit.FormatText;
var
X : extended;
Multiplier : Double;
begin
try
Multiplier := Power ( 10, Decimals );
X := FValue;
if UseRounding then
X := round ( X * Multiplier ) / Multiplier
else
X := trunc ( X * Multiplier ) / Multiplier;
except
on ERangeError do
X := FValue;
end;
case FNumericType of
ntCurrency : Text := FloatToStrF ( X, ffCurrency, FDigits, FDecimals);
ntPercentage : Text := FloatToStrF ( X, ffFixed, FDigits, FDecimals) + '%';
ntGeneral : with Masks do
Text := FormatFloat( PositiveMask+';'+NegativeMask+';'+ZeroMask, X);
end;
end;
procedure TCustomNumEdit.MaskChanged ( Sender : TObject );
begin
FormatText;
end;
procedure TCustomNumEdit.UnFormatText;
Begin
Text := StripChars ( Text, [ '0'..'9', '.', ',' ] );
if Value < 0 then
Text := '-' + Text;
End;
procedure Register;
begin
RegisterComponents ( 'Standard', [TNumEdit] );
RegisterComponents ( 'Standard', [TStrEdit] );
end;
end.