Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Otros temas > Trucos
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Los mejores trucos

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 06-04-2007
Hell_Raiser Hell_Raiser is offline
Miembro
 
Registrado: jun 2004
Posts: 13
Poder: 0
Hell_Raiser Va por buen camino
texto de edit tipo currency

He buscado en el foro como limitar un edit a cierta cantidad de enteros un punto y cierta cantidad de decimales
por ejemplo "12345.00". Aqui la cantidad de enteros es de 5 caracteres, un solo punto, y dos caracteres para los decimales todo esto sin que el usuario final tenga la posibilidad de equivocarse, o sea que solo puede escribir el punto una sola vez, despues del punto solo puede escribir 2 caracteres y antes del punto solo puede escribir 5 caracteres. Y claro debe estar alineado a la derecha como toda cadena de tipo numerico. El codigo es una recopilacion del foro, no dudaria que ya existiera algun metodo para hacer esto sin batallar tanto.
Código Delphi [-]
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
var
  i,decimales,enteros: integer;
  numEnteros,numDecimales:integer;
  cantidad:string;
begin
  //Aqui se definen la cantidad de enteros y decimales que se desean
  numEnteros:=5;
  numDecimales:=2;
  ///////////////

  cantidad:=(Sender as TEdit).Text;
  decimales:=-1;
  enteros:=1;

  if (not(key in ['0'..'9', #8, #9,'.'])) then
    key:=#0;

  for i:=1 to Length(cantidad) do
    begin
      enteros:=enteros+1;
      if (cantidad[i] = '.') then
      begin
        if (key = '.') then
          key:=#0;
        decimales:=decimales+1
      end;
      if decimales >= 0 then
        decimales:=decimales+1;
      if (decimales>numDecimales) and (not (key in[#8, #9])) then
        key:=#0;
      if (enteros>numEnteros) then
      begin
        if  (decimales<0) and (i=Length(cantidad)) then
        begin
          if not (key in[#8, #9, '.']) then
            key:=#0
        end;
      end;

    end;
end;
Aqui se valida en el evento onKeyPress de un TEdit, todos los caracteres validos y se especifican las cantidades, si se desea que algun otro edit tenga la misma funcionalidad solo es necesario agregarle al evento onKeyPress en el Object Inspector el evento onKeyPress del TEdit que tiene el codigo antes mencionado, para eso es la linea
Código Delphi [-]
cantidad:=(Sender as TEdit).Text;

Para mi caso en particular todos los edits de mi forma deben ser de este tipo por lo que todos deben tener el texto alineado a la derecha.
Código Delphi [-]
procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
var obj:Tedit;
begin
  SysLocale.MiddleEast := true;
  for i:=1 to self.ComponentCount do
  begin
    if self.Components[i-1].ClassType = TEdit then
      obj:=self.Components[i-1] as TEdit;
      obj.BiDiMode := bdRightToLeft
  end;
end;

Pero para el caso en que no sea asi agrego el siguiente codigo solo es necesario nombrar al componente TEdit las primeras cuatro letras edit pero creo que es mejor modificarlo a sus necesidades.
Código Delphi [-]
procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
var obj:Tedit;
begin
  SysLocale.MiddleEast := true;
  for i:=1 to self.ComponentCount do
  begin
    if (AnsiLeftStr(self.Components[i-1].Name,4)='Edit') then
      obj:=self.Components[i-1] as TEdit;
      obj.BiDiMode := bdRightToLeft
  end;
end;

Espero que esto les sea de utilidad y si conocen alguna manera mas sencilla o mas facil de hacerlo espero que me lo digan para saber como es que perdi mi tiempo.
Responder Con Cita
  #2  
Antiguo 11-04-2007
Avatar de axesys
axesys axesys is offline
Miembro
 
Registrado: ene 2007
Ubicación: Los Mochis Sinaloa
Posts: 208
Poder: 18
axesys Va por buen camino
Componente para Delphi Win32

Código Delphi [-]

unit NumCtrl;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Menus;

{ string edit component }
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];

{ mask component }
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;

{ num edit component }
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 CN_KeyUp(var Message: TWMKeyUp); message CN_KEYUP;
    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;

{========================================================================}
{ support routines                                                       }
{========================================================================}

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;

{========================================================================}
{ Custom String Edit                                                     }
{========================================================================}

constructor TCustomStrEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAlignment := taLeftJustify;
  FTextMargin := CalcTextMargin;
end;

function TCustomStrEdit.CalcTextMargin : integer;
{borrowed from TDBEdit}
{calculates a pixel offset from the edge of the control to the text(a margin)}
{used in the paint routine}
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);
{borrowed from TDBEdit}
{paints the text in the appropriate position}
var
  Width, Indent, Left: Integer;
  R: TRect;
  DC: HDC;
  PS: TPaintStruct;
  S: string;
  Canvas: TControlCanvas;
begin
  {let the existing code handle left justify}
  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;
//        FrameRect(R);
        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;{try}
end;
{========================================================================}
{ Masks object                                                           }
{========================================================================}

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;

{========================================================================}
{ Custom Numeric Edit                                                    }
{========================================================================}

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
  {only allow numerics, commas and one period}
  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
  {strip the mask and left justify the field}
  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 ]); {remove all literal characters}
  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
  {round the number appropriately}
  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; {will cause rounding in the FloatToStr function}
  end;

  {format the number}
  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;

{ string edit component }
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];
{ mask component }
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;

{ num edit component }
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 CN_KeyUp(var Message: TWMKeyUp); message CN_KEYUP;
    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;

{========================================================================}
{ support routines                                                       }
{========================================================================}

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;

{========================================================================}
{ Custom String Edit                                                     }
{========================================================================}

constructor TCustomStrEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAlignment := taLeftJustify;
  FTextMargin := CalcTextMargin;
end;

function TCustomStrEdit.CalcTextMargin : integer;
{borrowed from TDBEdit}
{calculates a pixel offset from the edge of the control to the text(a margin)}
{used in the paint routine}
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);
{borrowed from TDBEdit}
{paints the text in the appropriate position}
var
  Width, Indent, Left: Integer;
  R: TRect;
  DC: HDC;
  PS: TPaintStruct;
  S: string;
  Canvas: TControlCanvas;
begin
  {let the existing code handle left justify}
  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;
//        FrameRect(R);
        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;{try}
end;
{========================================================================}
{ Masks object                                                           }
{========================================================================}

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;

{========================================================================}
{ Custom Numeric Edit                                                    }
{========================================================================}

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
  {only allow numerics, commas and one period}
  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
  {strip the mask and left justify the field}
  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', '.' ]); {remove all literal characters}
  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
  {round the number appropriately}
  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; {will cause rounding in the FloatToStr function}
  end;

  {format the number}
  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.
Responder Con Cita
  #3  
Antiguo 12-04-2007
Hell_Raiser Hell_Raiser is offline
Miembro
 
Registrado: jun 2004
Posts: 13
Poder: 0
Hell_Raiser Va por buen camino
Se agradece la ayuda de axesys con el componente que mando, pero como bien dije era casi seguro que ya existiera alun componente, aunque, instale el componente para win32 y tiene algunos bugs , por que la cantidad de digitos permitidos va aumentando si pongo 1111. y los borro todos con backspace la proxima vez me permitira poner
11111. , y asi sucesivamente e igual con los decimales.
Responder Con Cita
Respuesta


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro


La franja horaria es GMT +2. Ahora son las 16:13:34.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi