cxcalc.pas

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

PAS
1,899
字号
begin
  inherited FocusChanged;
  InvalidateButton(cbEqual);
end;

procedure TcxCustomCalculator.SetEnabled( Value: Boolean);
begin
  inherited;
  Invalidate;
end;

procedure TcxCustomCalculator.StopTracking;
begin
  if FTracking then
  begin
    TrackButton(-1, -1);
    FTracking := False;
    MouseCapture := False;
    if FDownButton <> cbNone then
      FButtons[FDownButton].Down := False;
  end;
end;

procedure TcxCustomCalculator.TrackButton(X,Y: Integer);
var
  FlagRepaint : Boolean;
begin
  if FDownButton <> cbNone then
  begin
    FlagRepaint := (GetButtonKindAt(X, Y) = FDownButton) <> FButtons[FDownButton].Down;
    FButtons[FDownButton].Down := (GetButtonKindAt(X, Y) = FDownButton);
    if FlagRepaint then
      InvalidateButton(FDownButton);
  end;
end;

procedure TcxCustomCalculator.InvalidateButton(ButtonKind : TcxCalcButtonKind);
var
  R: TRect;
begin
  if ButtonKind <> cbNone then
  begin
    R := FButtons[ButtonKind].BtnRect;
    InvalidateRect(R, False);
  end;
end;

procedure TcxCustomCalculator.MouseLeave(AControl: TControl);
begin
  inherited;
  if GetPainter.IsButtonHotTrack and Enabled and
     not Dragging and (FActiveButton <> cbNone) then
  begin
    InvalidateButton(FActiveButton);
    FActiveButton := cbNone;
  end;
end;

function TcxCustomCalculator.GetButtonKindChar(Ch : Char) : TcxCalcbuttonKind;
begin
  case Ch of
    '0'..'9' : Result := TcxCalcbuttonKind(Ord(cbNum0)+Ord(Ch)-Ord('0'));
    '+' : Result := cbAdd;
    '-' : Result := cbSub;
    '*' : Result := cbMul;
    '/' : Result := cbDiv;
    '%' : Result := cbPercent;
    '=' : Result := cbEqual;
    #8 : Result := cbBack;
    '@' : Result := cbSqrt;
    '.', ',': Result := cbDecimal;
  else
    Result := cbNone;
  end;
end;

function TcxCustomCalculator.GetButtonKindKey(Key: Word; Shift: TShiftState) : TcxCalcbuttonKind;
begin
  Result := cbNone;
  case Key of
    VK_RETURN : Result := cbEqual;
    VK_ESCAPE : Result := cbClear;
    VK_F9 : Result := cbSign;
    VK_DELETE : Result := cbCancel;
    Ord('C'){VK_C} : if not (ssCtrl in Shift) then Result := cbClear;
    Ord('P'){VK_P} : if ssCtrl in Shift then Result := cbMP;
    Ord('L'){VK_L} : if ssCtrl in Shift then Result := cbMC;
    Ord('R'){VK_R} : if ssCtrl in Shift then Result := cbMR
                     else Result := cbRev;
    Ord('M'){VK_M} : if ssCtrl in Shift then Result := cbMS;
  end;
end;

procedure TcxCustomCalculator.CopyToClipboard;
begin
  Clipboard.AsText := GetEditorValue;
end;

procedure TcxCustomCalculator.PasteFromClipboard;
var
  S, S1 : String;
  i : Integer;
begin
  if Clipboard.HasFormat(CF_TEXT) then
    try
      S := Clipboard.AsText;
      S1 := '';
      repeat
        i := Pos(CurrencyString, S);
        if i > 0 then
        begin
          S1 := S1 + Copy(S, 1, i - 1);
          S := Copy(S, i + Length(CurrencyString), MaxInt);
        end
        else
          S1 := S1 + S;
      until i <= 0;
      SetDisplay(StrToFloat(Trim(S1)));
      FStatus := csValid;
    except
      SetDisplay(0.0);
    end;
end;

procedure TcxCustomCalculator.SetAutoFontSize(Value : Boolean);
begin
  if AutoFontSize <> Value then
  begin
    FAutoFontSize := Value;
    Font.OnChange(nil);
  end;
end;

// math routines
procedure TcxCustomCalculator.Error;
begin
  FStatus := csError;
  SetEditorValue(cxGetResourceString(@scxSCalcError));
  if FBeepOnError then MessageBeep(0);
//  if Assigned(FOnError) then FOnError(Self);
end;

procedure TcxCustomCalculator.CheckFirst;
begin
  if FStatus = csFirst then
  begin
    FStatus := csValid;
    SetEditorValue('0');
  end;
end;

procedure TcxCustomCalculator.Clear;
begin
  FStatus := csFirst;
  SetDisplay(0.0);
  FOperator := cbEqual;
end;

procedure TcxCustomCalculator.ButtonClick(ButtonKind : TcxCalcButtonKind);
var Value : Extended;
begin
  if Assigned(FOnButtonClick) then FOnButtonClick(Self, ButtonKind);
  if (FStatus = csError) and not (ButtonKind in [cbClear, cbCancel]) then
  begin
    Error;
    Exit;
  end;
  if ButtonKind = cbDecimal then
  begin
    CheckFirst;
    if Pos(DecimalSeparator, EditorValue) = 0 then
      SetEditorValue(EditorValue + DecimalSeparator);
    Exit;
  end;
  case ButtonKind of
    cbRev:
      if FStatus in [csValid, csFirst] then
      begin
        FStatus := csFirst;
        if FOperator in OperationButtons then
           FStatus := csValid;
        if GetDisplay = 0 then Error else SetDisplay(1.0 / GetDisplay);
      end;
    cbSqrt:
      if FStatus in [csValid, csFirst] then
      begin
        FStatus := csFirst;
        if FOperator in OperationButtons then
           FStatus := csValid;
        if GetDisplay < 0 then Error else SetDisplay(Sqrt(GetDisplay));
      end;
    cbNum0..cbNum9:
      begin
        CheckFirst;
        if EditorValue = '0' then SetEditorValue('');
        if Length(EditorValue) < Max(2, FPrecision) + Ord(Boolean(Pos('-', EditorValue))) then
          SetEditorValue(EditorValue + Char(Ord('0')+Byte(ButtonKind)-Byte(cbNum0)))
        else
          if FBeepOnError then MessageBeep(0);
      end;
    cbBack:
      begin
        CheckFirst;
        if (Length(EditorValue) = 1) or ((Length(EditorValue) = 2) and (EditorValue[1] = '-')) then
          SetEditorValue('0')
        else
          SetEditorValue(Copy(EditorValue, 1, Length(EditorValue) - 1));
      end;
    cbSign: SetDisplay(-GetDisplay);
    cbAdd, cbSub, cbMul, cbDiv, cbEqual, cbPercent :
      begin
        if FStatus = csValid then
        begin
          FStatus := csFirst;
          Value := GetDisplay;
          if ButtonKind = cbPercent then
            case FOperator of
              cbAdd, cbSub : Value := FOperand * Value / 100.0;
              cbMul, cbDiv : Value := Value / 100.0;
            end;
          case FOperator of
            cbAdd : SetDisplay(FOperand + Value);
            cbSub : SetDisplay(FOperand - Value);
            cbMul : SetDisplay(FOperand * Value);
            cbDiv : if Value = 0 then Error else SetDisplay(FOperand / Value);
          end;
        end;
        FOperator := ButtonKind;
        FOperand := GetDisplay;
        if (ButtonKind in ResultButtons) and Assigned(FOnResult) then FOnResult(Self);
      end;
    cbClear, cbCancel: Clear;
    cbMP:
      if FStatus in [csValid, csFirst] then
      begin
        FStatus := csFirst;
        FMemory := FMemory + GetDisplay;
        UpdateMemoryButtons;
        InvalidateMemoryButtons;
      end;
    cbMS:
      if FStatus in [csValid, csFirst] then
      begin
        FStatus := csFirst;
        FMemory := GetDisplay;
        UpdateMemoryButtons;
        InvalidateMemoryButtons;
      end;
    cbMR:
      if FStatus in [csValid, csFirst] then
      begin
        FStatus := csFirst;
        CheckFirst;
        SetDisplay(FMemory);
      end;
    cbMC:
      begin
        FMemory := 0.0;
        UpdateMemoryButtons;
        InvalidateMemoryButtons;
      end;
  end;
end;

procedure TcxCustomCalculator.UpdateMemoryButtons;
begin
  // Disable buttons
  if FMemory <> 0.0 then
  begin
    FButtons[cbMC].Grayed := False;
    FButtons[cbMR].Grayed := False;
  end
  else
  begin
    FButtons[cbMC].Grayed := True;
    FButtons[cbMR].Grayed := True;
  end;
end;

procedure TcxCustomCalculator.InvalidateMemoryButtons;
begin
  InvalidateButton(cbMC);
  InvalidateButton(cbMR);
end;

function TcxCustomCalculator.GetDisplay: Extended;
var
  S: string;
begin
  if FStatus = csError then
    Result := 0.0
  else
  begin
    S := Trim(GetEditorValue);
    if S = '' then S := '0';
    RemoveThousandSeparator(S);
    Result := StrToFloat(S);
  end;
end;

procedure TcxCustomCalculator.SetDisplay(Value: Extended);
var
  S: string;
begin
  S := FloatToStrF(Value, ffGeneral, Max(2, FPrecision), 0);
  if GetEditorValue <> S then
  begin
    SetEditorValue(S);
    if Assigned(FOnDisplayChange) then FOnDisplayChange(Self);
  end;
end;

function TcxCustomCalculator.GetMemory: Extended;
begin
  Result := FMemory;
end;

procedure TcxCustomCalculator.HidePopup(Sender: TcxControl; AReason: TcxEditCloseUpReason);
begin
  if Assigned(FOnHidePopup) then FOnHidePopup(Self, AReason);
end;

{ TcxPopupCalculator }

constructor TcxPopupCalculator.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  IsPopupControl := True;
end;

procedure TcxPopupCalculator.Init;
begin
  FPressedButton := cbNone;
end;

function TcxPopupCalculator.GetEditorValue: string;
begin
  Result := Edit.Text;
end;

function TcxPopupCalculator.GetPainter: TcxCustomLookAndFeelPainterClass;
begin
  if Edit.ViewInfo.Painter <> nil then
    Result := Edit.ViewInfo.Painter
  else
    Result := GetButtonPainterClass(Edit.PopupControlsLookAndFeel);
end;

procedure TcxPopupCalculator.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  case Key of
    VK_ESCAPE: HidePopup(Self, crCancel);
    VK_INSERT:
      if (Shift = [ssShift]) then
        PasteFromClipboard
      else
        if (Shift = [ssCtrl]) then
          CopyToClipboard;
    VK_F4:
      if not (ssAlt in Shift) then
        HidePopup(Self, crClose);
    VK_UP, VK_DOWN:
      if Shift = [ssAlt] then
        HidePopup(Self, crClose);
    VK_TAB:
      Edit.DoEditKeyDown(Key, Shift);
    VK_RETURN:
      HidePopup(Self, crEnter);
  end;
end;

procedure TcxPopupCalculator.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  if (Key = '=') and FEdit.ActiveProperties.QuickClose then
    HidePopup(Self, crEnter);
end;

procedure TcxPopupCalculator.SetEditorValue(const Value: string);
begin
  if Edit.DoEditing then
  begin
    Edit.InnerEdit.EditValue := Value;
    Edit.ModifiedAfterEnter := True;
  end;
end;

{ TcxCalcEditPropertiesValues }

procedure TcxCalcEditPropertiesValues.Assign(Source: TPersistent);
begin
  if Source is TcxCalcEditPropertiesValues then
  begin
    BeginUpdate;
    try
      inherited Assign(Source);
      Precision := TcxCalcEditPropertiesValues(Source).Precision;
    finally
      EndUpdate;
    end;
  end
  else
    inherited Assign(Source);
end;

procedure TcxCalcEditPropertiesValues.RestoreDefaults;
begin
  BeginUpdate;
  try
    inherited RestoreDefaults;
    Precision := False;
  finally
    EndUpdate;
  end;
end;

procedure TcxCalcEditPropertiesValues.SetPrecision(Value: Boolean);
begin
  if Value <> FPrecision then
  begin
    FPrecision := Value;
    Changed;
  end;
end;

{ TcxCustomCalcEditProperties }

constructor TcxCustomCalcEditProperties.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner);
  FBeepOnError := True;
  FPrecision := cxDefCalcPrecision;
//  MaxLength := cxDefCalcPrecision + 2;
  FQuickClose := False;
  PopupSizeable := False;
  ImmediateDropDown := False;
end;

function TcxCustomCalcEditProperties.GetAssignedValues: TcxCalcEditPropertiesValues;
begin
  Result := TcxCalcEditPropertiesValues(FAssignedValues);
end;

function TcxCustomCalcEditProperties.GetPrecision: Byte;
begin
  if AssignedValues.Precision then
    Result := FPrecision
  else
    if IDefaultValuesProvider <> nil then
      Result := IDefaultValuesProvider.DefaultPrecision
    else
      Result := cxDefCalcPrecision;
  if Result > cxMaxCalcPrecision then
    Result := cxMaxCalcPrecision;
end;

function TcxCustomCalcEditProperties.IsPrecisionStored: Boolean;
begin
  Result := AssignedValues.Precision;
end;

procedure TcxCustomCalcEditProperties.SetAssignedValues(
  Value: TcxCalcEditPropertiesValues);
begin
  FAssignedValues.Assign(Value);
end;

procedure TcxCustomCalcEditProperties.SetBeepOnError(Value: Boolean);
begin
  if Value <> FBeepOnError then
  begin
    FBeepOnError := Value;
    Changed;
  end;

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?