Recull Components Delphi

FloatEdit

Caixa d'edició que només permet l'entrada de números reals.

unit FloatEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, DsgnIntf, ShellAPI;

type TFloatEditEd = class(TDefaultEditor)
  procedure ExecuteVerb(Index: integer); override;
  function GetVerb(Index: integer): string; override;
  function GetVerbCount: integer; override;
  end;

type
  TFloatEdit = class(TCustomEdit)
  private
    { Private declarations }
    FAlignment: TAlignment;
    FValue: double;
    lDelPressed: boolean;
    FVersion: string;
    FMaxIntValue: integer;
    FPrecission: integer;
    FSeparator: char;
    procedure SetAlignment(AAlignment: TAlignment);
    function GetValue: double;
    procedure SetValue(iNewVal: double);
    function GetAsFloat: double;
    procedure SetAsFloat(lnVal: double);
    function GetAsString: string;
    procedure SetAsString(strVal: string);
    procedure SetVersion(strVersion: string);
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  protected
    { Protected declarations }
    procedure KeyPress(var Key: Char); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure CreateParams(var Params: TCreateParams); override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    property AsFloat: double read GetAsFloat write SetAsFloat;
    property AsString: string read GetAsString write SetAsString;
  published
    { Published declarations }
    property MaxIntValue: integer read FMaxIntValue write FMaxIntValue;
    property Precission: integer read FPrecission write FPrecission;
    property Value: double read GetValue write SetValue;
    property Alignment: TAlignment read FAlignment write SetAlignment default taRightJustify;
    property Anchors;
    property AutoSelect;
    property AutoSize default True;
    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;
    (* General events properties *)
    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;
    property Version: string read FVersion write SetVersion;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Components Delphi', [TFloatEdit]);
end;

constructor TFloatEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAlignment := taRightJustify;
  FValue := 0;
  Text := '0';
  FSeparator := ',';
  FMaxIntValue := 2147483647;
  FPrecission := 2;
  lDelPressed := False;
  FVersion := '1.1';
end;

procedure TFloatEdit.SetAlignment(AAlignment: TAlignment);
begin
  if FAlignment <> AAlignment then
  begin
    FAlignment := AAlignment;
    if not (csDesigning in ComponentState) then
      RecreateWnd;
    if Focused then
      SelectAll;
  end;
end;

function TFloatEdit.GetValue: double;
begin
  Result := FValue;
end;

procedure TFloatEdit.SetValue(iNewVal: double);
begin
    Text := FloatToStr(iNewVal);
    FValue := iNewVal;
    if Focused then
    begin
      SelStart := Length(Text);
      SelectAll;
    end;
end;

procedure TFloatEdit.SetAsFloat(lnVal: double);
begin
  Value := lnVal;
end;

function TFloatEdit.GetAsFloat: double;
begin
  Result := Value;
end;

procedure TFloatEdit.SetAsString(strVal: string);
begin
  Value := StrToFloat(strVal);
end;

function TFloatEdit.GetAsString: string;
begin
  Result := FloatToStr(Value);
end;

procedure TFloatEdit.KeyPress(var Key: Char);
begin
  if not (Key in [#27, '0'..'9', #8, ',']) then begin
    Key := #0;
    MessageBeep(0);
    Exit;
  end
  else if (Key in ['0'..'9']) then
  begin
    if (Length(Copy(Text,Pos(',',Text)+1,Length(Text)-Pos(',',Text)+1))>FPrecission-1) and (Pos(',',Text)<>0) then
    begin
      Key := #0;
      MessageBeep(0);
      Exit;
    end
    else if Int(StrToFloat(Text+key))>FMaxIntValue then
    begin
      Key := #0;
      MessageBeep(0);
      Exit;
    end;
  end;
  inherited;
end;

procedure TFloatEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  ClearSelection;
  inherited KeyDown(Key,Shift);
end;

procedure TFloatEdit.KeyUp(var Key: Word; Shift: TShiftState);
begin
  inherited KeyUp(Key,Shift);
  if Text='' then
  begin
    Text := '0';
    SelStart := Length(Text);
    SelectAll;
  end;
  FValue := StrToFloat(Text);
end;

procedure TFloatEdit.CreateParams(var Params: TCreateParams);
var
{$ifdef VER120}
  lnStyle: LongWord;
{$else}
  lnStyle: LongInt;
{$endif}
begin
  inherited CreateParams(Params);
  case Alignment of
    taLeftJustify:
      lnStyle := ES_LEFT;
    taRightJustify:
      lnStyle := ES_RIGHT
    else
      lnStyle := ES_CENTER;
  end (*case*);
  with Params do
    Style := Style or DWORD(lnStyle);
end;

procedure TFloatEdit.SetVersion(strVersion: string);
begin

end;

procedure TFloatEdit.CMEnter(var Message: TCMEnter);
begin
  if AutoSelect and not ReadOnly then
    SelectAll
  else
    if not ReadOnly then
    begin
      SelStart := Length(Text);
    end (*if*);
  Refresh;
  inherited;
end;

end.

La propietat Value conté el número introduït. MaxIntValue conté el màxim valor enter que és possible introduïr. Amb Precission determinem el màxim número de decimals permesos. Alignment permet alinear el text a la dreta o a l'esquerra.