(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
unit AHMTRealSpinEdit;

interface
{$I AHM.INC}
{$R *.res}

uses
  Windows, Menus, Messages, SysUtils, Classes, Graphics,
  Controls, Forms, Dialogs, StdCtrls,AHMTLookupedit,AHMStdClass;
type
  TAHMRealSpinEdit = class(TAHMCustomLookupEdit)
  private
    FSmallStep    : Double;
    FBigStep      : Double;
    FAlignment    : TAlignment;
    FDecimals     : ShortInt;
    FInvalidEntry : TNotifyEvent;
    FValidChange  : TNotifyEvent;
    FMaxValue     : Double;
    FMinValue     : Double;
    FormatMask    : String;
    Procedure IncNumber(Sender : TObject);
    Procedure DecNumber(Sender : TObject);
    Procedure SetAsCurrency(Value: Currency);
    Procedure SetAlignment(Value: TAlignment);
    Procedure SetAsFloat(Value: Double);
    Procedure SetAsInteger(Value: Integer);
    Procedure SetDecimals(Value: ShortInt);
    Procedure SetMaxValue(xValue: Double);
    Procedure SetMinValue(xValue: Double);
    Procedure SetValue(Value: Double);
    Procedure DeleteKey(Key: Word);
    Procedure DeleteSelection;
    Procedure InvalidEntry;
    Procedure SetFormatMask;
    Procedure WMCut(var Message: TMessage); message WM_CUT;
    Procedure WMPaste(var Message: TMessage); message WM_PASTE;
    Function GetAsCurrency: Currency;
    Function GetAsFloat: Double;
    Function GetAsInteger: Integer;
    Function GetValue: Double;
  protected
    Procedure Change; override;
    Procedure DoEnter; override;
    Procedure DoExit; override;
  public
    Procedure KeyPress(var Key: Char); override;
    Procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    constructor Create(AOwner: TComponent); override;
    Procedure CreateParams(var Params: TCreateParams); override;
    Property AsCurrency: Currency read GetAsCurrency write SetAsCurrency;
    Property AsFloat: Double read GetAsFloat write SetAsFloat;
    Property AsInteger: Integer read GetAsInteger write SetAsInteger;
  published
    Property AutoSelect;
    Property AutoSize;
    {$IFDEF AHMONLY4}
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragKind;
    property ParentBiDiMode;
    {$ENDIF}
    Property BorderStyle;
    Property Color;
    Property Ctl3D;
    Property DragCursor;
    Property DragMode;
    Property Enabled;
    Property Font;
    Property HideSelection;
    Property MaxLength;
    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;
    Property OnStartDrag;
    Property StepSmall : Double read FSmallStep write FSmallStep;
    Property StepBig   : Double read FBigStep write FBigStep;
    Property Alignment : TAlignment read FAlignment write SetAlignment default taRightJustify;
    Property Decimals  : ShortInt read FDecimals write SetDecimals default 2;
    Property MaxValue  : Double read FMaxValue write SetMaxValue;
    Property MinValue  : Double read FMinValue write SetMinValue;
    Property Value     : Double read GetValue write SetValue stored True;
    Property OnInvalidEntry : TNotifyEvent read FInvalidEntry write FInvalidEntry;
    Property OnValidChange  : TNotifyEvent read FValidChange write FValidChange;
  end;


implementation

uses Clipbrd;

constructor TAHMRealSpinEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSmallStep:=1;
  FBigStep:=10;
  EditButton1.Glyph.LoadFromResourceName(HInstance,'AHMSPINEDITA');
  EditButton1.NumGlyphs:=2;
  EditButton2.Glyph.LoadFromResourceName(HInstance,'AHMSPINEDITB');
  EditButton2.NumGlyphs:=2;
  OnButton1Click:=IncNumber;
  OnButton2Click:=DecNumber;
  Width := 73;
  FAlignment := taRightJustify;
  FDecimals := 2;
  FMaxValue := 0;
  FMinValue := 0;
  Value := 0;
  Text:= FloatToStr(Value);
  SetFormatMask;
end;

Procedure TAHMRealSpinEdit.CreateParams(var Params: TCreateParams);
const
  Alignments: array[TAlignment] of Word = (ES_LEFT, ES_RIGHT, ES_CENTER);
begin
  inherited CreateParams(Params);
  Params.Style:= Params.Style or ES_NUMBER or ES_MULTILINE or Alignments[FAlignment];
end;

Procedure TAHMRealSpinEdit.Change;
var NumVal: extended;
begin
  inherited Change;
  NumVal:= Value;
  if (NumVal >= MinValue) and (NumVal <= MaxValue) then
  if Assigned(FValidChange) then FValidChange(Self);
end;

Procedure TAHMRealSpinEdit.DoEnter;
begin
  if AutoSelect and not (csLButtonDown in ControlState) then SelectAll;
  inherited DoEnter;
end;

Procedure TAHMRealSpinEdit.DoExit;
begin
  if FMinValue <> FMaxValue then
  if (AsFloat < FMinValue) or (AsFloat > FMaxValue) then InvalidEntry;
  inherited DoExit;
end;

Procedure TAHMRealSpinEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if not ReadOnly then
  if Key in [38,40,33,34] then
  begin
    if Key=38 then SetValue(Value+FSmallStep) else
    if Key=40 then SetValue(Value-FSmallStep) else
    if Key=33 then SetValue(Value+FBigStep) else
    if Key=34 then SetValue(Value-FBigStep);
    exit;
  end else
  if Key = VK_DELETE then
  begin
    if SelLength > 0 then
    begin
      DeleteSelection;
      Change;
    end else DeleteKey(VK_DELETE);
    Key:= 0;
  end;
  inherited KeyDown(Key, Shift)
end;

Procedure TAHMRealSpinEdit.KeyPress(var Key: Char);
var X: Integer;
    N: Boolean;
begin
  if (Key = Char(VK_RETURN)) or (Key = Char(VK_ESCAPE)) then
  begin
    GetParentForm(Self).Perform(CM_DIALOGKEY, Byte(Key), 0);
    if Key = Char(VK_RETURN) then Key := #0;
  end;
  inherited KeyPress(Key);
  if ReadOnly then exit;
  if Key in [#3, #22, #24] then exit;
  if Key = DecimalSeparator then SelLength := 0
  else
    if (SelLength > 0) then DeleteSelection;
    N := (Pos('-', Text) > 0);
    if not (Key in ['0'..'9', DecimalSeparator, '-', #3, #8, #22, #24]) then Key := #0;
    if (SelStart = 0) and (Key = '0') then Key := #0;
    if (Key = DecimalSeparator) and (FDecimals = 0) then Key := #0;
    if (Key = '-') then
    begin
      if MinValue < 0 then
      begin
        X:= SelStart;
        if Pos('-', Text) = 0 then
        begin
          Text:= '-' + Text;
          SelStart := X + 1;
        end else
        begin
          Text:= Copy(Text, 2, Length(Text) - 1);
          SelStart:= X - 1;
        end;
      end;
    Key := #0;
  end;
  if (SelStart = Length(Text)) and (Key <> #8) and (Key <> DecimalSeparator)
     and (FDecimals > 0) then  Key := #0;
  if Key = DecimalSeparator then
  begin
    SelStart := Length(Text) - FDecimals;
    Key := #0;
  end;
  if N and (SelStart = 0) then SelStart := 1;
  if Key <> #0 then
  if Key = #8 then
  begin
    if SelLength > 0 then DeleteSelection else DeleteKey(VK_BACK);
    Key := #0;
  end else
  if FDecimals = 0 then
  begin
    if (SelStart <= 2) and (Copy(Text, 2, 1) = '0') and N then
    begin
      Text:= '-' + Key;
      SelLength:= 0;
      SelStart:= 1;
      Key:= #0;
    end else if (SelStart <= 1) and (Copy(Text, 1, 1) = '0') then
    begin
      Text:= Key;
      SelLength:= 0;
      SelStart:= 1;
      Key:= #0;
    end;
  end else
  begin
    if (SelStart <= 2) and (Copy(Text, 2, 1) = '0') and N then
    begin
      Text:= '-' + Key + Copy(Text, 3, Length(Text) - 2);
      SelLength:= 0;
      SelStart:= 2;
      Key:= #0;
    end else if (SelStart <= 1) and (Copy(Text, 1, 1) = '0') then
    begin
      Text:= Key + Copy(Text, 2, Length(Text) - 1);
      SelLength:= 0;
      SelStart:= 1;
      Key:= #0;
    end else if SelStart >= (Length(Text) - FDecimals) then
    begin
      X:= SelStart;
      Text:= Copy(Text, 1, SelStart) + Key + Copy(Text, SelStart + 2, Length(Text));
      SelStart:= X + 1;
      SelLength:= 0;
      Key:= #0;
    end else if SelStart < (Length(Text) - FDecimals) - 1 then
    begin
      X:= SelStart;
      if SelStart + SelLength > Length(Text) - FDecimals then dec(X);
      Text:= Copy(Text, 1, SelStart) + Key + Copy(Text, SelStart + 1, Length(Text));
      SelStart:= X + 1;
      SelLength:= 0;
      Key:= #0;
    end;
  end;
  SetValue(StrToFloat(Text));
end;

Function TAHMRealSpinEdit.GetAsCurrency: Currency;
begin
  Result := StrToCurr(Text);
end;

Procedure TAHMRealSpinEdit.SetAsCurrency(Value: Currency);
begin
  Text := FormatFloat(FormatMask, Value);
end;

Function TAHMRealSpinEdit.GetAsFloat: Double;
begin
  Result := StrToFloat(Text);
end;

Function TAHMRealSpinEdit.GetAsInteger: Integer;
begin
  Result := trunc(StrToFloat(Text));
end;

Function TAHMRealSpinEdit.GetValue: Double;
begin
  Result := StrToFloat(Text);
end;

Procedure TAHMRealSpinEdit.SetAsFloat(Value: Double);
begin
  Text := FormatFloat(FormatMask, Value);
end;

Procedure TAHMRealSpinEdit.SetAsInteger(Value: Integer);
begin
  Text := FormatFloat(FormatMask, Value);
end;

Procedure TAHMRealSpinEdit.SetAlignment(Value: TAlignment);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;
    RecreateWnd;
  end;
end;

Procedure TAHMRealSpinEdit.SetDecimals(Value: ShortInt);
begin
  if FDecimals <> Value then
  if Value < 0 then Value := 0;
  if Value > 9 then Value := 9;
  FDecimals := Value;
  SetFormatMask;
end;

Procedure TAHMRealSpinEdit.SetMaxValue(xValue: Double);
begin
  if FMaxValue <> xValue then FMaxValue := xValue;
  SetValue(Value);
end;

Procedure TAHMRealSpinEdit.SetMinValue(xValue: Double);
begin
  if FMinValue <> xValue then FMinValue := xValue;
  SetValue(Value);
end;

Procedure TAHMRealSpinEdit.SetValue(Value: Double);
var NewText: string;
    ChangeEvent: TNotifyEvent;
    DisabledOnChange: boolean;
begin
  DisabledOnChange:= csReading in ComponentState;
  ChangeEvent:= onChange;
  if DisabledOnChange then onChange:= nil;
  if ((FMinValue=FMaxValue) and (FMinValue=0)) then
  begin
    NewText:= FormatFloat(FormatMask, Value);
    if Text <> NewText then Text:= NewText;
  end else
  if (Value<FMinValue) then Beep else
  if (Value>FMaxValue) then Beep else
  begin
    NewText:= FormatFloat(FormatMask, Value);
    if Text <> NewText then Text:= NewText;
  end;
  OnChange:= ChangeEvent;
  if not((FMinValue=FMaxValue) and (FMinValue=0)) then
  begin
  if Value>=FMaxValue then EditButton1.Enabled:=False else EditButton1.Enabled:=True;
  if Value<=FMinValue then EditButton2.Enabled:=False else EditButton2.Enabled:=True;
  end;

end;

Procedure TAHMRealSpinEdit.DeleteKey(Key: Word);
var P: Integer;
    N: Boolean;
begin
  if Key = VK_DELETE then P := SelStart + 1
                     else P := SelStart;
  N := (Pos('-', Text) > 0);
  if (P = 0) or (P = Length(Text) + 1) then exit;
  if FDecimals = 0 then
  begin
    if (P = 2) and (Length(Text) = 2) and N then
    begin
      Text := '-0' + Copy(Text, 3, Length(Text) - 2);
      SelStart := 1;
    end else
      if (P = 1) and (Length(Text) = 1) then
      begin
        Text := '0' + Copy(Text, 2, Length(Text) - 1);
        SelStart := 1;
      end else
      begin
        Text := Copy(Text, 1, P - 1) + Copy(Text, P + 1, Length(Text) - P);
        SelStart := P - 1;
      end
  end else
  begin
    if P > (Length(Text) - FDecimals) then
    begin
      Text := Copy(Text, 1, P - 1) + Copy(Text, P + 1, Length(Text) - P) + '0';
      SelStart := P - 1;
    end else
      if (P = (Length(Text) - FDecimals)) then
      if Key = VK_DELETE then SelStart := (Length(Text) - FDecimals)
                         else SelStart := (Length(Text) - FDecimals) - 1
      else
        if (P = 2) and (P = (Length(Text) - FDecimals) - 1) and N then
        begin
          Text := '-0' + Copy(Text, 3, Length(Text) - 2);
          SelStart := 1;
        end else
        if (P = 1) and (P = (Length(Text) - FDecimals) - 1) then
        begin
          Text := '0' + Copy(Text, 2, Length(Text) - 1);
          SelStart := 1;
        end else
        if P > 0 then
        begin
          Text := Copy(Text, 1, P - 1) + Copy(Text, P + 1, Length(Text) - P);
          SelStart := P - 1;
        end;
  end;
end;

Procedure TAHMRealSpinEdit.DeleteSelection;
var
  X: Integer;
  Y: Integer;
  ChangeEvent: TNotifyEvent;
begin
  ChangeEvent:= onChange;
  onChange:= nil;
  if SelLength = 0 then exit;
  Y := Length(SelText);
  SelStart := SelStart + Y;
  for X:= 1 to Y do DeleteKey(VK_BACK);
  OnChange:= ChangeEvent;
end;

Procedure TAHMRealSpinEdit.InvalidEntry;
begin
  if assigned(FInvalidEntry) then FInvalidEntry(Self);
end;

Procedure TAHMRealSpinEdit.SetFormatMask;
Function StringOfChar(const Character: Char; const StrLength: word): string;
var OutString: String[255];
begin
  FillChar(OutString, SizeOf(OutString), ord(Character));
  OutString[0]:= chr(StrLength);
  StringOfChar:= OutString;
end;
var ChangeEvent: TNotifyEvent;
begin
  if FDecimals = 0 then FormatMask := '0'
                   else FormatMask := '0.' + StringOfChar('0', FDecimals);
  ChangeEvent:= onChange;
  OnChange:= nil;
  try
    Text := FormatFloat(FormatMask, AsFloat);
  finally
    onChange:= ChangeEvent;
  end;
end;

Procedure TAHMRealSpinEdit.WMCut(var Message: TMessage);
begin
  CopyToClipboard;
  DeleteSelection;
end;

Procedure TAHMRealSpinEdit.WMPaste(var Message: TMessage);
var
  X: integer;
  S: String;
  W: Word;
begin
  DeleteSelection;
  S := Clipboard.AsText;
  for X := 1 to Length(S) do begin
    W := Ord(S[X]);
    Perform(WM_CHAR, W, 0);
  end;
end;

Procedure TAHMRealSpinEdit.IncNumber(Sender : TObject);
begin
  Setvalue(Value+FSmallStep);
end;

Procedure TAHMRealSpinEdit.DecNumber(Sender : TObject);
begin
  Setvalue(Value-FSmallStep);
end;


end.

