rxspin.pas

rx library V2.7.7a component use in delphi7 to delphi 2006

      FBtnWindow.SetBounds(Left, Top, Right - Left, Bottom - Top);
//Polaris
    FButton.SetBounds(1, 1, FBtnWindow.Width-1, FBtnWindow.Height-1);
  end;
end;

procedure TRxCustomSpinEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if ArrowKeys and (Key in [VK_UP, VK_DOWN]) then begin
    if Key = VK_UP then UpClick(Self)
    else if Key = VK_DOWN then DownClick(Self);
    Key := 0;
  end;
end;

procedure TRxCustomSpinEdit.Change;
begin
  if not FChanging then inherited Change;
end;

procedure TRxCustomSpinEdit.KeyPress(var Key: Char);
begin
  if not IsValidChar(Key) then begin
    Key := #0;
    MessageBeep(0)
  end;
  //Polaris
  if Key = '.' then Key := DecimalSeparator;
  if Key <> #0 then begin
    inherited KeyPress(Key);
    if (Key = Char(VK_RETURN)) or (Key = Char(VK_ESCAPE)) then begin
      { must catch and remove this, since is actually multi-line }
      GetParentForm(Self).Perform(CM_DIALOGKEY, Byte(Key), 0);
      if Key = Char(VK_RETURN) then Key := #0;
    end;
  end;
end;

function TRxCustomSpinEdit.IsValidChar(Key: Char): Boolean;
var
  ValidChars: set of Char;
begin
  ValidChars := ['+', '-', '0'..'9'];
  if ValueType = vtFloat then begin
    if Pos(DecimalSeparator, Text) = 0 then
      ValidChars := ValidChars + [DecimalSeparator,'.'];
    if Pos('E', AnsiUpperCase(Text)) = 0 then
      ValidChars := ValidChars + ['e', 'E'];
  end
  else if ValueType = vtHex then begin
    ValidChars := ValidChars + ['A'..'F', 'a'..'f'];
  end;
  Result := (Key in ValidChars) or (Key < #32);
  if not FEditorEnabled and Result and ((Key >= #32) or
    (Key = Char(VK_BACK)) or (Key = Char(VK_DELETE))) then Result := False;
end;

procedure TRxCustomSpinEdit.CreateParams(var Params: TCreateParams);
const
{$IFDEF RX_D4}
  Alignments: array[Boolean, TAlignment] of DWORD =
    ((ES_LEFT, ES_RIGHT, ES_CENTER), (ES_RIGHT, ES_LEFT, ES_CENTER));
{$ELSE}
  Alignments: array[TAlignment] of Longint = (ES_LEFT, ES_RIGHT, ES_CENTER);
{$ENDIF}
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style
//    or ES_MULTILINE
    or WS_CLIPCHILDREN or
{$IFDEF RX_D4}
    Alignments[UseRightToLeftAlignment, FAlignment];
{$ELSE}
    Alignments[FAlignment];
{$ENDIF}
end;

procedure TRxCustomSpinEdit.CreateWnd;
begin
  inherited CreateWnd;
  SetEditRect;
end;

procedure TRxCustomSpinEdit.SetEditRect;
var
  Loc: TRect;
begin
//Polaris
{$IFDEF RX_D4}
  if (BiDiMode = bdRightToLeft) then begin
    SetRect(Loc, GetButtonWidth + 1, 0, ClientWidth - 1,
      ClientHeight + 1);
     SendMessage(Handle, EM_SETMARGINS, EC_LEFTMARGIN, MakeLong(GetButtonWidth, 0));
   end
     else begin
{$ENDIF RX_D4}
  SetRect(Loc, 0, 0, ClientWidth - GetButtonWidth - 2, ClientHeight + 1);
{$IFDEF RX_D4}
  SendMessage(Handle, EM_SETMARGINS, EC_RIGHTMARGIN, MakeLong(0, GetButtonWidth));
  end;
{$ENDIF RX_D4}

  SendMessage(Handle, EM_SETRECTNP, 0, Longint(@Loc));
end;

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

procedure TRxCustomSpinEdit.WMSize(var Message: TWMSize);
var
  MinHeight: Integer;
begin
  inherited;
  MinHeight := GetMinHeight;
  { text edit bug: if size to less than minheight, then edit ctrl does
    not display the text }
  if Height < MinHeight then
    Height := MinHeight
  else begin
    ResizeButton;
    SetEditRect;
  end;
end;

procedure TRxCustomSpinEdit.GetTextHeight(var SysHeight, Height: Integer);
var
  DC: HDC;
  SaveFont: HFont;
  SysMetrics, Metrics: TTextMetric;
begin
  DC := GetDC(0);
  GetTextMetrics(DC, SysMetrics);
  SaveFont := SelectObject(DC, Font.Handle);
  GetTextMetrics(DC, Metrics);
  SelectObject(DC, SaveFont);
  ReleaseDC(0, DC);
  SysHeight := SysMetrics.tmHeight;
  Height := Metrics.tmHeight;
end;

function TRxCustomSpinEdit.GetMinHeight: Integer;
var
  I, H: Integer;
begin
  GetTextHeight(I, H);
  if I > H then I := H;
  Result := H +
    (GetSystemMetrics(SM_CYBORDER) * 4) + 1;
end;

procedure TRxCustomSpinEdit.UpClick(Sender: TObject);
var
  OldText: string;
begin
  if ReadOnly then MessageBeep(0)
  else begin
    FChanging := True;
    try
      OldText := inherited Text;
      Value := Value + FIncrement;
    finally
      FChanging := False;
    end;
    if CompareText(inherited Text, OldText) <> 0 then begin
      Modified := True;
      Change;
    end;
    if Assigned(FOnTopClick) then FOnTopClick(Self);
  end;
end;

procedure TRxCustomSpinEdit.DownClick(Sender: TObject);
var
  OldText: string;
begin
  if ReadOnly then MessageBeep(0)
  else begin
    FChanging := True;
    try
      OldText := inherited Text;
      Value := Value - FIncrement;
    finally
      FChanging := False;
    end;
    if CompareText(inherited Text, OldText) <> 0 then begin
      Modified := True;
      Change;
    end;
    if Assigned(FOnBottomClick) then FOnBottomClick(Self);
  end;
end;

{$IFDEF RX_D4}
procedure TRxCustomSpinEdit.CMBiDiModeChanged(var Message: TMessage);
begin
  inherited;
  ResizeButton;
  SetEditRect;
end;
{$ENDIF}

procedure TRxCustomSpinEdit.CMFontChanged(var Message: TMessage);
begin
  inherited;
  ResizeButton;
  SetEditRect;
end;

procedure TRxCustomSpinEdit.CMCtl3DChanged(var Message: TMessage);
begin
  inherited;
  ResizeButton;
  SetEditRect;
end;

procedure TRxCustomSpinEdit.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  if FUpDown <> nil then begin
    FUpDown.Enabled := Enabled;
    ResizeButton;
  end;
  if FButton <> nil then FButton.Enabled := Enabled;
end;

procedure TRxCustomSpinEdit.WMPaste(var Message: TWMPaste);
var
  V: Extended;
begin
  if not FEditorEnabled or ReadOnly then Exit;
  V := Value;
  inherited;
  try
    StrToFloat(Text);
  except
    SetValue(V);
  end;
end;

procedure TRxCustomSpinEdit.WMCut(var Message: TWMCut);
begin
  if not FEditorEnabled or ReadOnly then Exit;
  inherited;
end;

//Polaris

procedure TRxCustomSpinEdit.SetFocused(Value: Boolean);
begin
  if Value <> FFocused then begin
    FFocused := Value;
    Invalidate;
    DataChanged;
  end;
end;

procedure TRxCustomSpinEdit.CheckRange;
begin
  if not (csDesigning in ComponentState) and CheckOnExit then
    CheckValueRange(Value, True);
end;

procedure TRxCustomSpinEdit.CMExit(var Message: TCMExit);
begin
  SetFocused(False);
  try
    CheckRange;
    SetValue(CheckValue(Value));
  except
    SetFocused(True);
    SelectAll;
    if CanFocus then SetFocus;
    raise
  end;
  inherited;
end;

procedure TRxCustomSpinEdit.CMEnter(var Message: TMessage);
begin
  SetFocused(True);
  if AutoSelect and not (csLButtonDown in ControlState) then SelectAll;
  inherited;
end;

function TRxCustomSpinEdit.GetAsInteger: Longint;
begin
  Result := Trunc(GetValue);
end;

procedure TRxCustomSpinEdit.SetAsInteger(NewValue: Longint);
begin
  SetValue(NewValue);
end;

procedure TRxCustomSpinEdit.SetValueType(NewType: TValueType);
begin
  if FValueType <> NewType then begin
    FValueType := NewType;
    Value := GetValue;
    if FValueType in [{$IFDEF CBUILDER} vtInt {$ELSE} vtInteger {$ENDIF}, vtHex] then
    begin
      FIncrement := Round(FIncrement);
      if FIncrement = 0 then FIncrement := 1;
    end;
  end;
end;

function TRxCustomSpinEdit.IsIncrementStored: Boolean;
begin
  Result := FIncrement <> 1.0;
end;

function TRxCustomSpinEdit.IsMaxStored: Boolean;
begin
  Result := (MaxValue <> 0.0);
end;

function TRxCustomSpinEdit.IsMinStored: Boolean;
begin
  Result := (MinValue <> 0.0);
end;

function TRxCustomSpinEdit.IsValueStored: Boolean;
begin
  Result := (GetValue <> 0.0);
end;

procedure TRxCustomSpinEdit.SetDecimal(NewValue: Byte);
begin
  if FDecimal <> NewValue then begin
    FDecimal := NewValue;
    Value := GetValue;
  end;
end;

//Polaris
function TRxCustomSpinEdit.CheckValueRange(NewValue: Extended; RaiseOnError: Boolean): Extended;
begin
  Result := CheckValue(NewValue);
  if (FCheckMinValue or FCheckMaxValue) and
   RaiseOnError and (Result <> NewValue) then
   raise ERangeError.CreateFmt(ReplaceStr(ResStr(SOutOfRange), '%d', '%g'),
      [FMinValue, FMaxValue]);
end;

function TRxCustomSpinEdit.CheckValue(NewValue: Extended): Extended;
begin
  Result := NewValue;
{
  if (FMaxValue <> FMinValue) then begin
    if NewValue < FMinValue then
      Result := FMinValue
    else if NewValue > FMaxValue then
      Result := FMaxValue;
  end;
}
  if FCheckMinValue or FCheckMaxValue then begin
    if FCheckMinValue and (NewValue < FMinValue) then
      Result := FMinValue;
    if FCheckMaxValue and (NewValue > FMaxValue) then
      Result := FMaxValue;
  end;
end;

//Polaris


procedure TRxCustomSpinEdit.Loaded;
begin
  inherited Loaded;
  FLCheckMinValue := True;
  FLCheckMaxValue := True;
end;

function TRxCustomSpinEdit.CheckDefaultRange(CheckMax: Boolean): Boolean;
begin
  Result := (FMinValue <> 0) or (FMaxValue <> 0);
end;

procedure TRxCustomSpinEdit.SetMinValue(NewValue: Extended);
var
  Z,
  B: Boolean;
begin
  if NewValue <> FMinValue then begin
    B := not StoreCheckMinValue;
    Z := (FMinValue = 0) <> (NewValue=0);
    FMinValue := NewValue;
    if Z and FLCheckMinValue then begin
      SetCheckMinValue(CheckDefaultRange(False));
      if B and FLCheckMaxValue
      then SetCheckMaxValue(CheckDefaultRange(True));
    end;
    SetValue(Value);
  end;
end;

procedure TRxCustomSpinEdit.SetMaxValue(NewValue: Extended);
var
  Z,
  B: Boolean;
begin
  if NewValue <> FMaxValue then begin
    B := not StoreCheckMaxValue;
    Z := (FMaxValue = 0) <> (NewValue=0);
    FMaxValue := NewValue;
    if Z and FLCheckMaxValue then begin
      SetCheckMaxValue(CheckDefaultRange(True));
      if B and FLCheckMinValue
      then SetCheckMinValue(CheckDefaultRange(False));
    end;
    SetValue(Value);
  end;
end;

procedure TRxCustomSpinEdit.SetCheckMinValue(NewValue: Boolean);
begin
  if (FMinValue <> 0)
  then NewValue := True;
  FCheckMinValue := NewValue;
  if (csLoading in ComponentState) then FLCheckMinValue := False;
  SetValue(Value);
end;

procedure TRxCustomSpinEdit.SetCheckMaxValue(NewValue: Boolean);
begin
  if (FMaxValue <> 0)
  then NewValue := True;
  FCheckMaxValue := NewValue;
  if (csLoading in ComponentState) then FLCheckMaxValue := False;
  SetValue(Value);
end;

function TRxCustomSpinEdit.StoreCheckMinValue: Boolean;
begin
  Result := (FMinValue = 0) and (FCheckMinValue = (FMaxValue = 0));
end;

function TRxCustomSpinEdit.StoreCheckMaxValue: Boolean;
begin
  Result := (FMaxValue = 0) and (FCheckMaxValue = (FMinValue = 0));
end;

//Polaris

function TRxCustomSpinEdit.DefaultDisplayFormat: string;
begin
  Result := ',0.##';
end;

function TRxCustomSpinEdit.IsFormatStored: Boolean;
begin
  Result := (DisplayFormat <> DefaultDisplayFormat);
end;

procedure TRxCustomSpinEdit.SetDisplayFormat(const Value: string);
begin
  if DisplayFormat <> Value then begin
    FDisplayFormat := Value;
    Invalidate;
  end;
end;

function TRxCustomSpinEdit.TextToValText(const AValue: string): string;
begin
  Result := DelRSpace(AValue);
  if DecimalSeparator <> ThousandSeparator then begin
    Result := DelChars(Result, ThousandSeparator);
  end;
  if (DecimalSeparator <> '.') and (ThousandSeparator <> '.') then
    Result := ReplaceStr(Result, '.', DecimalSeparator);
  if (DecimalSeparator <> ',') and (ThousandSeparator <> ',') then
    Result := ReplaceStr(Result, ',', DecimalSeparator);
  if Result = '' then Result := '0'
  else if Result = '-' then Result := '-0';
end;

procedure TRxCustomSpinEdit.DataChanged;
var
  EditFormat: string;
begin
  if (ValueType = vtFloat) and FFocused and (FDisplayFormat <> EmptyStr) then
  begin
    EditFormat := '0';
    if FDecimal > 0 then
      EditFormat := EditFormat + '.' + MakeStr('#', FDecimal);
    EditText := FormatFloat(EditFormat, Value);
  end;
end;

{ TRxSpinEdit }

constructor TRxSpinEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
//  FButtonKind := bkDiagonal;
  Text := '0';
//  RecreateButton;
end;

procedure TRxSpinEdit.SetValue(NewValue: Extended);
begin
  if ValueType = vtFloat then
    if (FDisplayFormat <> EmptyStr) then
      Text := FormatFloat(FDisplayFormat, CheckValue(NewValue))
    else
      Text := FloatToStrF(CheckValue(NewValue), ffFixed, 15, FDecimal)
  else if ValueType = vtHex then
    Text := IntToHex(Round(CheckValue(NewValue)), 1)
  else
    Text := IntToStr(Round(CheckValue(NewValue)));
  DataChanged;
end;

function TRxSpinEdit.GetValue: Extended;
begin
  try
    if ValueType = vtFloat then
    begin
      if FDisplayFormat <> EmptyStr then
        try
          Result := StrToFloat(TextToValText(Text));
        except
          Result := FMinValue;
        end
      else
        if not TextToFloat(PChar(Text), Result, fvExtended)
        then Result := FMinValue;
    end
    else if ValueType = vtHex then Result := StrToIntDef('$' + Text, Round(FMinValue))
    else Result := StrToIntDef(Text, Round(FMinValue));
  except
    if ValueType = vtFloat then Result := FMinValue
    else Result := Round(FMinValue);
  end;
end;



end.