Edit Numérico
Olá pessoal,
Tenho um EditNumérico que está com problemas, e queria saber se alguémpoderia ajudar.
Ele funciona perfeitamente no Delphi 5, só que no Delphi 7 ele tem um pequeno Bug. Quando entra no compoentente o cursor fica logo após o primeiro zero decimal (0,0|0 - O pipes tá indicando onde o cursor fica).
Gostaria de saber se alguém pode ajudar.
Ah, desconsiderem os outros componentes da Unit abaixo, só interessa o TCustomNumberEdit (superclasse) e TNumberEdit (subclasse)
Agradeço a quem puder ajudar.
Tenho um EditNumérico que está com problemas, e queria saber se alguémpoderia ajudar.
Ele funciona perfeitamente no Delphi 5, só que no Delphi 7 ele tem um pequeno Bug. Quando entra no compoentente o cursor fica logo após o primeiro zero decimal (0,0|0 - O pipes tá indicando onde o cursor fica).
Gostaria de saber se alguém pode ajudar.
Ah, desconsiderem os outros componentes da Unit abaixo, só interessa o TCustomNumberEdit (superclasse) e TNumberEdit (subclasse)
Agradeço a quem puder ajudar.
(***************************************************************************)
(***************************************************************************)
(**** ****)
(****Copyright (c) 1995-1996 M. Maher AL-Rijleh ****)
(**** ****)
(****Component : TNumberEdit(16 & 32 Bit) ****)
(****version: 1.05 ****)
(****Date: 09/28/1995 ****)
(****Last Update: 09/10/1996 ****)
(**** Description: An edit box that handle numerical entries ****)
(**** ****)
(**** ****)
(**** This code may be altered by you as you wish to make TNumberEdit****)
(**** function to your personal needs. However, you cannot resell or ****)
(*** redistribute the TNumberEdit as your own, altered or unaltered in ****)
(*** component or other non-executable form. ****)
(*** ****)
(***************************************************************************)
(***************************************************************************)
unit Numedit;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, Menus, Spin, clipbrd, Buttons;
const
{$ifdef Win32}
buttonWidth = 15;
{$ELSE}
buttonWidth = 20;
{$endif}
type
ENumberEditControl = Class(Exception);
TCurrencystring = string[10];
TFloat = extended;
TNumericFormat = (nfPercent,nfComma,nfCurrency,nfGeneral);
TCalcPosition =(cpCenter, cpCoordinates);
TCustomNumberEdit = class(TCustomEdit)
private
{ Private declarations }
FEntrouNoComponente : Boolean;
FAlignment: TAlignment;
FCharacterIsDelete : Boolean;
FNumericFormat : TNumericFormat;
FDecimalFigures : byte;
FCurrencySign : TCurrencystring;
FOldCurrencySign : TCurrencystring;
Fthousandseparator : char;
FDecimalseparator : char;
FValue: TFloat;
FMinimumAllowedValue : TFloat;
FMaximumAllowedValue : TFloat;
FRoundNumber : Boolean;
FParenthesis : Boolean;
FPositiveColor : TColor;
FNegativeColor : TColor;
Fskip: Boolean;
Finvalidating : Boolean;
FChangingValue : Boolean;
FSettingupforCurrencyShow : boolean;
FOutofRangeErrorMessage : String;
FShowRangeError : Boolean;
FActOnEnter : Boolean;
FOldText : string;
FBeepOnError : Boolean;
FSavedDecimalFigures : Byte;
FMoveCursor : Boolean;
FSelectedAll : Boolean;
FLockDecimalFigures : Boolean;
FOldParenthesis : Boolean;
FForceLimitedDecimals : Boolean;
FAllowNegativeNumber : Boolean;
procedure FSetNumericFormat(Value:TNumericFormat);
procedure FSetDecimalFigures(value:byte);
procedure FSetCurrencySign(value:TCurrencyString);
procedure Fsetthousandseparator(value:char);
procedure FsetDecimalseparator(value:char);
Procedure FSetValue(value:TFloat);
Procedure FSetMinimumAllowedValue(value:TFloat);
Procedure FSetMaximumAllowedValue(value:TFloat);
procedure FsetRoundNumber(value:boolean);
procedure FSetParenthesis(value:Boolean);
procedure FsetPositiveColor(value:Tcolor);
procedure Fsetnegativecolor(value:Tcolor);
protected
{ Protected declarations }
procedure change; override;
procedure keypress(var key:char); override;
procedure DoEnter; override;
procedure DoExit; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
function ValueInRange(value: TFloat) : Boolean;
function ExtraRightcharacters:string;
function ExtraLeftcharacters:string;
procedure WMSize(var Message: TWMSize); message WM_Size;
procedure WMCut(var Message: TMessage); message WM_CUT;
procedure WMCopy(var Message: TMessage); message WM_COPY;
procedure WMPaste(var Message: TMessage); message WM_PASTE;
function GetMinHeight: Integer;
procedure CreateParams(var Params: TCreateParams); override;
procedure SetAlignment(Value: TAlignment);
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
Property Alignment:TAlignment read FAlignment write SetAlignment;
procedure setValue;
Procedure FormatNegativeColor;
Procedure FormatNegativeText;
function TNEformatfloat(x:TFloat):string;
procedure setpercentshow;
procedure setpercentedit;
procedure setCommashow;
procedure setCommaedit;
procedure setCurrencyshow;
procedure setCurrencyedit;
procedure setGeneralshow;
procedure setGeneraledit;
function decimalpicture:string;
procedure invalidate; override;
Procedure SetupForShow;
Procedure SetupForEdit;
{ new properties }
property ActOnEnter: Boolean read FActOnEnter write FActOnEnter;
property BeepOnError: Boolean read FBeepOnError write FBeepOnError;
property NumericFormat:TNumericFormat read FNumericFormat write FsetNumericFormat;
property DecimalFigures:byte read FDecimalFigures write FSetDecimalFigures;
property CurrencySign:TCurrencystring read FCurrencySign write FsetCurrencySign;
property ThousandSeparator:char read Fthousandseparator write Fsetthousandseparator;
property Decimalseparator:char read FDecimalseparator write FsetDecimalseparator;
Property RoundNumber:Boolean read FRoundNumber write FsetRoundNumber;
Property ParenthesisForMinus:Boolean read FParenthesis write FsetParenthesis;
Property PositiveColor:TColor read FPositiveColor write FsetPositiveColor;
Property NegativeColor:TColor read FNegativeColor write FsetNegativeColor;
Property Value:TFloat read FValue write FSetValue;
Property MinimumAllowedValue:TFloat read FMinimumAllowedValue
write FSetMinimumAllowedValue;
Property MaximumAllowedValue:TFloat read FMaximumAllowedValue
write FSetMaximumAllowedValue;
property OutOfRangeErrorMessage: string read FOutOfRangeErrorMessage
write FOutOfRangeErrorMessage;
property ShowRangeError: boolean read FShowRangeError
write FShowRangeError;
property LockDecimalFigures : Boolean read FLockDecimalFigures
write FLockDecimalFigures;
published
{ Applicable Tedit Properties}
property ForceLimitedDecimals : Boolean read FForceLimitedDecimals
write FForceLimitedDecimals;
property AllowNegativeNumber : Boolean read FAllowNegativeNumber write
FAllowNegativeNumber;
property AutoSelect;
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 TabStop;
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;
TNumberEdit = class(TCustomNumberEdit)
private
protected
published
property Alignment;
property ActOnEnter;
property BeepOnError;
property NumericFormat;
property DecimalFigures;
property CurrencySign;
property ThousandSeparator;
property Decimalseparator;
Property RoundNumber;
Property ParenthesisForMinus;
Property PositiveColor;
Property NegativeColor;
Property Value;
Property MinimumAllowedValue;
Property MaximumAllowedValue;
property OutOfRangeErrorMessage;
property ShowRangeError;
property LockDecimalFigures;
end;
TSNumberEdit = class(TNumberEdit)
private
{ Private declarations}
FSpinButton : TSpinButton;
FIncrement : TFloat;
protected
{ Protected declarations }
procedure ProcessDownClick (Sender:TObject);
procedure ProcessUpClick (Sender:TObject);
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure WMSize(var Message: TWMSize); message WM_Size;
procedure keypress(var key:char); override;
procedure Change; override;
procedure DoEnter; override;
procedure SetEditRect;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property Increment : TFloat read FIncrement write FIncrement;
property Alignment;
property ActOnEnter;
property BeepOnError;
property NumericFormat;
property DecimalFigures;
property CurrencySign;
property ThousandSeparator;
property Decimalseparator;
Property RoundNumber;
Property ParenthesisForMinus;
Property PositiveColor;
Property NegativeColor;
Property Value;
Property MinimumAllowedValue;
Property MaximumAllowedValue;
property OutOfRangeErrorMessage;
end;
TCNumberEdit = class(TNumberEdit)
private
{ Private declarations}
FButton : TBitBtn;
FCaption : string;
FPosition : TCalcPosition;
FLeft : integer;
FTop : integer;
function GetVisibleButton:Boolean;
procedure SetVisibleButton(value : boolean);
function GetEnableButton:Boolean;
procedure SetEnableButton(value : boolean);
protected
{ Protected declarations }
procedure ProcessClick (Sender:TObject);
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure WMSize(var Message: TWMSize); message WM_Size;
procedure keypress(var key:char); override;
procedure Change; override;
procedure DoEnter; override;
procedure SetEditRect;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property Alignment;
property ActOnEnter;
property BeepOnError;
property NumericFormat;
property DecimalFigures;
property CurrencySign;
property ThousandSeparator;
property Decimalseparator;
Property RoundNumber;
Property ParenthesisForMinus;
Property PositiveColor;
Property NegativeColor;
Property Value;
Property MinimumAllowedValue;
Property MaximumAllowedValue;
property OutOfRangeErrorMessage;
property CalcCaption : string read FCaption write FCaption;
property CalcLeft : integer read FLeft write FLeft;
property CalcPosition : TCalcPosition read FPosition write FPosition;
property CalcTop : integer read FTop write FTop;
property VisibleButton : Boolean read GetVisibleButton
write SetVisibleButton;
property EnableButton : Boolean read GetEnableButton
write SetEnableButton;
end;
TmmCalculator = class(TComponent)
private
FCaption : string;
FPosition : TCalcPosition;
FAssociatedWindow : TwinControl;
FLeft : integer;
FTop : integer;
protected
procedure Notification( AComponent : TComponent;
Operation : TOperation ); override;
public
constructor Create(AOwner: TComponent); override;
function Execute: integer;
published
property AssociatedWindow : TwinControl read FAssociatedWindow
write FAssociatedWindow;
property Caption : string read FCaption write FCaption;
property Left : integer read FLeft write FLeft;
property Position : TCalcPosition read FPosition write FPosition;
property Top : integer read FTop write FTop;
end;
procedure Register;
implementation
uses
W_Calc, Windows;
type
characterset = set of char;
procedure Register;
begin
RegisterComponents(´MMRTools´, [TNumberEdit]);
RegisterComponents(´MMRTools´, [TSNumberEdit]);
RegisterComponents(´MMRTools´, [TCNumberEdit]);
RegisterComponents(´MMRTools´, [TmmCalculator]);
end;
{Supporting functions}
// nglauberRAD was here - 25/05/2004
{------------------------------------------------------------------------------}
function power10(n:byte):TFloat;
var
c : byte;
begin
result := 1;
for c := 1 to n do
result := result * 10;
end;
{------------------------------------------------------------------------------}
function StripExtraLetters (s : string ; CurrencyString:TCurrencyString;
GoodLetters : characterset):string;
var
counter : byte;
lng : byte;
p: byte;
begin
p := pos(CurrencyString,s);
if p <> 0 then
system.delete(s,p,length(CurrencyString));
lng := length(s);
result := s;
for counter := lng downto 1 do
if not(result[counter] in GoodLetters) then
delete(result,counter,1);
end;
{------------------------------------------------------------------------------}
Procedure RaiseError(const msg : string; Beep:Boolean);
begin
if Beep then
MessageBeep(0);
if msg <> ´´ then
MessageDlg(msg,mterror,[mbok],0);
end;
{------------------------------------------------------------------------------}
function NumberofDecimalFigures(value : TFloat;NumericFormat:TNumericFormat):Byte;
const
smallvalue : TFloat = 1e-16;
var
temp : integer;
X : TFloat;
XS : string;
begin
x := abs(value);
X := frac(x)+SmallValue;
if x = SmallValue then
x := 0;
xs := floattostrf(X,ffgeneral,12,0);
while (xs<>´´) and (xs[length(xs)]=´0´) do
delete (xs,length(xs),1);
temp := length(XS)-2;
if NumericFormat=nfPercent then
temp := temp-2;
if temp < 0 then
result := 0
else
result := temp;
end;
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
constructor TCustomNumberEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Alignment := tarightJustify;
ControlStyle := ControlStyle - [csSetCaption];
FSkip := true;
FInvalidating := False;
FChangingValue := False;
FSettingUpForCurrencyShow := False;
FBeepOnError := True;
FOutOfRangeErrorMessage := ´Number out of range´;
FShowRangeError := true;
FNumericFormat := nfComma;
FDecimalFigures := 2;
FCurrencySign := ´$´;
Fthousandseparator := ´,´;
FDecimalseparator := ´.´;
FRoundNumber := False;
FParenthesis := False;
FPositiveColor := clBlack;
FNegativeColor := clRed;
FMinimumAllowedValue := 0;
FMaximumAllowedValue := 0;
FActonEnter := False;
FSavedDecimalFigures := FDecimalFigures;
fValue := 0;
text:=´0.00´;
Fskip := False;
FLockDecimalFigures := false;
FForceLimitedDecimals := false;
FAllowNegativeNumber := true;
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.invalidate;
begin
if FSkip then
exit;
if FInvalidating then
exit;
FInvalidating := true;
try
SetupForEdit;
SetupForShow;
finally
inherited invalidate;
Finvalidating := false;
end;
end;
{------------------------------------------------------------------------------}
Procedure TCustomNumberEdit.FSetDecimalFigures(value:Byte);
begin
if value = FDecimalFigures then
exit;
// if (value < 0) or (value > 15) then
if (value > 15) then
raise ENumberEditControl.create(´Número de casas decimais inválido.´)
else
begin
FDecimalFigures := value;
invalidate;
end;
end;
{------------------------------------------------------------------------------}
Procedure TCustomNumberEdit.FSetMinimumAllowedValue(value:TFloat);
begin
if value = FMinimumAllowedValue then
exit;
if (value > FMaximumAllowedValue) and (not (CsReading in Componentstate)) then
raise ENumberEditControl.create(´Valor mínimo permitido não pode ser ´+
´maior que o maior valor permitido.´)
else
FMinimumAllowedValue := value;
end;
{------------------------------------------------------------------------------}
Procedure TCustomNumberEdit.FSetMaximumAllowedValue(value:TFloat);
begin
if value = FMaximumAllowedValue then
exit;
if value < FMinimumAllowedValue then
raise ENumberEditControl.create(´Valor máximo permitido não pode ser ´+
´menor que o menor valor permitido.´)
else
FMaximumAllowedValue := value;
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.FSetNumericFormat(Value:TNumericFormat);
begin
if value = FNumericFormat then
exit;
FNumericFormat:=value;
invalidate;
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.FSetCurrencySign(value:TCurrencyString);
begin
if value = FCurrencySign then
exit;
FCurrencySign := value;
invalidate;
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.Fsetthousandseparator(value:char);
begin
if value = Fthousandseparator then
exit;
Fthousandseparator:=value;
invalidate;
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.FsetDecimalseparator(value:char);
begin
if value = FDecimalseparator then
exit;
FDecimalseparator:=value;
invalidate;
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.FsetRoundNumber(value:boolean);
begin
if value = FRoundNumber then
exit;
FRoundNumber:=value;
invalidate;
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.FSetParenthesis(value:Boolean);
begin
if value = FParenthesis then
exit;
FParenthesis:=value;
invalidate;
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.FsetPositiveColor(value:Tcolor);
begin
if value = FPositiveColor then
exit;
FPositiveColor:=value;
invalidate;
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.Fsetnegativecolor(value:Tcolor);
begin
if value = FNegativeColor then
exit;
FNegativeColor:=value;
invalidate;
end;
{------------------------------------------------------------------------------}
function TCustomNumberEdit.ValueinRange(value:TFloat):Boolean; {1.01a}
begin
if ((value < FMinimumAllowedValue)
or(value > FMaximumAllowedValue))
and(FMinimumAllowedValue<>FMaximumAllowedValue) then
result := false
else
result := true;
end;
{------------------------------------------------------------------------------}
Procedure TCustomNumberEdit.FsetValue (value : TFloat);
begin
if ValueInRange(value) then
begin
FChangingValue := true;
fvalue:=value;
invalidate;
FchangingValue := false;
end
else if ShowRangeError then
RaiseError(FOutOfRangeErrorMessage,FBeepOnError);
end;
{------------------------------------------------------------------------------}
function TCustomNumberEdit.TNEformatfloat(x:TFloat):string;
begin
SySUtils.DecimalSeparator:=FDecimalseparator;
SysUtils.ThousandSeparator:=Fthousandseparator;
result := FormatFloat(´#,´+DecimalPicture,x);
if pos(FDecimalseparator,result)=1 then
result := ´0´+result
else if result = ´´ then
result := ´0´;
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.setValue;
var
d : TFloat;
s : real;
// t : string;
begin
if FNumericFormat = nfgeneral then
exit;
if fvalue>=0 then
s := 0.5
else
s := -0.5;
d := power10(FDecimalFigures);
if FRoundNumber then
value := int((fvalue*d)+s)/d;
end;
{------------------------------------------------------------------------------}
Procedure TCustomNumberEdit.FormatNegativeColor;
//var
//t :string;
// OldFSkip : Boolean;
begin
if not FAllowNegativeNumber then
exit;
if (fvalue<0) and (Font.Color<>FNegativeColor) then
Font.Color := FNegativeColor
else if (fvalue>=0) and (Font.Color<>FPositiveColor) then
Font.Color := FpositiveColor;
end;
{------------------------------------------------------------------------------}
Procedure TCustomNumberEdit.FormatNegativetext;
var
t :string;
OldFSkip : Boolean;
begin
if fvalue<0 then
if FParenthesis then
begin
t :=text;
delete(t,pos(´-´,t),1);
OldFSkip := Fskip;
Fskip := true;
text := ´(´+t+´)´;
Fskip := OldFSkip;
end;
end;
{------------------------------------------------------------------------------}
function TCustomNumberEdit.decimalpicture:string;
var
c : byte;
begin
result:=´´;
for c := 1 to FDecimalFigures do
result:=result+´0´;
if result <> ´´ then
result := ´.´+result;
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.setpercentshow;
//var
// v : TFloat;
begin
if text = ´´ then
begin
FValue := 0;
exit;
end;
setValue;
text := TNEformatfloat(fvalue*100);
text := text+´¬´;
FormatNegativeColor;
FormatNegativeText;
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.setpercentedit;
begin
text:=floattostr(fvalue);
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.setCommashow;
//var
// v : TFloat;
begin
if text = ´´ then
begin
FValue := 0;
exit;
end;
setValue;
text := TNEformatfloat(fvalue);
FormatNegativeColor;
FormatNegativeText;
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.setCommaedit;
begin
text:=floattostr(fvalue);
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.setCurrencyshow;
//var
// v : TFloat;
begin
if FSettingUpForCurrencyShow then
exit;
if text = ´´ then
begin
FValue := 0;
exit;
end;
FSettingUpForCurrencyShow := true;
try
setValue;
text := TNEformatfloat(fvalue);
text := FCurrencySign+text;
FormatNegativeColor;
FormatNegativeText;
finally
FSettingUpForCurrencyShow := false;
end;
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.setCurrencyedit;
begin
text:=floattostr(fvalue);
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.setGeneralshow;
//var
// v : TFloat;
begin
if text = ´´ then
begin
FValue := 0;
exit;
end;
setValue;
FormatNegativeColor;
FormatNegativeText;
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.setGeneraledit;
begin
text:=floattostr(fvalue);
end;
{------------------------------------------------------------------------------}
Procedure TCustomNumberEdit.SetupForShow;
begin
case FNumericFormat of
nfPercent : SetPercentshow;
nfComma : SetCommashow;
nfCurrency : SetCurrencyshow;
nfGeneral : SetGeneralshow;
end;
end;
{------------------------------------------------------------------------------}
Procedure TCustomNumberEdit.SetupForEdit;
Begin
case FNumericFormat of
nfPercent : SetPercentedit;
nfComma : SetCommaedit;
nfCurrency : SetCurrencyedit;
nfGeneral : SetGeneraledit;
end;
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.DoEnter;
var
temp : integer;
begin
try
FEntrouNoComponente := True;
FSkip := true;
inherited DoEnter;
FOldParenthesis := FParenthesis;
FParenthesis := False;
FOldCurrencySign := FCurrencySign;
FCurrencysign := ´´;
if (FOldParenthesis) or (NumericFormat = nfCurrency) then
setupForshow;
FSavedDecimalFigures := FDecimalFigures;
if LockDecimalFigures then
temp := DecimalFigures
else
temp := NumberOfDecimalFigures(FValue,FNumericFormat);
if Temp < FSavedDecimalFigures then
Temp := FSavedDecimalFigures;
if (temp <= 0) then
begin
//if FSavedDecimalFigures < 0 then
// FDecimalFigures := 0;
end
else
FDecimalFigures := Temp;
if FDecimalFigures <> FSavedDecimalFigures then
setupforshow;
if (FDecimalFigures <> 0) then
self.SelStart := length(text)-DecimalFigures-1-length(ExtraRightcharacters)
else
self.SelStart := length(text)-length(ExtraRightcharacters);
if AutoSelect then
SelectAll;
finally
FSkip := False;
end;
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.DoExit;
begin
try
FSkip := true;
inherited DoExit;
if FDecimalFigures <> FSavedDecimalFigures then
FDecimalFigures := FSavedDecimalFigures;
FParenthesis := FOldParenthesis;
FCurrencySign := FOldCurrencySign;
setupforshow;
finally
FSkip := False;
end;
end;
{------------------------------------------------------------------------------}
function TCustomNumberEdit.ExtraRightcharacters:string;
begin
result := ´´;
if FNumericFormat = nfPercent then
result := result+´¬´;
if (fvalue < 0) and FParenthesis then
result := result + ´)´;
end;
{------------------------------------------------------------------------------}
function TCustomNumberEdit.ExtraLeftcharacters:string;
begin
result := ´´;
if FNumericFormat = nfcurrency then
result := result+FCurrencySign;
if (fvalue < 0) then
begin
if FParenthesis then
result := result + ´(´
else
result := result + ´-´;
end;
end;
{------------------------------------------------------------------------------}
{The Heart of the NumberEdit Component}
procedure TCustomNumberEdit.change;
var
s : string;
TempValue : TFloat;
oldpos : word;
oldlength : word;
startingtext : string;
ValueIsNegative : Boolean;
begin
if NumericFormat = nfGeneral then
exit;
if FSkip or FChangingValue then
begin
inherited change;
exit;
end;
if (csLoading in Componentstate) or (CsReading in Componentstate) then
begin
exit;
end;
{strip extra characters from the string representation of the number}
s :=stripextraletters(text,FCurrencySign,[´0´..´9´,fdecimalseparator,´+´,´-´,´E´,´e´]);
if ForceLimitedDecimals then
begin
if FDecimalFigures > FSavedDecimalFigures then
begin
delete(s,length(s),1);
FDecimalFigures := FSavedDecimalFigures;
end;
end;
if not (NumericFormat = nfCurrency) then
begin
if (pos (´-´+fdecimalseparator,text)=1) then
begin
{fvalue :=}
if StrToFloat(S)= 0 then
begin
inherited change;
exit;
end;
end;
end
else if pos (CurrencySign+´-´+fdecimalseparator,text)=1 then
begin
fvalue := 0;
inherited change;
exit;
end;
{if pos(´-´+fdecimalseparator,s)=1 then
s := ´-0´+fdecimalseparator+copy(s,3,length(s)-2)
else}
if pos(fdecimalseparator,s)=1 then
s := ´0´+s;
if (s =TNEFormatFloat(0))
or (s=´-´+TNEFormatFloat(0))
or (s =´-´) or (s = ´´)then
begin
fvalue :=0;
if FSavedDecimalFigures = 0 then
Self.SelStart := length(text)-length(ExtraRightCharacters);
inherited change;
exit;
end;
Fskip := True;
startingtext := text;
try
oldpos := self.SelStart;
oldlength := length(text);
TempValue := fvalue;
if (s=´´) or (s=´-´) then
Tempvalue := 0
else
try
Tempvalue := strtofloat(s);
except
RaiseError(s+´ não é um número válido.´,FBeepOnError);
text := FOldtext;
exit;
end;
if text[1]=´(´ then
TempValue := -TempValue;
if ValueInRange(TempValue) then
begin
fvalue := TempValue;
if (FNumericFormat=nfPercent) then
fvalue := fvalue/100;
end
else if (s <> ´´) and (s<>´-´) then
begin
if ShowRangeError then
RaiseError(FOutOfRangeErrorMessage,FBeepOnError);
text := FOldText;
exit;
end;
ValueIsNegative := false;
if (fvalue = 0) and (pos(´-´,s)<>0) then
begin
ValueIsNegative := true;
end;
setupforshow;
if ValueIsNegative then
Text := ´-´+text;
self.SelStart := oldpos+length(text)-(oldlength);
if (pos(´-´,startingtext)<>0) and (pos(´-´,text)=0) then
self.selstart := self.selstart-1;
if self.SelStart >(length(text)-DecimalFigures-1-length(ExtraRightcharacters)) then
begin
if FCharacterIsDelete then
begin
if FMoveCursor then
Self.SelStart := Self.SelStart-1
end
else if FMoveCursor then
Self.SelStart := Self.SelStart+1;
end;
if FSelectedALL and (not (FDecimalFigures=0)) then
self.SelStart := length(text)-DecimalFigures-1-length(ExtraRightcharacters);
finally
if (fvalue = 0) and (FSavedDecimalFigures = 0) then
Self.SelStart := length(text);
FSkip := false;
inherited change;
end;
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
if Trim(text) <> ´´ then
if (key=46) and (text[self.SelStart+1]=FDecimalSeparator) then
self.SelStart := self.SelStart+1;
if Trim(text) <> ´´ then
if (key=46) and (self.SelStart>1) and (text[self.SelStart+1]=ThousandSeparator) then
self.SelStart := self.SelStart+1;
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.keypress;
var
oldpos : integer;
tempstr : string;
tempFloat : TFloat;
err: integer;
wn : TwinControl;
begin
{ inherited Keypress (key);}
if ReadOnly then
begin
key := #0;
inherited Keypress (key);
exit;
end;
if (key = ´-´) and (not FAllowNegativeNumber) then
begin
key := 0;
if FBeepOnError then
MessageBeep(0);
inherited Keypress (key);
exit;
end;
FOldText := text;
FCharacterIsDelete := False;
FSelectedAll := (self.SelLength = Length(text));
if FSelectedAll then
begin
val (key,TempFloat,err);
if err = 0 then
begin
if NumericFormat = nfPercent then
TempFloat := TempFloat / 100;
value := TempFloat;
SelStart := 1;
key := 0;
inherited Keypress (key);
exit;
end {else
value := 0;}
end;
if (key<>chr(8))then
begin
if (self.SelStart >=
Length(text)-length(ExtraRightcharacters)-FDecimalFigures) then
begin
if FSavedDecimalFigures > 0 then
begin
FMoveCursor := false;
if FDecimalFigures <= NumberOfDecimalFigures(Fvalue,FNumericFormat) then
inc(FDecimalFigures)
else
FMoveCursor := true;
end;
end;
end;
if (key=chr(8))then
begin
FMoveCursor := true;
if (self.SelStart >=
Length(text)-length(ExtraRightcharacters)-FDecimalFigures) then
begin
if FDecimalFigures > 1 then
begin
FMoveCursor := false;
if FSavedDecimalFigures < FDecimalFigures then
dec(FDecimalFigures)
else
FMoveCursor := true;
end
else
FMoveCursor := false;
end;
end;
if Key=chr(8) then
FCharacterIsDelete := True;
if (key=chr(8)) and (self.SelStart>1) and (text[self.SelStart]=FDecimalSeparator) then
self.SelStart := self.SelStart-1;
if (key=chr(8)) and (self.SelStart>1) and (text[self.SelStart]=ThousandSeparator) then
self.SelStart := self.SelStart-1;
if self.SelStart < length(Extraleftcharacters) then
self.SelStart := length(Extraleftcharacters);
if FActonEnter and (key = chr(vk_Return)) then
{sendmessage(parent.handle,WM_NEXTDLGCTL,0,0);}
begin
key := #0;
wn := self.parent;
while not (wn is Tform) do
wn := wn.parent;
sendmessage(wn.handle,WM_NEXTDLGCTL,0,0);
end;
if not (key in [´0´..´9´,fdecimalseparator,{´+´,}´-´,{´E´,´e´,}chr(8)]) then
key := char(0)
else if (key=fdecimalseparator) and (not (NumericFormat = nfGeneral)) then
begin
key := chr(0);
Self.SelStart := length(text)-DecimalFigures-length(ExtraRightcharacters);
end
else if (key = chr(8)) and (FNumericFormat = nfCurrency)
and (SelStart = Length(FCurrencySign)) then
key := chr(0)
else if (key = ´-´) then
begin
key := chr(0);
oldPos := selstart;
if pos(´-´,text) <> 0 then
begin
tempstr := text;
delete(tempstr,pos(´-´,text),1);
text := tempstr;
selstart := oldpos - 1;
end
else
begin
if (text <> ´´) and (text[1]=´0´) then
begin
tempstr := text;
delete(tempstr,1,1);
text := ´-´+tempstr;
end
else
text := ´-´+text;
selstart := oldpos + 1;
end;
end;
inherited Keypress (key);
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.WMSize(var Message: TWMSize);
//var
// Loc: TRect;
// MinHeight: Integer;
begin
inherited;
{$ifNdef Win32}
MinHeight := GetMinHeight;
{ text edit bug: if size to less than minheight, then edit ctrl does
not display the text }
if Height < MinHeight then
Height := MinHeight
{$endif}
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.WMCut(var Message: TMessage);
begin
inherited;
clipBoard.AsText := FloatToStr(Self.value);
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.WMCopy(var Message: TMessage);
begin
clipBoard.AsText := FloatToStr(Self.value);
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.WMPaste(var Message: TMessage);
var
s : string;
v : TFloat;
err : integer;
begin
s := clipboard.astext;
if FAllowNegativeNumber then
s :=stripextraletters(s,FCurrencySign,[´0´..´9´,fdecimalseparator,´+´,´-´,´E´,´e´])
else
s :=stripextraletters(s,FCurrencySign,[´0´..´9´,fdecimalseparator,´+´,´E´,´e´]);
val(s,v,err);
if err = 0 then
value := v
else
MessageBeep(0);
end;
{------------------------------------------------------------------------------}
function TCustomNumberEdit.GetMinHeight: 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 := Metrics.tmHeight + I div 4 + GetSystemMetrics(SM_CYBORDER) * 4 + 2;
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.CreateParams(var Params: TCreateParams);
const
Alignments: array[TAlignment] of Longint = (ES_LEFT, ES_RIGHT, ES_CENTER);
begin
inherited CreateParams(Params);
Params.Style := Params.Style or ES_MULTILINE or Alignments[FAlignment];
end;
{------------------------------------------------------------------------------}
procedure TCustomNumberEdit.SetAlignment(Value: TAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
RecreateWnd;
end;
end;
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
constructor TSNumberEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
self.AutoSize := true;
FSpinButton := TSpinButton.Create(self);
FSpinButton.Parent := self;
FSpinButton.Height := self.Height;
FSpinButton.width := 15;
FSpinButton.Top := 0;
FSpinButton.left := self.width - FSpinButton.width;
FSpinButton.Align := alRight;
FSpinButton.Ctl3d := False;
FSpinButton.TabStop := False;
FSpinButton.OnDownClick := ProcessDownClick;
FSpinButton.OnUpClick := ProcessUpClick;
FIncrement := 1.0;
end;
{------------------------------------------------------------------------------}
destructor TSNumberEdit.Destroy;
begin
FSpinButton.Free;
inherited Destroy;
end;
{------------------------------------------------------------------------------}
procedure TSNumberEdit.keypress(var key:char);
begin
if self.parent = nil then
exit;
inherited keypress(key);
SetEditRect;
end;
{------------------------------------------------------------------------------}
procedure TSNumberEdit.Change;
begin
if self.parent = nil then
exit;
inherited Change;
SetEditRect;
end;
{------------------------------------------------------------------------------}
procedure TSNumberEdit.DoEnter;
begin
if self.parent = nil then
exit;
inherited DoEnter;
SetEditRect;
end;
{------------------------------------------------------------------------------}
procedure TSNumberEdit.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style or WS_CLIPCHILDREN;
end;
{------------------------------------------------------------------------------}
procedure TSNumberEdit.CreateWnd;
//var
// Loc: TRect;
begin
inherited CreateWnd;
SetEditRect;
end;
{------------------------------------------------------------------------------}
procedure TSNumberEdit.SetEditRect;
var
Loc: TRect;
begin
SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));
Loc.Bottom := ClientHeight + 1;
Loc.Right := ClientWidth - FSpinButton.Width - 2;
Loc.Top := 0;
Loc.Left := 0;
SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Loc));
SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));
end;
{------------------------------------------------------------------------------}
procedure TSnumberEdit.WMSize(var Message: TWMSize);
//var
// W, H : integer;
begin
inherited;
if FSpinButton <> nil then
begin
FSpinButton.SetBounds (Width - FSpinButton.Width, 0, FSpinButton.Width, Height);
SetEditRect;
end;
end;
{------------------------------------------------------------------------------}
procedure TSNumberEdit.ProcessDownClick (Sender : TObject);
begin
if ((self.value - FIncrement) < 0) and (not FAllowNegativeNumber) then
exit;
self.value := self.value - FIncrement;
change;
end;
{------------------------------------------------------------------------------}
procedure TSNumberEdit.ProcessUpClick (Sender : TObject);
begin
self.value := self.value + FIncrement;
change;
end;
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
constructor TCNumberEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
self.AutoSize := true;
FButton := TBitBtn.Create(self);
FButton.Parent := self;
{$ifdef Win32}
FButton.Height := self.Height - 4;
FButton.Top := 2;
FButton.width := buttonWidth;
FButton.left := self.width - FButton.width -2;
{$Else}
FButton.Height := self.Height;
FButton.Top := 0;
FButton.width := buttonWidth;
FButton.left := self.width - FButton.width ;
{$EndIf}
FButton.Caption :=´...´;
FButton.style := bsNew;
FButton.TabStop := False;
FButton.OnClick := ProcessClick;
Calcleft := (screen.width div 2) - 90;
CalcTop := (screen.Height div 2) - 145;
end;
{------------------------------------------------------------------------------}
destructor TCNumberEdit.Destroy;
begin
FButton.free;
inherited Destroy;
end;
{------------------------------------------------------------------------------}
procedure TCNumberEdit.keypress(var key:char);
begin
if self.parent = nil then
exit;
inherited keypress(key);
SetEditRect;
end;
{------------------------------------------------------------------------------}
procedure TCNumberEdit.Change;
begin
if self.parent = nil then
exit;
inherited Change;
SetEditRect;
end;
{------------------------------------------------------------------------------}
procedure TCNumberEdit.DoEnter;
begin
if self.parent = nil then
exit;
inherited DoEnter;
SetEditRect;
end;
{------------------------------------------------------------------------------}
procedure TCNumberEdit.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style or WS_CLIPCHILDREN;
end;
{------------------------------------------------------------------------------}
procedure TCNumberEdit.CreateWnd;
//var
// Loc: TRect;
begin
inherited CreateWnd;
SetEditRect;
end;
{------------------------------------------------------------------------------}
function TCNumberEdit.GetVisibleButton:Boolean;
begin
result := FButton.width <> 0;
end;
{------------------------------------------------------------------------------}
procedure TCNumberEdit.SetVisibleButton(value : boolean);
begin
if value then
FButton.Width := ButtonWidth
else
FButton.Width := 0;
RecreateWnd;
end;
{------------------------------------------------------------------------------}
function TCNumberEdit.GetEnableButton:Boolean;
begin
result := FButton.Enabled;
end;
{------------------------------------------------------------------------------}
procedure TCNumberEdit.SetEnableButton(value : boolean);
begin
if value = FButton.Enabled then
exit;
FButton.Enabled := value;
end;
{------------------------------------------------------------------------------}
procedure TCNumberEdit.SetEditRect;
var
Loc: TRect;
begin
SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));
Loc.Bottom := ClientHeight;
Loc.Right := ClientWidth - FButton.Width - 4;
Loc.Top := 0;
Loc.Left := 0;
SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Loc));
SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));
end;
{------------------------------------------------------------------------------}
procedure TCnumberEdit.WMSize(var Message: TWMSize);
//var
// Loc: TRect;
// MinHeight: Integer;
begin
inherited;
if FButton <> nil then
begin
{$ifdef Win32}
FButton.SetBounds (Width - FButton.Width-4, 0, FButton.Width, Height-4);
{$Else}
FButton.SetBounds (Width - FButton.Width, 0, FButton.Width, Height);
{$EndIf}
SetEditRect;
end;
end;
{------------------------------------------------------------------------------}
procedure TCNumberEdit.ProcessClick (Sender : TObject);
var
Calculator: TCalculator;
begin
SetEditRect;
Calculator := TCalculator.create(Application);
try
Calculator.Caption := FCaption;
if CalcPosition <> cpCenter then
begin
Calculator.Left := self.CalcLeft;
Calculator.Top := self.CalcTop;
end;
Calculator.NumberEdit1.value := self.value;
if Calculator.Showmodal = mrok then
begin
if (Calculator.NumberEdit1.value>0) or ( FAllowNegativeNumber) then
self.value := Calculator.NumberEdit1.value;
end;
finally
Calculator.free;
self.Setfocus;
invalidate;
end;
end;
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
constructor TmmCalculator.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
self.left := (screen.width div 2) - 90;
self.Top := (screen.Height div 2) - 145;
end;
{------------------------------------------------------------------------------}
procedure TmmCalculator.Notification( AComponent : TComponent; Operation : TOperation);
begin
inherited Notification( AComponent, Operation );
if ( Operation = opRemove ) and ( AComponent = FAssociatedWindow ) then
FAssociatedWindow := nil;
end;
{------------------------------------------------------------------------------}
function TmmCalculator.Execute:integer;
var
Calculator : TCalculator;
counter : Integer;
begin
Calculator := TCalculator.Create( Application );
try
Calculator.Caption := FCaption;
if Position <> cpCenter then
begin
Calculator.Left := self.Left;
Calculator.Top := self.Top;
end;
Result := Calculator.ShowModal;
if (Result=mrOK) and (AssociatedWindow <> nil) then
for Counter:= 1 to Length(Calculator.NumberEdit1.Text) do
SendMessage(AssociatedWindow.Handle,WM_CHAR,
ord(Calculator.NumberEdit1.Text[counter]),0);
finally
Calculator.Free;
end;
end;
{------------------------------------------------------------------------------}
end.
Nglauber
Curtidas 0
Respostas
Lucas Silva
25/05/2004
Acho dificel alguem tem paciência pra ler e enteder este código seu todo..
Seria bem mais interessante, você postar só um fragmento do código.
Depois dá uma lida no ´tópico : Como obter respostas rápidas
Seria bem mais interessante, você postar só um fragmento do código.
Depois dá uma lida no ´tópico : Como obter respostas rápidas
GOSTEI 0
Nglauber
25/05/2004
Bem galera,
Como ninguém respondeu, eu fiz meu próprio Edit numérico.
Que quizer testá-lo, eu mando os fontes.
[]´s
Como ninguém respondeu, eu fiz meu próprio Edit numérico.
Que quizer testá-lo, eu mando os fontes.
[]´s
GOSTEI 0
Rômulo Barros
25/05/2004
Beleza !! Gostei muito do código.... (é aquele q vc mandou pra mim, né?)
GOSTEI 0