Edit Numérico

Delphi

25/05/2004

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.

(***************************************************************************)
(***************************************************************************)
(****                                                                  ****)
(****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

Nglauber

Curtidas 0

Respostas

Lucas Silva

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


GOSTEI 0
Nglauber

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


GOSTEI 0
Rômulo Barros

Rômulo Barros

25/05/2004

Beleza !! Gostei muito do código.... (é aquele q vc mandou pra mim, né?)


GOSTEI 0
POSTAR