cxspinedit.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,961 行 · 第 1/5 页

end;

procedure TcxCustomSpinEditProperties.SetAssignedValues(
  Value: TcxSpinEditPropertiesValues);
begin
  FAssignedValues.Assign(Value);
end;

procedure TcxCustomSpinEditProperties.SetCircular(Value: Boolean);
begin
  if Value <> FCircular then
  begin
    FCircular := Value;
    Changed;
  end;
end;

procedure TcxCustomSpinEditProperties.SetSpinButtons(Value: TcxSpinEditButtons);
begin
  FSpinButtons.Assign(Value);
end;

function TcxCustomSpinEditProperties.TryTextToValue(S: string;
  out AValue: TcxEditValue): Boolean;
var  
  AExtendedValue: Extended;
  AIntegerValue: {$IFDEF DELPHI6}Int64{$ELSE}Integer{$ENDIF};
{$IFNDEF DELPHI6}
  E: Integer;
{$ENDIF}
begin
  AValue := Null;
  AIntegerValue := 0;
  if ValueType = vtInt then
  begin
  {$IFDEF DELPHI6}
    Result := TryStrToInt64(S, AIntegerValue);
  {$ELSE}
    Val(S, AIntegerValue, E);
    Result := E = 0;
  {$ENDIF}
  end
  else
  begin
    Result := TextToFloat(PChar(S), AExtendedValue, fvExtended);
    Result := Result and IsValueBoundsValid(AExtendedValue);
  end;
  if Result then
  begin
    if ValueType = vtInt then
      AValue := AIntegerValue
    else
      AValue := AExtendedValue;
  end;
end;

procedure TcxCustomSpinEditProperties.SetValueType(Value: TcxSpinEditValueType);
begin
  if AssignedValues.ValueType and (Value = FValueType) then
    Exit;
  AssignedValues.FValueType := True;
  FValueType := Value;
  Changed;
end;

function TcxCustomSpinEditProperties.VarToCurrentValueType(AValue: TcxEditValue): TcxEditValue;
begin
  if ValueType = vtFloat then
    Result := VarAsType(AValue, varDouble)
  else
    Result := VarAsType(AValue, {$IFDEF DELPHI6}varInt64{$ELSE}varInteger{$ENDIF});
end;

procedure TcxCustomSpinEditProperties.WriteZeroIncrement(Writer: TWriter);
begin
  Writer.WriteBoolean(True);
end;

procedure TcxCustomSpinEditProperties.WriteZeroLargeIncrement(Writer: TWriter);
begin
  Writer.WriteBoolean(True);
end;

{ TcxCustomSpinEdit }

procedure TcxCustomSpinEdit.ClearSelection;
begin
  if not (Focused and not ActiveProperties.CanEdit) then
  begin
    FIsCustomTextAction := True;
    try
      inherited ClearSelection;
    finally
      FIsCustomTextAction := False;
    end;
  end;
end;

procedure TcxCustomSpinEdit.CutToClipboard;
begin
  if not (Focused and not ActiveProperties.CanEdit) then
  begin
    FIsCustomTextAction := True;
    try
      inherited CutToClipboard;
    finally
      FIsCustomTextAction := False;
    end;
  end;
end;

class function TcxCustomSpinEdit.GetPropertiesClass: TcxCustomEditPropertiesClass;
begin
  Result := TcxCustomSpinEditProperties;
end;

function TcxCustomSpinEdit.Increment(AButton: TcxSpinEditButton): Boolean;

  function GetMinMaxValueDelta(const AValue: Variant;
    AIsMin: Boolean = True): Variant;
  var
    ADelta, AMaxRange, ARange: Variant;
  begin
    if AIsMin then
    begin
      AMaxRange := ActiveProperties.GetMaxMinValueForCurrentValueType;
      ARange := ActiveProperties.InternalMinValue;
    end
    else
    begin
      AMaxRange := ActiveProperties.GetMaxMinValueForCurrentValueType(False);
      ARange := ActiveProperties.InternalMaxValue;
    end;

    if (ARange > 0) and (AValue > 0) or
      (ARange < 0) and (AValue < 0) then
        Result := ARange - AValue
    else
    begin
      ADelta := AMaxRange - ARange;
      ADelta := ADelta + AValue;
      if (ADelta < 0) and (AValue < 0) or
        (ADelta > 0) and (AValue > 0) then
        Result := AMaxRange
      else
        Result := ARange - AValue;
    end;
  end;

  function InternalIncrement(var AValue: Variant; AIncrement: Variant): Boolean;
  var
    AMaxValueDelta, AMinValueDelta: TcxEditValue;
  begin
    Result := True;
    AIncrement := ActiveProperties.VarToCurrentValueType(AIncrement);
    AMinValueDelta := GetMinMaxValueDelta(AValue);
    AMaxValueDelta := GetMinMaxValueDelta(AValue, False);
    if (AIncrement < AMinValueDelta) or (AIncrement > AMaxValueDelta) then
      case ActiveProperties.GetBoundsCheckingKind of
        bckDoNotExceed:
          begin
            Result := False;
            Exit;
          end;
        bckExtendToBound:
          if AIncrement < AMinValueDelta then
            AValue := ActiveProperties.InternalMinValue
          else
            AValue := ActiveProperties.InternalMaxValue;
        bckCircular:
          if AIncrement < AMinValueDelta then
            AValue := ActiveProperties.InternalMaxValue + AIncrement  + 1
              - AMinValueDelta
          else
            AValue := ActiveProperties.InternalMinValue + AIncrement - 1
               - AMaxValueDelta;
      end
    else
      AValue := AValue + AIncrement;
  end;

  function GetNewValue(out AValue: Variant): Boolean;
  var
    ABoundsCheckingKind: TcxSpinBoundsCheckingKind;
  begin
    Result := False;
    with ActiveProperties do
    begin
      ABoundsCheckingKind := ActiveProperties.GetBoundsCheckingKind;
      AValue := Value;
      if AValue < InternalMinValue then
        if AButton in [sebForward, sebFastForward] then
          AValue := InternalMinValue
        else
          if ABoundsCheckingKind = bckCircular then
            AValue := InternalMaxValue
          else
            Exit
      else
        if AValue > InternalMaxValue then
          if AButton in [sebBackward, sebFastBackward] then
            AValue := InternalMaxValue
          else
            if ABoundsCheckingKind = bckCircular then
              AValue := InternalMinValue
            else
              Exit
        else
        begin
          if not InternalIncrement(AValue, GetIncrement(AButton)) then
            Exit;
        end;
    end;
    Result := True;
    AValue := ActiveProperties.SetVariantType(AValue);
  end;

var
  ADisplayValue: TcxEditValue;
  APrevText: string;
  AValue: Variant;
  APrevSelStart: Integer;
  APrevSelLength: Integer;
begin
  LockChangeEvents(True);
  try
    Result := False;
    if not DoEditing then
      Exit;
    if not GetNewValue(AValue) then
      Exit;

    APrevText := Text;

    ADisplayValue := IncrementValueToStr(AValue);
    APrevSelStart := SelStart;
    APrevSelLength := SelLength;
    SetInternalValue(AValue);
    KeyboardAction := True;
    try
      SetInternalDisplayValue(ADisplayValue);
    finally
      KeyboardAction := False;
    end;
    Result := not InternalCompareString(APrevText, Text, True);
    if Result then
    begin
      ModifiedAfterEnter := True;
      if ActiveProperties.PreserveSelection then
        SetSelection(APrevSelStart, APrevSelLength)
      else
        SelStart := Length(Text);
      if ActiveProperties.ImmediatePost and CanPostEditValue and ValidateEdit(True) then
      begin
        InternalPostEditValue;
        SynchronizeDisplayValue;
      end;
    end;
  finally
    LockChangeEvents(False);
  end;
end;

procedure TcxCustomSpinEdit.PasteFromClipboard;
begin
  if not (Focused and not ActiveProperties.CanEdit) then
  begin
    FIsCustomTextAction := True;
    try
      inherited PasteFromClipboard;
    finally
      FIsCustomTextAction := False;
    end;
  end;
end;

procedure TcxCustomSpinEdit.PrepareEditValue(const ADisplayValue: TcxEditValue;
  out EditValue: TcxEditValue; AEditFocused: Boolean);
var
  AErrorText: TCaption;
begin
  InternalPrepareEditValue(ADisplayValue, True, EditValue, AErrorText);
end;

procedure TcxCustomSpinEdit.ChangeHandler(Sender: TObject);
begin
  FIsCustomText := FIsCustomTextAction;
  inherited ChangeHandler(Sender);
  FIsCustomTextAction := False;
end;

procedure TcxCustomSpinEdit.CheckEditorValueBounds;
begin
  KeyboardAction := ModifiedAfterEnter;
  try
    with ActiveProperties do
      if Value < InternalMinValue then
        Value := InternalMinValue
      else
        if Value > InternalMaxValue then
          Value := InternalMaxValue;
  finally
    KeyboardAction := False;
  end;
end;

procedure TcxCustomSpinEdit.DoButtonDown(AButtonVisibleIndex: Integer);

  procedure CreateTimer;
  begin
    if ActiveProperties.ReadOnly or not DataBinding.IsDataAvailable then
      Exit;
    if FTimer <> nil then
      FTimer.Free;
    FTimer := TcxTimer.Create(Self);
    FTimer.Interval := cxSpinEditTimerInitialInterval;
    FTimer.OnTimer := HandleTimer;
  end;

begin
  inherited DoButtonDown(AButtonVisibleIndex);
  if GetCaptureControl <> Self then
    ShortRefreshContainer(False)
  else
    if FPressedState = epsNone then
      with ViewInfo do
        if PressedButton <> -1 then
        begin
          Increment(TcxSpinEditButton(PressedButton));
          CreateTimer;
        end;
end;

procedure TcxCustomSpinEdit.DoEditKeyDown(var Key: Word; Shift: TShiftState);
const
  APressedStateMap: array[TcxSpinEditButton] of TcxSpinEditPressedState =
    (epsDown, epsUp, epsFastDown, epsFastUp);
var
  AButton: TcxSpinEditButton;
begin
  FIsCustomTextAction := False;
  if ((Key = VK_UP) or (Key = VK_DOWN) or (Key = VK_NEXT) or (Key = VK_PRIOR)) and
    not (ActiveProperties.UseCtrlIncrement and not (ssCtrl in Shift)) then
  begin
    if not DataBinding.Modified and not DoEditing then
      Exit;
    case Key of
      VK_UP:
        AButton := sebForward;
      VK_DOWN:
        AButton := sebBackward;
      VK_PRIOR:
        AButton := sebFastForward;
      else
        AButton := sebFastBackward;
    end;
    PressedState := APressedStateMap[AButton];

    if HasNativeHandle(Self, GetCapture) then
      SetCaptureControl(nil);
    Increment(AButton);
    Key := 0;
  end
  else
  begin
    StopTracking;
      if Key <> VK_ESCAPE then
        FIsCustomTextAction := True;
    if not ActiveProperties.CanEdit and CanKeyDownModifyEdit(Key, Shift) then
    begin
      DoAfterKeyDown(Key, Shift);
      Key := 0;
    end;
  end;

  if Key <> 0 then
    inherited DoEditKeyDown(Key, Shift);
end;

procedure TcxCustomSpinEdit.DoEditKeyPress(var Key: Char);
begin
  if (Key = '.') or (Key = ',') then
    Key := DecimalSeparator;
  if IsTextChar(Key) or (Key = Char(VK_BACK)) or (Key = Char(VK_DELETE)) then
    if not IsValidChar(Key) then
    begin
      Key := #0;
      Beep;