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 + -
显示快捷键?