abnumedit.pas

著名的虚拟仪表控件,包含全部源码, 可以在,delphi2007 下安装运行

unit AbNumEdit;

{$I abks.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, _AbProc, extctrls, _GClass, _AbInfo;

type

  TEditBase = (ebBin, ebHex, ebFloat, ebInt);

  TNumEditOption = (eoLimitMax, eoLimitMin, eoMultiply );
  TNumEditOptions = set of TNumEditOption;

  TBaseProperties = record
    ValidChars : String;   // String with valid chars
    ExpEnable : Boolean;   // if true exponent Char is enabled
    MultiEnable : Boolean; // if true multiplicator Char is enabled
    Sign       : String;   // String with valid sign's (at pos 1)
    MinValue   : Extended; // lowest allowed value
    MaxValue   : Extended; // highest allowed value
  end;

  TNumEditState = (esNormal, esEditing, esError);

  TAbNumEdit = class(TCustomEdit)
  private
    FAbInfo: TAbInfo;
    FEditBase : TEditBase;
    FEditorEnabled: Boolean;
    FMinValue: Double;
    FMaxValue: Double;
    FIncrement: Single;
    FOldText : String;
    FValue : Double;
    FValueAsBool : String;
    FValueAsHex  : String;
    FValueAsSingle : Single;
    FValueAsInt : Integer;
    FOptions : TNumEditOptions;
    FFormatStr : String;
    FOnValueChanged: TNotifyEvent;
    FState : TNumEditState;

    FirstDraw  : Boolean;
    IgnoreChange : Boolean;

    FLimitUp : Boolean;
    FLimitLo : Boolean;
    FOnLimit : TNotifyEvent;

    FColorDefault  : TColor;
    FColorError    : TColor;
    FColorEditing  : TColor;

    FDigitsBool : Integer;
    FDigitsHex : Integer;

    procedure SetColorDefault(Value : TColor);
    procedure SetFormatStr(Value : String);
    procedure SetLimitUp(Value : Boolean);
    procedure SetLimitLo(Value : Boolean);
    procedure SetMaxValue(Value : Double);
    procedure SetMinValue(Value : Double);

    procedure SetText(ExtValue : Extended);

    procedure SetOptions(Value : TNumEditOptions);
    procedure SetValueAsBool(Value: String);
    procedure SetValueAsHex(Value: String);
    procedure SetValueAsInt(Value: Integer);
    procedure SetValueAsSingle(Value: Single);
    procedure SetValue (Value: Double);

    function CheckValue (Value: Double): Double;
    procedure SetEditBase(Value : TEditBase);
    procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
    procedure CMExit(var Message: TCMExit);   message CM_EXIT;
    procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED;
  protected
    procedure SetState (Value : TNumEditState); virtual;
    procedure Limit;  virtual;
    property OldText : String read FOldText write FOldText;
    function CheckEdit(WriteEnable : Boolean): Boolean;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Change; override;
    procedure Loaded; override;
  public
    procedure UpClick (Sender: TObject); virtual;
    procedure DownClick (Sender: TObject); virtual;
    property LimitUp : Boolean read FLimitUp write SetLimitUp stored False;
    property LimitLo : Boolean read FLimitLo write SetLimitLo stored False;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property AbInfo: TAbInfo read FAbInfo write FAbInfo stored false;
    {$IFDEF CEnabled}
      property Anchors;
      property Constraints;
    {$ENDIF}
    property AutoSelect;
    property AutoSize;
    property ColorDefault : TColor read FColorDefault write SetColorDefault;
    property ColorError : TColor read FColorError write FColorError default clRed;
    property ColorEditing : TColor read FColorEditing write FColorEditing default clLime;

    property Ctl3D;
    property DragCursor;
    property DragMode;

    property DigitsBool : Integer read FDigitsBool write FDigitsBool;
    property DigitsHex  : Integer read FDigitsHex write FDigitsHex;

    property EditorEnabled: Boolean read FEditorEnabled write FEditorEnabled default True;
    property EditBase : TEditBase read FEditBase write SetEditBase default ebFloat;
    property Enabled;
    property Font;
    property FormatStr : String read fFormatStr write SetFormatStr;
    property Increment: Single read FIncrement write FIncrement;
    property MaxLength;
    property MaxValue: Double read FMaxValue write SetMaxValue;
    property MinValue: Double read FMinValue write SetMinValue;
    property OnLimit : TNotifyEvent read FOnLimit write FOnLimit;
    property OnValueChanged: TNotifyEvent read FOnValueChanged write FOnValueChanged;
    property Options : TNumEditOptions read FOptions write SetOptions;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property State : TNumEditState read FState;
    property TabOrder;
    property TabStop;
    property Text;
    property Value: Double read FValue write SetValue  stored False;
    property ValueAsBool: String read FValueAsBool write SetValueAsBool  stored False;
    property ValueAsHex: String read FValueAsHex write SetValueAsHex  stored False;
    property ValueAsSingle: Single read FValueAsSingle write SetValueAsSingle  stored False;
    property ValueAsInt: Integer read FValueAsInt write SetValueAsInt stored False;
    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;
    property OnStartDrag;
  end;

  TAbNumSpin = class(TAbNumEdit)
  private
    FButton: TAbSpinButton;

    procedure SetInterval(Value : Integer);
    function GetInterval: Integer;
    procedure SetStartDelay(Value : Integer);
    function GetStartDelay: Integer;

    procedure SetEditRect;
    function GetMinHeight: Integer;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
  protected
    procedure CreateWnd; override;
    procedure Limit; Override;
    procedure SetEnabled(Value: Boolean); {$IFDEF CEnabled} override; {$ENDIF}
    procedure SetState (Value : TNumEditState); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Interval    : Integer read GetInterval write SetInterval;
    property StartDelay    : Integer read GetStartDelay write SetStartDelay;
  end;




var
  EBase : Array[0..Ord(ebInt)] of TBaseProperties;

const
  ValidFirstChar : String = '$%&!';    // e.g.: to input HexNumber even if another
                                      // EditBase is selected
  ExpChars : String = 'Ee';
  Factors : Array[0..11] of Single = (1e18,1e15,1e12,1e9,1e6,1e3,1e-3,1e-6,1e-9,1e-12,1e-15,1e-18);
  ValidMultipChars : String = 'EPTGMkmunpfa';

{  Multiplicator Chars
  *factor               Sign
  1e18          Exa     E
  1e15          Peta    P
  1e12          Tera    T
  1e9           Giga    G
  1e6           Mega    M
  1e3           Kilo    k
  1e-3          milli   m
  1e-6          Micro   u
  1e-9          nano    n
  1e-12         pico    p
  1e-15         femto   f
  1e-18         atto    a
 }


implementation
{ TAbSpinButton }


//==============================================================================


{ TAbNumEdit }

constructor TAbNumEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
 // if (AOwner is TWinControl) then Parent := AOwner as TWinControl;
  FirstDraw := true;
  AbInfo := LoadAbakusInfo;
  width := 65;
  FEditBase := ebFloat;
  FDigitsBool :=0;
  FDigitsHex := 0;
  FFormatStr := '#0.#';

  Text := '0';
  FOldText := '';
  ControlStyle := ControlStyle - [csSetCaption];
  FColorDefault := clWindow;
  FColorError := clRed;
  FColorEditing := clLime;
  FIncrement := 1.0;
  FEditorEnabled := True;
  IgnoreChange := true;
end;

procedure TAbNumEdit.Loaded;
begin
  inherited Loaded;
end;

destructor TAbNumEdit.Destroy;
begin
  inherited Destroy;
end;

procedure TAbNumEdit.SetColorDefault(Value : TColor);
begin
  FColorDefault := Value;
  Color := Value;
end;

procedure TAbNumEdit.SetMaxValue(Value : Double);
begin
  if FMaxValue <> Value then begin
    FMaxValue := Value;
    if (FValue > Value) and (eoLimitMax in Options) then Self.Value := Value;
  end;
end;

procedure TAbNumEdit.SetMinValue(Value : Double);
begin
  if FMinValue <> Value then begin
    FMinValue := Value;
    if (FValue < Value) and (eoLimitMin in Options) then Self.Value := Value;
  end;
end;

procedure TAbNumEdit.SetFormatStr(Value : String);
begin
  if FFormatStr <> Value then begin
    FFormatStr := Value;
    if EditBase = ebFloat then
      Text := FormatFloat(fFormatStr,FValue);
    CheckEdit(True);
  end;
end;

procedure TAbNumEdit.SetLimitUp(Value : Boolean);
begin
  if FLimitUp <> Value then begin
    FLimitUp := Value;
    Limit;
  end;
end;

procedure TAbNumEdit.SetLimitLo(Value : Boolean);
begin
  if FLimitLo <> Value then begin
    FLimitLo := Value;
    Limit;
  end;
end;

procedure TAbNumEdit.Limit;
begin
  if Assigned(FOnLimit) then FOnLimit(self);
end;


procedure TAbNumEdit.SetOptions(Value : TNumEditOptions);
begin
  if fOptions <> Value then begin
    fOptions := Value;
    CheckEdit(true);
  end;
end;

procedure TAbNumEdit.Change;
var
  bin : Boolean;
begin
  if IgnoreChange then IgnoreChange := false
  else begin
    bin :=  (fValueAsBool = '');
    if (csDesigning in ComponentState) then CheckEdit(true)
    else CheckEdit(bin);
  end;
end;


procedure TAbNumEdit.SetEditBase(Value : TEditBase);
begin
  if fEditBase <> Value then begin
    fEditBase := Value;
    case fEditBase of
      ebBin : begin
                Text := FValueAsBool;
              end;
      ebHex : begin
                Text := FValueAsHex;
              end;
      ebFloat : begin
                Text := FormatFloat(fFormatStr,FValue);
              end;
      ebInt : begin
                Text := IntToStr(FValueAsInt);
              end;
    end;
    OldText := Text;
    SetState(esNormal);
  end;

end;

procedure TAbNumEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if (Key = VK_UP) and not FLimitUp then UpClick (Self)
  else if (Key = VK_DOWN) and not FLimitLo then DownClick (Self)
  else begin
    if (State <> esNormal) and (Key = VK_ESCAPE) then
      case EditBase of
        ebBin : begin
                  Text := FValueAsBool;
                end;
        ebHex : begin
                  Text := FValueAsHex;
                end;
        ebFloat : begin
                  Text := FormatFloat(fFormatStr,FValue);
                end;
        ebInt : begin
                  Text := IntToStr(FValueAsInt);
                end;
      end;
    if Assigned(OnChange) then OnChange(Self);
  end;

  inherited KeyDown(Key, Shift);
end;

procedure TAbNumEdit.KeyPress(var Key: Char);
begin
  if FEditorEnabled then begin
    if Key = Chr(VK_RETURN) then  begin
      Key := #0;
      if Text = '' then Text := '0';
      CheckEdit(true);
    end;
    inherited KeyPress(Key);
  end else begin
    Key := #0;
    Beep;
  end;
end;


procedure TAbNumEdit.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or ES_MULTILINE or WS_CLIPCHILDREN;
  CheckEdit(true);
end;

procedure TAbNumEdit.UpClick (Sender: TObject);
begin
  if ReadOnly or LimitUp then begin
    Beep;
  end else begin
    IgnoreChange := true;
    if ((eoMultiply in Options) and (EditBase = ebFloat)) and
       (FIncrement <> 0) and (FValue <> 0) then
      Value := CheckValue(FValue * FIncrement)
    else
      Value := CheckValue(FValue + FIncrement);
    if Assigned(OnChange) then OnChange(Self);
  end;
end;

procedure TAbNumEdit.DownClick (Sender: TObject);
begin
  if ReadOnly or LimitLo then begin
    Beep;
  end else begin
    IgnoreChange := true;
    if ((eoMultiply in Options) and (EditBase = ebFloat)) and
       (FIncrement <> 0) and (FValue <> 0) then
      Value := CheckValue(FValue / FIncrement)
    else
      Value := CheckValue(FValue - FIncrement);
    if Assigned(OnChange) then OnChange(Self);
  end;
end;

procedure TAbNumEdit.CMExit(var Message: TCMExit);
begin
  inherited;
  if Text = '' then Text := '0';
  CheckEdit(True);
end;

procedure TAbNumEdit.CMParentColorChanged(var Message: TMessage); 
begin
  inherited;
  if ParentColor then FColorDefault := Color;
end;

procedure TAbNumEdit.SetValue (Value: Double);
begin
  if Value = FValue then exit;
  SetText(CheckValue(Value));
end;

procedure TAbNumEdit.SetValueAsBool(Value: String);
begin
  if Value = Text then exit;
  if EditBase = ebBin then
    Text := Value
  else
    Text := '&' + Value;
  CheckEdit(True);
end;

procedure TAbNumEdit.SetValueAsHex(Value: String);
begin
  if Value = Text then exit;
  if EditBase = ebHex then
    Text := Value
  else
    Text := '$' + Value;
  CheckEdit(True);
end;

procedure TAbNumEdit.SetValueAsInt(Value: Integer);
begin
  if IntToStr(Value) = Text then exit;
  SetText(Value);
end;

procedure TAbNumEdit.SetValueAsSingle(Value: Single);
begin