Chip 2001 September/Chip_2001-09_cd1.bin/zkuste/delphi/kolekce/d12345/MISC.ZIP/Nedit.pas

Pascal/Delphi Source File | 2001-05-02 | 18.9 KB | 712 lines

unit Nedit;

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at

http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for the specific language governing rights and limitations under the License.

The Original Code is: NEdit.pas, released 12 September 2000.

The Initial Developer of the Original Code is Mat Ballard.
Portions created by Mat Ballard are Copyright (C) 1999 Mat Ballard.
Portions created by Microsoft are Copyright (C) 1998, 1999 Microsoft Corp.
All Rights Reserved.

Contributor(s): Mat Ballard                 e-mail: [e-mail].

Last Modified: 05/25/2000
Current Version: 2.00

You may retrieve the latest version of this file from:

        http://Chemware.hypermart.net/

This work was created with the Project JEDI VCL guidelines:

        http://www.delphi-jedi.org/Jedi:VCLVCL

in mind.


Purpose:
Limit user input to various types and ranges of number

Known Issues:
 0         32    [space]      64    @     96    `
 1         33    !     65    A     97    a
 2         34    "     66    B     98    b
 3         35    #     67    C     99    c
 4         36    $     68    D     100    d
 5         37    %     69    E     101    e
 6         38    &     70    F     102    f
 7         39    '     71    G     103    g
 8    * *     40    (     72    H     104    h
 9    * *     41    )     73    I     105    i
 10    * *     42    *     74    J     106    j
 11         43    +     75    K     107    k
 12         44    ,     76    L     108    l
 13    * *     45    -     77    M     109    m
 14         46    .     78    N     110    n
 15         47    /     79    O     111    o
 16         48    0     80    P     112    p
 17         49    1     81    Q     113    q
 18         50    2     82    R     114    r
 19         51    3     83    S     115    s
 20         52    4     84    T     116    t
 21         53    5     85    U     117    u
 22         54    6     86    V     118    v
 23         55    7     87    W     119    w
 24         56    8     88    X     120    x
 25         57    9     89    Y     121    y
 26         58    :     90    Z     122    z
 27         59    ;     91    [     123    {
 28         60    <     92    \     124    |
 29         61    =     93    ]     125    curly brackets
 30         62    >     94    ^     126    ~
 31         63    ?     95    _     127
-----------------------------------------------------------------------------}

{$I Misc.inc}

interface

uses
  Classes, SysUtils,
{$IFDEF NO_MATH}NoMath,{$ELSE}Math,{$ENDIF}
{$IFDEF WINDOWS}
  WinTypes, WinProcs,
  Forms, StdCtrls, Graphics, Controls,
{$ENDIF}
{$IFDEF WIN32}
  Windows,
  Forms, StdCtrls,
{$ENDIF}
{$IFDEF LINUX}
  Untranslated,
  QForms, QStdCtrls,
{$ENDIF}
  Misc;

type
  TNumericType = (ntInteger, ntBinary, ntHex, ntFixed, ntCurrency, ntScientific);

  TDataType = (dtInteger, dtCardinal,
    dtShortint, dtSmallint, dtLongint,
{$IFDEF DELPHI2_UP}
    dtInt64,
{$ENDIF}
    dtByte, dtWord,
{$IFDEF DELPHI2_UP}
    dtLongword,
{$ENDIF}
    dtReal, dtReal48, dtSingle, dtDouble, dtExtended, dtComp
{$IFDEF DELPHI2_UP}
    ,dtCurrency
{$ENDIF}
    );

  TNEdit = class(TCustomEdit)
  private
    { Private declarations }
    FDataType: TDataType;
    FMin: Extended;
    FMax: Extended;
    FNumericType: TNumericType;

    function GetReal: Extended;
{$IFDEF DELPHI4_UP}
    function GetInt64: Int64;
{$ENDIF}
    function GetInteger: Integer;
{$IFDEF DELPHI2_UP}
    function GetCurrency: Currency;
{$ENDIF}

    procedure SetDataType(Value: TDataType);
    procedure SetNumericType(Value: TNumericType);
    procedure SetReal(Value: Extended);
{$IFDEF DELPHI4_UP}
    procedure SetInt64(Value: Int64);
{$ENDIF}
    procedure SetInteger(Value: Integer);
{$IFDEF DELPHI2_UP}
    procedure SetCurrency(Value: Currency);
{$ENDIF}

  protected
    Procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure DoExit; override;
  public
    { Public declarations }
    Constructor Create(AOwner:TComponent);override;
    function IsValid: Boolean;
  published
    { Published declarations }
    Property AsReal: Extended read GetReal write SetReal stored FALSE;
{$IFDEF DELPHI4_UP}
    Property AsInt64: Int64 read GetInt64 write SetInt64 stored FALSE;
{$ENDIF}
    Property AsInteger: Integer read GetInteger write SetInteger stored FALSE;
{$IFDEF DELPHI2_UP}
    Property AsCurrency: Currency read GetCurrency write SetCurrency stored FALSE;
{$ENDIF}
    Property DataType: TDataType read FDataType write SetDataType;
    Property Min: Extended read FMin write FMin;
    Property Max: Extended read FMax write FMax;
    Property NumericType: TNumericType read FNumericType write SetNumericType;

{The Custom... properties:}
    property AutoSelect;
    property AutoSize;
    property BorderStyle;
    property CharCase;
    property Color;
{$IFDEF MSWINDOWS}
    property Ctl3D;
    property DragCursor;
{$ENDIF}
    property Enabled;
    property Font;
    property HideSelection;
    property MaxLength;
{$IFDEF MSWINDOWS}
    property OEMConvert;
{$ENDIF}
    property ParentColor;
{$IFDEF MSWINDOWS}
    property ParentCtl3D;
{$ENDIF}
    property ParentFont;
    property ParentShowHint;
{$IFDEF MSWINDOWS}
    property PasswordChar;
{$ENDIF}
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Text;
    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;
{$IFDEF DELPHI2_UP}
{$ENDIF}
{$IFDEF DELPHI3_UP}
{$ENDIF}
{$IFDEF DELPHI4_UP}
    property Anchors;
{$IFDEF MSWINDOWS}
    property BiDiMode;
{$ENDIF}
    property Constraints;
{$IFDEF MSWINDOWS}
    property DragKind;
{$ENDIF}
    property DragMode;
{$IFDEF MSWINDOWS}
    property ImeMode;
    property ImeName;
    property ParentBiDiMode;
{$ENDIF}
    property PopupMenu;
{$IFDEF MSWINDOWS}
    property OnEndDock;
    property OnStartDock;
{$ENDIF}
    property OnStartDrag;
{$ENDIF}
{$IFDEF DELPHI5_UP}
{$ENDIF}
  end;

const
  TNEDIT_VERSION = 100;

  NumericTypes: array[TDataType] of string =
    ('Integer', 'Cardinal',
    'Shortint', 'Smallint', 'Longint',
{$IFDEF DELPHI2_UP}
    'Int64',
{$ENDIF}
    'Byte', 'Word',
{$IFDEF DELPHI2_UP}
    'Longword',
{$ENDIF}
    'Real', 'Real48', 'Single', 'Double', 'Extended', 'Comp'
{$IFDEF DELPHI2_UP}
    , 'Currency'
{$ENDIF}
    );

implementation

{------------------------------------------------------------------------------
    Procedure: TNEdit.Create
  Description: standard constructor
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: sets the Text and DataType
 Known Issues:
 ------------------------------------------------------------------------------}
constructor TNEdit.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  Text := '0';
  DataType := dtInteger;
end;

{------------------------------------------------------------------------------
    Procedure: TNEdit.KeyDown
  Description: standard KeyDown event handler
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: examines Key to see if valid
 Known Issues:
 ------------------------------------------------------------------------------}
Procedure TNEdit.KeyDown(var Key: Word; Shift: TShiftState);
var
  KeyOK: Boolean;

  function IsInteger: Boolean;
  begin
    if ((Ord('1') <= Key) and (Key <= Ord('9'))) then
      Result := TRUE
     else
      Result := FALSE;
  end;

begin
  KeyOK := FALSE;
  if (Key < VK_SPACE) then {32}
    KeyOK := TRUE
  else if (Key > Ord('~')) then
    KeyOK := TRUE
  else if ((Key = Ord('-')) and
    (FMin < 0)) then
      KeyOK := TRUE
  else
  begin
    case FNumericType of
      ntBinary:
        if ((Key = Ord('0')) or (Key = Ord('1'))) then
          KeyOK := TRUE;
      ntInteger: KeyOK := IsInteger;
      ntHex:
        if IsInteger or
          ((Ord('A') <= Key) and (Key <= Ord('F'))) or
          ((Ord('a') <= Key) and (Key <= Ord('f'))) then
            KeyOK := TRUE;
      ntFixed, ntCurrency:
        if (IsInteger or
          (Key = Ord('.'))) then
            KeyOK := TRUE;
      ntScientific:
        if (IsInteger or
          (Key = Ord('.')) or
          (Key = Ord('e')) or
          (Key = Ord('E')) or
          (Key = Ord('-'))) then
          KeyOK := TRUE;
    end;
  end;

  if (KeyOK) then
{call the TEdit parent function last:}
    inherited KeyDown(Key, Shift);
end;

{------------------------------------------------------------------------------
    Procedure: TNEdit.SetNumericType
  Description: standard property Set procedure
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: sets the NumericType Property
 Known Issues:
 ------------------------------------------------------------------------------}
procedure TNEdit.SetNumericType(Value: TNumericType);
begin
  if (Value = FNumericType) then exit;

  FNumericType := Value;
end;

{------------------------------------------------------------------------------
    Procedure: TNEdit.SetDataType
  Description: standard property Set procedure
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: sets the DataType Property
 Known Issues:
 ------------------------------------------------------------------------------}
procedure TNEdit.SetDataType(Value: TDataType);
begin
  if (Value = FDataType) then exit;

  FDataType := Value;
  case FDataType of
    dtInteger:
      begin
        FMin := Low(Integer);
        FMax := High(Integer);
      end;
    dtCardinal:
      begin
        FMin := Low(Cardinal);
        FMax := High(Cardinal);
      end;
    dtShortint:
      begin
        FMin := Low(Shortint);
        FMax := High(Shortint);
      end;
    dtSmallint:
      begin
        FMin := Low(Smallint);
        FMax := High(Smallint);
      end;
    dtLongint:
      begin
        FMin := Low(Longint);
        FMax := High(Longint);
      end;
{$IFDEF DELPHI4_UP}
    dtInt64:
      begin
        FMin := Low(Int64);
        FMax := High(Int64);
      end;
{$ENDIF}
    dtByte:
      begin
        FMin := Low(Byte);
        FMax := High(Byte);
      end;
    dtWord:
      begin
        FMin := Low(Word);
        FMax := High(Word);
      end;
{$IFDEF DELPHI4_UP}
    dtLongword:
      begin
        FMin := Low(Longword);
        FMax := High(Longword);
      end;
{$ENDIF}

{now the reals:}
    dtReal48:
      begin
        {FMin := 2.9e-39;}
        FMax := 1.7e38;
        FMin := -FMax;
      end;
    dtSingle:
      begin
        {FMin := 1.5e-45;}
        FMax := 3.4e38;
        FMin := -FMax;
      end;
    dtDouble, dtReal:
      begin
        {FMin := 5.0e-324;}
        FMax := 1.7e308;
        FMin := -FMax;
      end;
    dtExtended:
      begin
        {FMin := 3.6e-4951;}
        FMax := 1.1e4932;
        FMin := -FMax;
      end;
    dtComp:
      begin
        FMin := -IntPower(2, 63) + 1;
        FMax := IntPower(2, 63) -1;
      end;
{$IFDEF DELPHI2_UP}
    dtCurrency:
      begin
        FMin := -922337203685477.5808;
        FMax := 922337203685477.5807;
      end;
{$ENDIF}
  end;
  case FDataType of
    dtInteger .. {$IFDEF DELPHI2_UP}dtLongword{$ELSE}dtWord{$ENDIF}:
      if not ((FNumericType = ntInteger) or
              (FNumericType = ntBinary) or
              (FNumericType = ntHex)) then
        NumericType := ntInteger;
{$IFDEF DELPHI2_UP}
    dtCurrency:
      NumericType := ntCurrency;
{$ENDIF}
    else
      if not ((FNumericType = ntFixed) or
              (FNumericType = ntScientific)) then
        NumericType := ntScientific;
  end;
end;

{------------------------------------------------------------------------------
     Function: TNEdit.IsValid
  Description: examines Text to determine if it is a valid number
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: see Description
 Return Value: TRUE or FALSE
 Known Issues:
 ------------------------------------------------------------------------------}
function TNEdit.IsValid: Boolean;
var
  RealValue: Extended;
  TheResult: Boolean;
begin
  try
    TheResult := TRUE;
    case FDataType of
      dtInteger .. dtWord:
        begin
          if (FNumericType = ntHex) then
            RealValue := StrToInt('$' + Text)
           else
            RealValue := StrToInt(Text);
        end;
{$IFDEF DELPHI2_UP}
      dtLongword:
        RealValue := StrToInt(Text);
      dtCurrency:
        RealValue := StrToCurr(Text);
{$ENDIF}
    else
      RealValue := StrToFloat(Text);
    end;
    if ((RealValue < FMin) or
        (RealValue > FMax)) then
      TheResult := FALSE;
  except
    TheResult := FALSE;
  end;
  if (not TheResult) then
  begin
    raise EConvertError.CreateFmt(Text + ' is not a valid %s between %g and %g',
      [NumericTypes[FDataType], FMin, FMax]);
  end;
  IsValid := TheResult;
end;

{------------------------------------------------------------------------------
    Procedure: TNEdit.DoExit
  Description: standard DoExit event handler
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: examines the validity of the Text
 Known Issues:
 ------------------------------------------------------------------------------}
procedure TNEdit.DoExit;
begin
  IsValid;
  inherited DoExit;
end;

{------------------------------------------------------------------------------
     Function: TNEdit.GetReal
  Description: standard property Get function
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: gets the value of the Text Property as a Real
 Return Value: Extended
 Known Issues:
 ------------------------------------------------------------------------------}
function TNEdit.GetReal: Extended;
begin
  {Result := 0;}
  try
    Result := StrToFloat(Text);
  except
    Result := 0;
  end;
end;

{------------------------------------------------------------------------------
     Function: TNEdit.GetInteger
  Description: standard property Get function
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: gets the value of the Text Property as an Integer
 Return Value: IntEGER
 Known Issues:
 ------------------------------------------------------------------------------}
function TNEdit.GetInteger: Integer;
begin
  {Result := 0;}
  try
    if (FNumericType = ntHex) then
      Result := StrToInt('$' + Text)
     else
      Result := StrToInt(Text);
  except
    try
      Result := Round(StrToFloat(Text));
    except
      Result := 0;
    end;
  end;
end;

{$IFDEF DELPHI4_UP}
{------------------------------------------------------------------------------
     Function: TNEdit.GetInt64
  Description: standard property Get function
       Author: Mat Ballard
 Date created: 11/25/2000
Date modified: 11/25/2000 by Mat Ballard
      Purpose: gets the value of the Text Property as an Integer
 Return Value: Int64
 Known Issues:
 ------------------------------------------------------------------------------}
function TNEdit.GetInt64: Int64;
begin
  //Result := 0;
  try
    if (FNumericType = ntHex) then
      Result := StrToInt64('$' + Text)
     else
      Result := StrToInt64(Text);
  except
    try
      Result := Round(StrToFloat(Text));
    finally
    end;
  end;
end;
{$ENDIF}

{------------------------------------------------------------------------------
     Function: TNEdit.GetCurrency
  Description: standard property Get function
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: gets the value of the Text Property as Currency
 Return Value: Currency
 Known Issues:
 ------------------------------------------------------------------------------}
{$IFDEF DELPHI2_UP}
function TNEdit.GetCurrency: Currency;
begin
  //Result := 0;
  try
    GetCurrency := StrToCurr(Text);
  finally
  end;
end;
{$ENDIF}

{------------------------------------------------------------------------------
    Procedure: TNEdit.SetReal
  Description: standard property Set procedure
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: sets the Text Property numerically
 Known Issues:
 ------------------------------------------------------------------------------}
procedure TNEdit.SetReal(Value: Extended);
begin
  case FDataType of
    dtReal, dtReal48, dtSingle, dtDouble, dtExtended, dtComp: ;
    else DataType := dtExtended; {this then sets numeric type}
  end;
  Text := FloatToStr(Value);
end;

{------------------------------------------------------------------------------
    Procedure: TNEdit.SetInteger
  Description: standard property Set procedure
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: sets the Text Property numerically
 Known Issues:
 ------------------------------------------------------------------------------}
procedure TNEdit.SetInteger(Value: Integer);
begin
  case FDataType of
    dtInteger .. {$IFDEF DELPHI2_UP}dtLongword{$ELSE}dtWord{$ENDIF}: ;
    else DataType := dtInteger; {this then sets numeric type}
  end;

  if (FNumericType = ntHex) then
    Text := IntToHex(Value, 0)
   else
    Text := IntToStr(Value);
end;

{$IFDEF DELPHI4_UP}
{------------------------------------------------------------------------------
    Procedure: TNEdit.SetInt64
  Description: standard property Set procedure
       Author: Mat Ballard
 Date created: 11/25/2000
Date modified: 11/25/2000 by Mat Ballard
      Purpose: sets the Text Property numerically
 Known Issues:
 ------------------------------------------------------------------------------}
procedure TNEdit.SetInt64(Value: Int64);
begin
  case FDataType of
    dtInteger .. {$IFDEF DELPHI2_UP}dtLongword{$ELSE}dtWord{$ENDIF}: ;
    else DataType := dtInteger; {this then sets numeric type}
  end;

  if (FNumericType = ntHex) then
    Text := IntToHex(Value, 0)
   else
    Text := IntToStr(Value);
end;
{$ENDIF}

{------------------------------------------------------------------------------
    Procedure: TNEdit.SetCurrency
  Description: standard property Set procedure
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: sets the Text Property numerically
 Known Issues:
 ------------------------------------------------------------------------------}
{$IFDEF DELPHI2_UP}
procedure TNEdit.SetCurrency(Value: Currency);
begin
  FDataType := dtCurrency;
  Text := CurrToStr(Value);
end;
{$ENDIF}


end.