f557d85ab0
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@963 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2706 lines
75 KiB
ObjectPascal
2706 lines
75 KiB
ObjectPascal
{*********************************************************}
|
|
{* OVCCALC.PAS 4.06 *}
|
|
{*********************************************************}
|
|
|
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
|
{* Version: MPL 1.1 *}
|
|
{* *}
|
|
{* The contents of this file are subject to the Mozilla Public License *}
|
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
|
{* compliance with the License. You may obtain a copy of the License at *}
|
|
{* http://www.mozilla.org/MPL/ *}
|
|
{* *}
|
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
|
{* for the specific language governing rights and limitations under the *}
|
|
{* License. *}
|
|
{* *}
|
|
{* The Original Code is TurboPower Orpheus *}
|
|
{* *}
|
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
|
{* *}
|
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
|
{* *}
|
|
{* Contributor(s): *}
|
|
{* *}
|
|
{* ***** END LICENSE BLOCK ***** *}
|
|
|
|
{$I OVC.INC}
|
|
|
|
{$B-} {Complete Boolean Evaluation}
|
|
{$I+} {Input/Output-Checking}
|
|
{$P+} {Open Parameters}
|
|
{$T-} {Typed @ Operator}
|
|
{.W-} {Windows Stack Frame}
|
|
{$X+} {Extended Syntax}
|
|
|
|
unit ovccalc;
|
|
{-calculator component}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, Types, LclType, GraphType, MyMisc, {$ENDIF}
|
|
Buttons, Classes, ClipBrd, Controls, ExtCtrls, Forms, Graphics,
|
|
Menus, StdCtrls, SysUtils,
|
|
OvcData, OvcConst, OvcBase, OvcMisc;
|
|
|
|
type
|
|
TOvcCalculatorButton = (
|
|
cbNone, cbTape, cbBack, cbClearEntry, cbClear, cbAdd, cbSub, cbMul, cbDiv,
|
|
cb0, cb1, cb2, cb3, cb4, cb5, cb6, cb7, cb8, cb9,
|
|
cbDecimal, cbEqual, cbInvert, cbChangeSign, cbPercent, cbSqrt,
|
|
cbMemClear, cbMemRecall, cbMemStore, cbMemAdd, cbMemSub, cbSubTotal);
|
|
|
|
TOvcButtonInfo = packed record
|
|
Position : TRect; {position and size}
|
|
Caption : string[10]; {button text}
|
|
Visible : Boolean; {true to display button}
|
|
end;
|
|
|
|
TOvcButtonArray = array[cbTape..cbMemSub] of TOvcButtonInfo;
|
|
|
|
type
|
|
TOvcCalculatorOperation = (
|
|
coNone, coAdd, coSub, coMul, coDiv,
|
|
coEqual, coInvert, coPercent, coSqrt,
|
|
coMemClear, coMemRecall, coMemStore, coMemAdd, coMemSub, coSubTotal);
|
|
|
|
TOvcCalcState = (csValid, csLocked, csClear);
|
|
TOvcCalcStates = set of TOvcCalcState;
|
|
|
|
type
|
|
TOvcCalcColorArray = array[0..7] of TColor;
|
|
TOvcCalcColorScheme = (cscalcCustom, cscalcWindows, cscalcDark,
|
|
cscalcOcean, cscalcPlain);
|
|
TOvcCalcSchemeArray = array[TOvcCalcColorScheme] of TOvcCalcColorArray;
|
|
TOvcCalcDisplayString = array[TOvcCalculatorButton] of string;
|
|
TOvcCalcButtonToOperation = array[cbNone..cbSubTotal] of TOvcCalculatorOperation;
|
|
|
|
|
|
const
|
|
{DisabledMemoryButtons, Display, DisplayTextColor, EditButtons,
|
|
FunctionButtons, MemoryButtons, NumberButtons, OperatorButtons}
|
|
CalcScheme : TOvcCalcSchemeArray =
|
|
((0, 0, 0, 0, 0, 0, 0, 0),
|
|
(clGray, clWindow, clWindowText, clMaroon, clNavy, clRed, clBlue, clRed),
|
|
(clGray, clBlack, clAqua, clBlack, clTeal, clNavy, clMaroon, clBlue),
|
|
(clGray, clAqua, clBlack, clPurple, clNavy, clNavy, clAqua, clBlue),
|
|
(clGray, clWhite, clNavy, clBlack, clNavy, clNavy, clBlue, clBlue)
|
|
);
|
|
{ You must set the Length of the first entry (cbNone) to the Length of the largest entry}
|
|
CalcDisplayString : TOvcCalcDisplayString =
|
|
(' ',' ',' ','CE','C' ,'+' ,'-' ,'*' ,'/',
|
|
' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',
|
|
' ','=' ,'1/','-+','%' ,'SQ',
|
|
'MC','MR','MS','M+','M-','*' );
|
|
|
|
CalcButtontoOperation : TOvcCalcButtonToOperation =
|
|
(coNone, coNone, coNone, coNone, coNone, coAdd, coSub, coMul, coDiv,
|
|
coNone, coNone, coNone, coNone, coNone, coNone, coNone, coNone, coNone, coNone,
|
|
coNone, coEqual, coInvert, coNone, coPercent, coSqrt,
|
|
coMemClear, coMemRecall, coMemStore, coMemAdd, coMemSub, coSubTotal);
|
|
|
|
type
|
|
TOvcCalcColors = class(TPersistent)
|
|
{.Z+}
|
|
private
|
|
{property variables}
|
|
FUpdating : Boolean;
|
|
FOnChange : TNotifyEvent;
|
|
|
|
{internal variables}
|
|
SettingScheme : Boolean;
|
|
|
|
{internal methods}
|
|
procedure DoOnChange;
|
|
|
|
{property methods}
|
|
function GetColor(const Index : Integer) : TColor;
|
|
procedure SetColor(const Index : Integer; const Value : TColor);
|
|
procedure SetColorScheme(const Value : TOvcCalcColorScheme);
|
|
procedure SetDisplayTextColor(const Value : TColor);
|
|
|
|
public
|
|
{property variables}
|
|
FCalcColors : TOvcCalcColorArray;
|
|
FColorScheme : TOvcCalcColorScheme;
|
|
|
|
procedure Assign(Source : TPersistent);
|
|
override;
|
|
procedure BeginUpdate;
|
|
procedure EndUpdate;
|
|
|
|
property OnChange : TNotifyEvent
|
|
read FOnChange write FOnChange;
|
|
{.Z-}
|
|
|
|
published
|
|
property ColorScheme : TOvcCalcColorScheme
|
|
read FColorScheme write SetColorScheme;
|
|
property DisabledMemoryButtons : TColor index 0
|
|
read GetColor write SetColor;
|
|
property Display : TColor index 1
|
|
read GetColor write SetColor;
|
|
property DisplayTextColor : TColor
|
|
read FCalcColors[2] write SetDisplayTextColor nodefault;
|
|
property EditButtons : TColor index 3
|
|
read GetColor write SetColor;
|
|
property FunctionButtons : TColor index 4
|
|
read GetColor write SetColor;
|
|
property MemoryButtons : TColor index 5
|
|
read GetColor write SetColor;
|
|
property NumberButtons : TColor index 6
|
|
read GetColor write SetColor;
|
|
property OperatorButtons : TColor index 7
|
|
read GetColor write SetColor;
|
|
end;
|
|
|
|
type
|
|
{.Z+}
|
|
TOvcCalcPanel = class(TPanel)
|
|
protected
|
|
procedure Click;
|
|
override;
|
|
public
|
|
end;
|
|
{.Z-}
|
|
|
|
type
|
|
{.Z+}
|
|
TOvcCustomCalculatorEngine = class
|
|
protected {private}
|
|
{property variables}
|
|
FDecimals : Integer;
|
|
FShowSeparatePercent : Boolean;
|
|
|
|
{internal variables}
|
|
cCalculated : Extended;
|
|
cLastOperation : TOvcCalculatorOperation;
|
|
cOperationCount : Integer;
|
|
cMemory : Extended; {value stored in memory register}
|
|
cOperands : array [0..3] of Extended; {the operand stack}
|
|
cState : TOvcCalcStates;
|
|
|
|
public
|
|
function AddOperand(const Value : Extended; const Button : TOvcCalculatorOperation) : Boolean;
|
|
virtual; abstract;
|
|
function AddOperation(const Button : TOvcCalculatorOperation) : Boolean;
|
|
virtual; abstract;
|
|
procedure ClearAll;
|
|
procedure PushOperand(const Value : Extended);
|
|
function PopOperand : Extended;
|
|
function TopOperand : Extended;
|
|
|
|
{public properties}
|
|
property Decimals : Integer
|
|
read FDecimals write FDecimals;
|
|
property LastOperation : TOvcCalculatorOperation
|
|
read cLastOperation write cLastOperation;
|
|
property Memory : Extended
|
|
read cMemory write cMemory;
|
|
property OperationCount : Integer
|
|
read cOperationCount write cOperationCount;
|
|
property ShowSeparatePercent : Boolean
|
|
read FShowSeparatePercent write FShowSeparatePercent;
|
|
property State : TOvcCalcStates
|
|
read cState write cState;
|
|
end;
|
|
{.Z-}
|
|
|
|
type
|
|
{.Z+}
|
|
TOvcCalcTape = class(TObject)
|
|
protected {private}
|
|
{property variables}
|
|
FMaxPaperCount : Integer;
|
|
FShowTape : Boolean;
|
|
FTapeDisplaySpace : Integer;
|
|
FVisible : Boolean;
|
|
|
|
{internal variables}
|
|
taListBox : TListBox;
|
|
taTapeColor : TColor;
|
|
taHeight : Integer;
|
|
taOwner : TComponent;
|
|
taOperandSize : Integer;
|
|
taFont : TFont;
|
|
taMaxTapeCount : Integer;
|
|
taTapeInitialized : Boolean;
|
|
taWidth : Integer;
|
|
|
|
procedure ValidateListBox;
|
|
function GetFont : TFont;
|
|
procedure SetFont(const Value : TFont);
|
|
function GetHeight : Integer;
|
|
procedure SetHeight(const Value : Integer);
|
|
function GetTape : TStrings;
|
|
procedure SetTape(const Value : TStrings);
|
|
function GetTapeColor : TColor;
|
|
procedure SetTapeColor(const Value : TColor);
|
|
function GetTop : Integer;
|
|
procedure SetTop(const Value : Integer);
|
|
function GetTopIndex : Integer;
|
|
procedure SetTopIndex(const Value : Integer);
|
|
function GetVisible : Boolean;
|
|
procedure SetVisible(const Value : Boolean);
|
|
function GetWidth : Integer;
|
|
procedure SetWidth(const Value : Integer);
|
|
|
|
protected
|
|
procedure Add(const Value : string);
|
|
procedure DeleteFirst;
|
|
procedure taOnClick(Sender : TObject);
|
|
procedure taOnDblClick(Sender : TObject);
|
|
procedure taOnDrawItem(Control: TWinControl; Index: Integer;
|
|
Rect:TRect;State: TOwnerDrawState);
|
|
procedure taTapeFontChange(Sender : TObject);
|
|
|
|
public
|
|
constructor Create(const AOwner : TComponent; const AOperandSize : Integer);
|
|
destructor Destroy;
|
|
override;
|
|
|
|
procedure InitializeTape;
|
|
procedure SetBounds(const ALeft, ATop, AWidth, AHeight : Integer);
|
|
function GetDisplayedItemCount : Integer;
|
|
procedure AddToTape(const Value : string;
|
|
const OpString : string);
|
|
procedure AddToTapeLeft(const Value : string);
|
|
procedure ClearTape;
|
|
procedure RefreshDisplays;
|
|
procedure SpaceTape(const Value : char);
|
|
|
|
property Font : TFont
|
|
read GetFont write SetFont;
|
|
property Height : Integer
|
|
read GetHeight write SetHeight;
|
|
property MaxPaperCount : Integer
|
|
read FMaxPaperCount write FMaxPaperCount;
|
|
property ShowTape : Boolean
|
|
read FShowTape write FShowTape;
|
|
property Tape : TStrings
|
|
read GetTape write SetTape;
|
|
property TapeColor : TColor
|
|
read GetTapeColor write SetTapeColor;
|
|
property TapeDisplaySpace : Integer
|
|
read FTapeDisplaySpace write FTapeDisplaySpace;
|
|
property Top : Integer
|
|
read GetTop write SetTop;
|
|
property TopIndex : Integer
|
|
read GetTopIndex write SetTopIndex;
|
|
property Visible : Boolean
|
|
read GetVisible write SetVisible;
|
|
property Width : Integer
|
|
read GetWidth write SetWidth;
|
|
end;
|
|
{.Z-}
|
|
|
|
type
|
|
TOvcCalcButtonPressedEvent =
|
|
procedure(Sender : TObject; Button : TOvcCalculatorButton)
|
|
of object;
|
|
|
|
TOvcCalculatorOption = (coShowItemCount, coShowMemoryButtons,
|
|
coShowClearTapeButton, coShowTape, coShowSeparatePercent);
|
|
TOvcCalculatorOptions = set of TOvcCalculatorOption;
|
|
|
|
TOvcCustomCalculator = class(TOvcCustomControl)
|
|
{.Z+}
|
|
protected {private}
|
|
{property variables}
|
|
FBorderStyle : TBorderStyle;
|
|
FColors : TOvcCalcColors;
|
|
FDisplay : Extended; {the calculated value}
|
|
FDisplayStr : string; {the string that is displayed}
|
|
FLastOperand : Extended;
|
|
FOptions : TOvcCalculatorOptions;
|
|
FTapeSeparatorChar : Char;
|
|
{$IFDEF LCL}
|
|
FCtl3D : Boolean;
|
|
{$ENDIF}
|
|
|
|
{event variables}
|
|
FOnButtonPressed : TOvcCalcButtonPressedEvent;
|
|
|
|
{internal variables}
|
|
cButtons : TOvcButtonArray;
|
|
cDecimalEntered : Boolean;
|
|
cDownButton : TOvcCalculatorButton;
|
|
cHitTest : TPoint; {location of mouse cursor}
|
|
cLastButton : TOvcCalculatorButton;
|
|
cMargin : Integer;
|
|
cMinus0 : Boolean;
|
|
cOverBar : Boolean;
|
|
cPanel : TOvcCalcPanel;
|
|
cPopup : Boolean; {true if being created as a popup}
|
|
cScrBarWidth : Integer;
|
|
cSizeOffset : Integer; { the offset of the sizing line }
|
|
cSizing : Boolean; { Are we showing the sizing cursor? }
|
|
cTabCursor : HCursor; {design-time tab slecting cursor handle}
|
|
cTape : TOvcCalcTape;
|
|
cEngine : TOvcCustomCalculatorEngine;
|
|
|
|
{internal methods}
|
|
procedure cAdjustHeight;
|
|
procedure cCalculateLook;
|
|
procedure cClearAll;
|
|
procedure cColorChange(Sender : TObject);
|
|
procedure cDisplayError;
|
|
procedure cDrawCalcButton(const Button : TOvcButtonInfo; const Pressed : Boolean);
|
|
procedure cDrawFocusState;
|
|
procedure cDrawSizeLine;
|
|
procedure cEvaluate(const Button : TOvcCalculatorButton);
|
|
function cFormatString(const Value : Extended) : string;
|
|
function cGetFontWidth : Integer;
|
|
procedure cInvalidateIndicator;
|
|
procedure cRefreshDisplays;
|
|
procedure cSetDisplayString(const Value : string);
|
|
procedure cTapeFontChange(Sender : TObject);
|
|
|
|
{property methods}
|
|
function GetDecimals : Integer;
|
|
function GetMaxPaperCount : Integer;
|
|
function GetMemory : Extended;
|
|
function GetOperand : Extended;
|
|
function GetTape : TStrings;
|
|
function GetTapeFont : TFont;
|
|
function GetTapeHeight : Integer;
|
|
function GetVisible : Boolean;
|
|
procedure SetBorderStyle(const Value : TBorderStyle);
|
|
procedure SetDecimals(const Value : Integer);
|
|
procedure SetDisplay(const Value : Extended);
|
|
procedure SetDisplayStr(const Value : string);
|
|
procedure SetMaxPaperCount(const Value : Integer);
|
|
procedure SetMemory(const Value : Extended);
|
|
procedure SetOperand(const Value : Extended);
|
|
procedure SetOptions(const Value : TOvcCalculatorOptions);
|
|
procedure SetTape(const Value : TStrings);
|
|
procedure SetTapeFont(const Value : TFont);
|
|
procedure SetTapeHeight(const Value : Integer);
|
|
procedure SetVisible(const Value : Boolean);
|
|
|
|
{VCL control methods}
|
|
{$IFNDEF LCL}
|
|
procedure CMCtl3DChanged(var Msg : TMessage);
|
|
message CM_CTL3DCHANGED;
|
|
{$ENDIF}
|
|
procedure CMDesignHitTest(var Msg : TCMDesignHitTest);
|
|
message CM_DESIGNHITTEST;
|
|
procedure CMEnter(var Msg : TMessage);
|
|
message CM_ENTER;
|
|
procedure CMExit(var Msg : TMessage);
|
|
message CM_EXIT;
|
|
procedure CMFontChanged(var Msg : TMessage);
|
|
message CM_FONTCHANGED;
|
|
|
|
{windows message handlers}
|
|
procedure WMCancelMode(var Msg : TMessage);
|
|
message WM_CANCELMODE;
|
|
procedure WMEraseBkgnd(var Msg : TWMEraseBkgnd);
|
|
message WM_ERASEBKGND;
|
|
procedure WMGetText(var Msg : TWMGetText);
|
|
message WM_GETTEXT;
|
|
procedure WMGetTextLength(var Msg : TWMGetTextLength);
|
|
message WM_GETTEXTLENGTH;
|
|
procedure WMKeyDown(var Msg : TWMKeyDown);
|
|
message WM_KEYDOWN;
|
|
procedure WMKillFocus(var Msg : TWMKillFocus);
|
|
message WM_KILLFOCUS;
|
|
procedure WMLButtonDown(var Msg : TWMMouse);
|
|
message WM_LBUTTONDOWN;
|
|
procedure WMLButtonUp(var Msg : TWMMouse);
|
|
message WM_LBUTTONUP;
|
|
procedure WMMouseMove(var Msg : TWMMouse);
|
|
message WM_MOUSEMOVE;
|
|
procedure WMNCHitTest(var Msg : TWMNCHitTest);
|
|
message WM_NCHITTEST;
|
|
procedure WMSetText(var Msg : TWMSetText);
|
|
message WM_SETTEXT;
|
|
procedure WMSetCursor(var Msg : TWMSetCursor);
|
|
message WM_SETCURSOR;
|
|
|
|
protected
|
|
procedure CreateParams(var Params : TCreateParams);
|
|
override;
|
|
procedure CreateWnd;
|
|
override;
|
|
procedure KeyDown(var Key : Word; Shift : TShiftState);
|
|
override;
|
|
procedure MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
|
|
override;
|
|
procedure MouseUp(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
|
|
override;
|
|
procedure Paint;
|
|
override;
|
|
{.Z-}
|
|
|
|
{protected properties}
|
|
property BorderStyle : TBorderStyle
|
|
read FBorderStyle write SetBorderStyle;
|
|
property Colors : TOvcCalcColors
|
|
read FColors write FColors;
|
|
property Decimals : Integer
|
|
read GetDecimals write SetDecimals;
|
|
property MaxPaperCount : Integer
|
|
read GetMaxPaperCount write SetMaxPaperCount;
|
|
property Options : TOvcCalculatorOptions
|
|
read FOptions write SetOptions;
|
|
property TapeFont : TFont
|
|
read GetTapeFont write SetTapeFont;
|
|
property TapeHeight : Integer
|
|
read GetTapeHeight write SetTapeHeight;
|
|
property TapeSeparatorChar : Char
|
|
read FTapeSeparatorChar write FTapeSeparatorChar;
|
|
property Visible : Boolean
|
|
read GetVisible write SetVisible;
|
|
{$IFDEF LCL}
|
|
property Ctl3D : Boolean read FCtl3D write FCtl3D;
|
|
{$ENDIF}
|
|
|
|
{protected events}
|
|
property OnButtonPressed : TOvcCalcButtonPressedEvent
|
|
read FOnButtonPressed write FOnButtonPressed;
|
|
|
|
public
|
|
{.Z+}
|
|
constructor Create(AOwner : TComponent);
|
|
override;
|
|
constructor CreateEx(AOwner : TComponent; AsPopup : Boolean);
|
|
virtual;
|
|
destructor Destroy;
|
|
override;
|
|
procedure KeyPress(var Key : Char);
|
|
override;
|
|
procedure PushOperand(const Value : Extended);
|
|
procedure SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
|
|
override;
|
|
{.Z-}
|
|
|
|
procedure CopyToClipboard;
|
|
procedure PasteFromClipboard;
|
|
procedure PressButton(Button : TOvcCalculatorButton);
|
|
|
|
{public properties}
|
|
property LastOperand : Extended
|
|
read FLastOperand write FLastOperand;
|
|
property Memory : Extended
|
|
read GetMemory write SetMemory;
|
|
property Operand : Extended
|
|
read GetOperand write SetOperand;
|
|
property DisplayStr : string
|
|
read FDisplayStr write SetDisplayStr;
|
|
property DisplayValue : Extended
|
|
read FDisplay write SetDisplay;
|
|
property Tape : TStrings
|
|
read GetTape write SetTape;
|
|
end;
|
|
|
|
TOvcCalculator = class(TOvcCustomCalculator)
|
|
published
|
|
{properties}
|
|
{$IFDEF VERSION4}
|
|
property Anchors;
|
|
property Constraints;
|
|
property DragKind;
|
|
{$ENDIF}
|
|
property About;
|
|
property Align;
|
|
property BorderStyle default bsNone;
|
|
property Ctl3D;
|
|
property Font; {must be prior to "Colors"}
|
|
property TapeFont; {must be prior to "Colors"}
|
|
property Colors;
|
|
property Cursor;
|
|
property Decimals;
|
|
property DragCursor;
|
|
property DragMode;
|
|
property Enabled;
|
|
property LabelInfo;
|
|
property MaxPaperCount default 9999;
|
|
property TapeHeight ; {Must be Prior to Options}
|
|
property Options default [coShowMemoryButtons, coShowItemCount];
|
|
{$IFNDEF LCL}
|
|
property ParentCtl3D;
|
|
{$ENDIF}
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ShowHint;
|
|
property TabOrder;
|
|
property TabStop default True;
|
|
property TapeSeparatorChar default '_';
|
|
property Visible default True;
|
|
|
|
{events}
|
|
property OnButtonPressed;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnStartDrag;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
const
|
|
calcDefMinSize = 30;
|
|
|
|
|
|
{*** TOvcCalcColors ***}
|
|
|
|
procedure TOvcCalcColors.Assign(Source : TPersistent);
|
|
begin
|
|
if Source is TOvcCalcColors then begin
|
|
FCalcColors := TOvcCalcColors(Source).FCalcColors;
|
|
FColorScheme := TOvcCalcColors(Source).FColorScheme;
|
|
FOnChange := TOvcCalcColors(Source).FOnChange;
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure TOvcCalcColors.BeginUpdate;
|
|
begin
|
|
FUpdating := True;
|
|
end;
|
|
|
|
procedure TOvcCalcColors.EndUpdate;
|
|
begin
|
|
FUpdating := False;
|
|
DoOnChange;
|
|
end;
|
|
|
|
procedure TOvcCalcColors.DoOnChange;
|
|
begin
|
|
if not FUpdating and Assigned(FOnChange) then
|
|
FOnChange(Self);
|
|
|
|
if not SettingScheme then
|
|
FColorScheme := cscalcCustom;
|
|
end;
|
|
|
|
function TOvcCalcColors.GetColor(const Index : Integer) : TColor;
|
|
begin
|
|
Result := FCalcColors[Index];
|
|
end;
|
|
|
|
procedure TOvcCalcColors.SetColor(const Index : Integer; const Value : TColor);
|
|
begin
|
|
if Value <> FCalcColors[Index] then begin
|
|
FCalcColors[Index] := Value;
|
|
DoOnChange;
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcCalcColors.SetColorScheme(const Value : TOvcCalcColorScheme);
|
|
begin
|
|
if Value <> FColorScheme then begin
|
|
SettingScheme := True;
|
|
try
|
|
FColorScheme := Value;
|
|
if Value <> cscalcCustom then begin
|
|
FCalcColors := CalcScheme[Value];
|
|
DoOnChange;
|
|
end;
|
|
finally
|
|
SettingScheme := False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcCalcColors.SetDisplayTextColor(const Value : TColor);
|
|
begin
|
|
if Value <> FCalcColors[2] then begin
|
|
FCalcColors[2] := Value;
|
|
DoOnChange;
|
|
end;
|
|
end;
|
|
|
|
|
|
{*** TOvcCalcTape ***}
|
|
|
|
constructor TOvcCalcTape.Create(const AOwner : TComponent; const AOperandSize : Integer);
|
|
begin
|
|
inherited Create;
|
|
taOwner := AOwner;
|
|
FVisible := False;
|
|
taOperandSize := AOperandSize;
|
|
taFont := TFont.Create;
|
|
taFont.Name := 'Courier New';
|
|
taFont.Size := 10;
|
|
taFont.Style := [];
|
|
end;
|
|
|
|
destructor TOvcCalcTape.Destroy;
|
|
begin
|
|
taFont.Free;
|
|
taFont := nil;
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TOvcCalcTape.ValidateListBox;
|
|
begin
|
|
if not Assigned(taListBox) then begin
|
|
taListBox := TListBox.Create(taOwner);
|
|
with taListBox do begin
|
|
OnClick := taOnClick;
|
|
OnDblClick := taOnDblClick;
|
|
OnDrawItem := taOnDrawItem;
|
|
Style := lbOwnerDrawFixed;
|
|
Parent := taOwner as TWinControl;
|
|
ParentFont := False;
|
|
{$IFNDEF LCL}
|
|
ParentCtl3D := True;
|
|
{$ENDIF}
|
|
BorderStyle := bsSingle;
|
|
Color := taTapeColor;
|
|
Visible := FVisible;
|
|
Width := taWidth;
|
|
Height := taHeight;
|
|
Font.Assign(taFont);
|
|
Font.OnChange := taFont.OnChange;
|
|
taFont.OnChange := taTapeFontChange;
|
|
TabStop := False;
|
|
end;
|
|
taTapeInitialized := False;
|
|
end;
|
|
InitializeTape;
|
|
end;
|
|
|
|
procedure TOvcCalcTape.Add(const Value : string);
|
|
begin
|
|
ValidateListBox;
|
|
taListBox.Items.Add(Value);
|
|
end;
|
|
|
|
procedure TOvcCalcTape.DeleteFirst;
|
|
begin
|
|
ValidateListBox;
|
|
with taListBox, Items do
|
|
if Strings[0] = '' then
|
|
taListBox.Items.Delete(0)
|
|
else
|
|
Inc(taMaxTapeCount);
|
|
end;
|
|
|
|
procedure TOvcCalcTape.SetFont(const Value : TFont);
|
|
begin
|
|
taFont.Assign(Value);
|
|
taFont.OnChange(Self);
|
|
end;
|
|
|
|
function TOvcCalcTape.GetFont : TFont;
|
|
begin
|
|
Result := taFont;
|
|
end;
|
|
|
|
procedure TOvcCalcTape.SetHeight(const Value : Integer);
|
|
begin
|
|
taHeight := Value;
|
|
if Visible then begin
|
|
ValidateListBox;
|
|
taListBox.Height := Value;
|
|
end;
|
|
end;
|
|
|
|
function TOvcCalcTape.GetHeight : Integer;
|
|
begin
|
|
if Visible then begin
|
|
ValidateListBox;
|
|
Result := taListBox.Height;
|
|
end else
|
|
Result := taHeight;
|
|
end;
|
|
|
|
function TOvcCalcTape.GetTape : TStrings;
|
|
begin
|
|
ValidateListBox;
|
|
Result := taListBox.Items;
|
|
end;
|
|
|
|
procedure TOvcCalcTape.SetTape(const Value : TStrings);
|
|
begin
|
|
ValidateListBox;
|
|
taListBox.Items.Assign(Value);
|
|
end;
|
|
|
|
function TOvcCalcTape.GetTapeColor : TColor;
|
|
begin
|
|
if Visible then begin
|
|
ValidateListBox;
|
|
Result := taListBox.Color;
|
|
end else
|
|
Result := taTapeColor;
|
|
end;
|
|
|
|
procedure TOvcCalcTape.SetTapeColor(const Value : TColor);
|
|
begin
|
|
taTapeColor := Value;
|
|
if Visible then begin
|
|
ValidateListBox;
|
|
taListBox.Color := Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcCalcTape.SetTop(const Value : Integer);
|
|
begin
|
|
ValidateListBox;
|
|
taListBox.Top := Value;
|
|
end;
|
|
|
|
function TOvcCalcTape.GetTop : Integer;
|
|
begin
|
|
ValidateListBox;
|
|
Result := taListBox.Top;
|
|
end;
|
|
|
|
function TOvcCalcTape.GetVisible : Boolean;
|
|
begin
|
|
Result := FVisible;
|
|
end;
|
|
|
|
procedure TOvcCalcTape.SetVisible(const Value : Boolean);
|
|
begin
|
|
FVisible := Value;
|
|
if Assigned(taListBox) then begin
|
|
if not Value and taListBox.Visible then begin
|
|
if csDesigning in taListBox.Owner.ComponentState then begin
|
|
{$IFDEF VERSION4}
|
|
taListBox.Visible := Value;
|
|
taListBox.Height := 0;
|
|
{$ELSE}
|
|
taListBox.Free;
|
|
taListBox := nil;
|
|
{$ENDIF}
|
|
end else
|
|
taListBox.Visible := Value;
|
|
end else if Value and not taListBox.Visible then begin
|
|
taListBox.Visible := Value;
|
|
{$IFDEF VERSION4}
|
|
taListBox.Height := taHeight;
|
|
{$ENDIF}
|
|
end;
|
|
end else if Value then begin
|
|
ValidateListBox;
|
|
taListBox.Visible := Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcCalcTape.SetWidth(const Value : Integer);
|
|
begin
|
|
taWidth := Value;
|
|
if Visible then begin
|
|
ValidateListBox;
|
|
taListBox.Width := Value;
|
|
end;
|
|
end;
|
|
|
|
function TOvcCalcTape.GetWidth : Integer;
|
|
begin
|
|
if Visible then begin
|
|
ValidateListBox;
|
|
Result := taListBox.Width;
|
|
end else
|
|
Result := taWidth;
|
|
end;
|
|
|
|
procedure TOvcCalcTape.SetTopIndex(const Value : Integer);
|
|
begin
|
|
ValidateListBox;
|
|
taListBox.TopIndex := Value;
|
|
end;
|
|
|
|
function TOvcCalcTape.GetTopIndex : Integer;
|
|
begin
|
|
ValidateListBox;
|
|
Result := taListBox.TopIndex;
|
|
end;
|
|
|
|
procedure TOvcCalcTape.SetBounds(const ALeft, ATop, AWidth, AHeight : Integer);
|
|
begin
|
|
ValidateListBox;
|
|
taListBox.SetBounds(ALeft, ATop, AWidth, AHeight);
|
|
end;
|
|
|
|
procedure TOvcCalcTape.InitializeTape;
|
|
begin
|
|
if not Assigned(taListBox) then
|
|
Exit;
|
|
if csDesigning in taListBox.Owner.ComponentState then
|
|
if not taListBox.HandleAllocated then
|
|
Exit;
|
|
if taTapeInitialized then
|
|
Exit;
|
|
ClearTape;
|
|
taTapeInitialized := True;
|
|
end;
|
|
|
|
procedure TOvcCalcTape.taOnClick(Sender : TObject);
|
|
begin
|
|
ValidateListBox;
|
|
(taListBox.Owner as TOvcCustomCalculator).SetFocus;
|
|
end;
|
|
|
|
procedure TOvcCalcTape.taOnDblClick(Sender : TObject);
|
|
var
|
|
Str : string;
|
|
begin
|
|
ValidateListBox;
|
|
if (taListBox.Items.Count < 1) then
|
|
Exit;
|
|
Str := taListBox.Items.Strings[taListBox.ItemIndex];
|
|
try
|
|
if (Str[1] = '0') and
|
|
(Str[2] <> '.') then
|
|
Exit;
|
|
if taListBox.Items.Strings[taListBox.ItemIndex] <> '' then begin
|
|
(taListBox.Owner as TOvcCustomCalculator).DisplayValue :=
|
|
StrToFloat(Copy(Str,1, Length(Str) - taOperandSize));
|
|
(taListBox.Owner as TOvcCustomCalculator).LastOperand :=
|
|
StrToFloat(Copy(Str,1, Length(Str) - taOperandSize));
|
|
(taListBox.Owner as TOvcCustomCalculator).Operand :=
|
|
StrToFloat(Copy(Str,1, Length(Str) - taOperandSize));
|
|
(taListBox.Owner as TOvcCustomCalculator).DisplayStr :=
|
|
Copy(Str,1, Length(Str) - taOperandSize);
|
|
(taListBox.Owner as TOvcCustomCalculator).SetFocus;
|
|
end;
|
|
except
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcCalcTape.taOnDrawItem(Control: TWinControl; Index: Integer;
|
|
Rect:TRect;State: TOwnerDrawState);
|
|
var
|
|
SaveColor : TColor;
|
|
SaveBack : TColor;
|
|
Str : String;
|
|
I, FirstUsedIndex : Integer;
|
|
begin
|
|
FirstUsedIndex := 0;
|
|
if Index > FMaxPaperCount then
|
|
with (Control as TListBox) do begin
|
|
for I := 0 to Index do begin
|
|
if Items[I] <> '' then begin
|
|
FirstUsedIndex := I;
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
Str := (Control as TListBox).Items[Index];
|
|
with (Control as TListBox).Canvas do begin { draw on control canvas, not on the form }
|
|
FillRect(Rect); { clear the rectangle }
|
|
|
|
SaveColor := (Control as TListBox).Canvas.Font.Color;
|
|
try
|
|
SaveBack := (Control as TListBox).Canvas.Brush.Color;
|
|
try
|
|
if (Trim(Str) <> '') then begin
|
|
if (Trim(Str)[1] = '-') then
|
|
(Control as TListBox).Canvas.Font.Color := clRed;
|
|
if FTapeDisplaySpace > Length(Str) then
|
|
Str := Str + StringOfChar(' ', FTapeDisplaySpace - Length(Str));
|
|
TextOut(Rect.Left, Rect.Top, Copy(Str, 1, Length(Str) - 1));
|
|
if Index - FirstUsedIndex >= FMaxPaperCount then
|
|
(Control as TListBox).Canvas.Brush.Color := clRed;
|
|
TextOut(PenPos.X, PenPos.Y, Copy(Str, Length(Str), 1));
|
|
end;
|
|
finally
|
|
(Control as TListBox).Canvas.Brush.Color := SaveBack;
|
|
end;
|
|
finally
|
|
(Control as TListBox).Canvas.Font.Color := SaveColor;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcCalcTape.taTapeFontChange(Sender : TObject);
|
|
begin
|
|
if Visible then begin
|
|
taListBox.Font.Assign(taFont);
|
|
taListBox.Font.OnChange(Sender);
|
|
end;
|
|
end;
|
|
|
|
function TOvcCalcTape.GetDisplayedItemCount : Integer;
|
|
var
|
|
DC : hDC;
|
|
SaveFont : hFont;
|
|
Size : TSize;
|
|
begin
|
|
if not Assigned(taListBox) then begin
|
|
Result := 0;
|
|
Exit;
|
|
end;
|
|
|
|
DC := GetDC(0);
|
|
SaveFont := SelectObject(DC, taListBox.Font.Handle);
|
|
GetTextExtentPoint(DC, ' 0123456789', 11, Size);
|
|
Result := taListBox.ClientHeight div Size.cy;
|
|
if Result < 3 then
|
|
Result := 3;
|
|
SelectObject(DC, SaveFont);
|
|
ReleaseDC(0, DC);
|
|
end;
|
|
|
|
procedure TOvcCalcTape.AddToTape(const Value : string; const OpString : string);
|
|
{-adds an operand to the tape display}
|
|
var
|
|
TapeString : string;
|
|
DSpace : Integer;
|
|
begin
|
|
DSpace := FTapeDisplaySpace - Length(Value);
|
|
TapeString := StringOfChar(' ', DSpace - taOperandSize);
|
|
TapeString := TapeString + Value + ' ' + OpString;
|
|
Add(TapeString);
|
|
DeleteFirst;
|
|
TopIndex := taMaxTapeCount - GetDisplayedItemCount + 2;
|
|
end;
|
|
|
|
{adds an operand to the tape display}
|
|
procedure TOvcCalcTape.AddToTapeLeft(const Value : string);
|
|
var
|
|
TapeString : string;
|
|
DSpace : Integer;
|
|
begin
|
|
DSpace := FTapeDisplaySpace - Length(Value);
|
|
TapeString := StringOfChar(' ', DSpace);
|
|
TapeString := Value + TapeString;
|
|
Add(Value);
|
|
DeleteFirst;
|
|
TopIndex := taMaxTapeCount - GetDisplayedItemCount + 2;
|
|
end;
|
|
|
|
procedure TOvcCalcTape.ClearTape;
|
|
var
|
|
I : Integer;
|
|
begin
|
|
if not Assigned(taListBox) then
|
|
Exit;
|
|
if csDesigning in taListBox.Owner.ComponentState then
|
|
if not taListBox.HandleAllocated then
|
|
Exit;
|
|
taMaxTapeCount := 30; {set starting line count}
|
|
|
|
taListBox.Items.Clear;
|
|
for I := 0 to taMaxTapeCount - 1 do
|
|
taListBox.Items.Add('');
|
|
taListBox.TopIndex := taMaxTapeCount - GetDisplayedItemCount + 2;
|
|
end;
|
|
|
|
procedure TOvcCalcTape.RefreshDisplays;
|
|
var
|
|
I, Diff : Integer;
|
|
S : string;
|
|
|
|
function AllSame(const Str : string) : Boolean;
|
|
var
|
|
I : Integer;
|
|
begin
|
|
Result := True;
|
|
for I := 2 to Length(Str) do begin
|
|
if Str[1] <> Str[I] then
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if not Assigned(taListBox) then
|
|
Exit;
|
|
if not taListBox.HandleAllocated then
|
|
Exit;
|
|
|
|
if FShowTape then begin
|
|
for I := 0 to taMaxTapeCount - 1 do begin
|
|
S := taListBox.Items.Strings[I];
|
|
if S <> '' then begin
|
|
Diff := FTapeDisplaySpace - Length(S);
|
|
if S[1] = ' ' then begin
|
|
if Diff >= 0 then
|
|
S := StringOfChar(' ', Diff) + S
|
|
else if AllSame(copy(S, 1, -Diff)) then
|
|
S := copy(S,-Diff + 1, Length(S));
|
|
end else begin
|
|
if AllSame(S) and (not (S[1] in ['0'..'9'])) then
|
|
if Diff >= 0 then
|
|
S := S + StringOfChar(S[1], Diff)
|
|
else
|
|
S := copy(S, 1, Length(S)-Diff + 1)
|
|
else if (Diff >= 0) and not ((S[1] <> '0') or (S[2] <> '.')) then
|
|
S := StringOfChar(' ', Diff) + S;
|
|
end;
|
|
taListBox.Items.Strings[I] := S;
|
|
end;
|
|
end;
|
|
taListBox.TopIndex := taMaxTapeCount - GetDisplayedItemCount + 2;
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcCalcTape.SpaceTape(const Value : char);
|
|
var
|
|
TapeString : string;
|
|
begin
|
|
TapeString := StringOfChar(Value, FTapeDisplaySpace);
|
|
Add(TapeString);
|
|
DeleteFirst;
|
|
TopIndex := taMaxTapeCount - GetDisplayedItemCount + 2;
|
|
end;
|
|
|
|
|
|
{*** TOvcCustomCalculatorEngine ***}
|
|
|
|
procedure TOvcCustomCalculatorEngine.ClearAll;
|
|
var
|
|
I : Integer;
|
|
begin
|
|
for I := 0 to 3 do
|
|
cOperands[I] := 0;
|
|
cLastOperation := coNone;
|
|
cOperationCount := 0;
|
|
cState := [csValid, csClear];
|
|
end;
|
|
|
|
procedure TOvcCustomCalculatorEngine.PushOperand(const Value : Extended);
|
|
var
|
|
I : Integer;
|
|
begin
|
|
for I := 2 downto 0 do
|
|
cOperands[I+1] := cOperands[I];
|
|
cOperands[0] := Value;
|
|
end;
|
|
|
|
function TOvcCustomCalculatorEngine.PopOperand : Extended;
|
|
var
|
|
I : Integer;
|
|
begin
|
|
Result := cOperands[0];
|
|
for I := 0 to 2 do
|
|
cOperands[I] := cOperands[I+1];
|
|
cOperands[3] := 0;
|
|
end;
|
|
|
|
function TOvcCustomCalculatorEngine.TopOperand : Extended;
|
|
begin
|
|
Result := cOperands[0];
|
|
end;
|
|
|
|
|
|
{*** TOvcBasicCalculatorEngine ***}
|
|
type
|
|
TOvcBasicCalculatorEngine = class(TOvcCustomCalculatorEngine)
|
|
protected {private}
|
|
{internal methods}
|
|
procedure cEvaluate(const Operation : TOvcCalculatorOperation);
|
|
public
|
|
function AddOperand(const Value : Extended; const Button : TOvcCalculatorOperation) : Boolean;
|
|
override;
|
|
function AddOperation(const Button : TOvcCalculatorOperation) : Boolean;
|
|
override;
|
|
end;
|
|
|
|
function TOvcBasicCalculatorEngine.AddOperand(
|
|
const Value : Extended;
|
|
const Button : TOvcCalculatorOperation) : Boolean;
|
|
var
|
|
I : Integer;
|
|
begin
|
|
Result := False;
|
|
if Button <> coNone then begin
|
|
if csValid in cState then begin
|
|
Result := True;
|
|
for I := 2 downto 0 do
|
|
cOperands[I+1] := cOperands[I];
|
|
cOperands[0] := Value;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcBasicCalculatorEngine.cEvaluate(const Operation : TOvcCalculatorOperation);
|
|
begin
|
|
if csValid in cState then begin
|
|
{evaluate the expression}
|
|
case Operation of
|
|
coAdd : begin
|
|
cOperands[1] := cOperands[1] + cOperands[0];
|
|
PopOperand;
|
|
end;
|
|
coSub : begin
|
|
cOperands[1] := cOperands[1] - cOperands[0];
|
|
PopOperand;
|
|
end;
|
|
coMul : begin
|
|
cOperands[1] := cOperands[1] * cOperands[0];
|
|
PopOperand;
|
|
end;
|
|
coDiv : begin
|
|
cOperands[1] := cOperands[1] / cOperands[0];
|
|
PopOperand;
|
|
end;
|
|
coEqual : ;
|
|
coNone : ;
|
|
coPercent : begin
|
|
if cLastOperation in [coAdd, coSub] then
|
|
cOperands[0] := (cOperands[0] / 100) * cOperands[1] {do markup/down}
|
|
else
|
|
cOperands[0] := cOperands[0] / 100; {as a percentage}
|
|
cState := [csValid, csClear];
|
|
end;
|
|
coMemStore : begin
|
|
cMemory := cOperands[0];
|
|
Include(cState, csClear);
|
|
end;
|
|
coMemRecall : begin
|
|
cOperands[0] := cMemory;
|
|
cState := [csValid, csClear];
|
|
end;
|
|
coMemClear : begin
|
|
cMemory := 0;
|
|
end;
|
|
coMemAdd,
|
|
coMemSub : begin
|
|
try
|
|
if Operation = coMemAdd then
|
|
cMemory := cMemory + cOperands[0]
|
|
else
|
|
cMemory := cMemory - cOperands[0];
|
|
except
|
|
cMemory := 0;
|
|
end;
|
|
Include(cState, csClear);
|
|
end;
|
|
coInvert : begin
|
|
cOperands[0] := 1 / cOperands[0];
|
|
end;
|
|
coSqrt : begin
|
|
cOperands[0] := Sqrt(cOperands[0]);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TOvcBasicCalculatorEngine.AddOperation(const Button : TOvcCalculatorOperation) : Boolean;
|
|
begin
|
|
Result := False;
|
|
if csValid in cState then begin
|
|
{evaluate the expression}
|
|
case Button of
|
|
coAdd : begin
|
|
cEvaluate(cLastOperation);
|
|
cState := [csValid, csClear];
|
|
if cLastOperation in [coAdd, coSub] then
|
|
Inc(cOperationCount)
|
|
else
|
|
cOperationCount := 1;
|
|
cLastOperation := Button;
|
|
Result := True;
|
|
end;
|
|
coSub : begin
|
|
cEvaluate(cLastOperation);
|
|
cState := [csValid, csClear];
|
|
if cLastOperation in [coAdd, coSub] then
|
|
Inc(cOperationCount)
|
|
else
|
|
cOperationCount := 1;
|
|
cLastOperation := Button;
|
|
Result := True;
|
|
end;
|
|
coMul : begin
|
|
cEvaluate(cLastOperation);
|
|
cState := [csValid, csClear];
|
|
if cLastOperation = Button then
|
|
cOperationCount := cOperationCount + 1
|
|
else
|
|
cOperationCount := 1;
|
|
cLastOperation := Button;
|
|
Result := True;
|
|
end;
|
|
coDiv : begin
|
|
cEvaluate(cLastOperation);
|
|
cState := [csValid, csClear];
|
|
if cLastOperation = Button then
|
|
cOperationCount := cOperationCount + 1
|
|
else
|
|
cOperationCount := 1;
|
|
cLastOperation := Button;
|
|
Result := True;
|
|
end;
|
|
coEqual : begin
|
|
Include(cState, csClear);
|
|
if cLastOperation <> coNone then begin
|
|
cEvaluate(cLastOperation);
|
|
cState := [csClear, csValid];
|
|
if cLastOperation = coEqual then
|
|
cLastOperation := coNone
|
|
else
|
|
cLastOperation := Button;
|
|
end;
|
|
Result := True;
|
|
end;
|
|
coNone : Result := True;
|
|
coPercent : begin
|
|
cEvaluate(Button);
|
|
if not ShowSeparatePercent then begin
|
|
cEvaluate(cLastOperation);
|
|
cState := [csValid, csClear];
|
|
if cLastOperation = Button then
|
|
cOperationCount := cOperationCount + 1
|
|
else
|
|
cOperationCount := 0;
|
|
cLastOperation := coEqual;
|
|
Result := True;
|
|
end else begin
|
|
if cLastOperation = Button then
|
|
cOperationCount := cOperationCount + 1
|
|
else
|
|
cOperationCount := 0;
|
|
Result := True;
|
|
end;
|
|
end;
|
|
coMemStore : begin
|
|
cEvaluate(Button);
|
|
end;
|
|
coMemRecall : begin
|
|
cEvaluate(Button);
|
|
Result := True;
|
|
end;
|
|
coMemClear : begin
|
|
cEvaluate(Button);
|
|
end;
|
|
coMemAdd,
|
|
coMemSub : begin
|
|
cEvaluate(Button);
|
|
end;
|
|
coInvert : begin
|
|
cEvaluate(Button);
|
|
Result := True;
|
|
end;
|
|
coSqrt : begin
|
|
cEvaluate(Button);
|
|
Result := True;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
{*** TOvcCalcPanel ***}
|
|
|
|
procedure TOvcCalcPanel.Click;
|
|
begin
|
|
(Owner as TOvcCustomCalculator).SetFocus;
|
|
end;
|
|
|
|
|
|
{*** TOvcCustomCalculator ***}
|
|
|
|
procedure TOvcCustomCalculator.cAdjustHeight;
|
|
var
|
|
DC : hDC;
|
|
SaveFont : hFont;
|
|
I : Integer;
|
|
SysMetrics : TTextMetric;
|
|
Metrics : TTextMetric;
|
|
begin
|
|
DC := GetDC(0);
|
|
GetTextMetrics(DC, SysMetrics);
|
|
SaveFont := SelectObject(DC, Font.Handle);
|
|
GetTextMetrics(DC, Metrics);
|
|
SelectObject(DC, SaveFont);
|
|
ReleaseDC(0, DC);
|
|
if NewStyleControls then begin
|
|
if Ctl3D then
|
|
I := 8
|
|
else
|
|
I := 6;
|
|
I := GetSystemMetrics(SM_CYBORDER) * I;
|
|
end else begin
|
|
I := SysMetrics.tmHeight;
|
|
if I > Metrics.tmHeight then
|
|
I := Metrics.tmHeight;
|
|
I := I div 4 + GetSystemMetrics(SM_CYBORDER) * 4;
|
|
end;
|
|
cPanel.Height := Metrics.tmHeight + I;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.cCalculateLook;
|
|
var
|
|
CW : Integer; {client width}
|
|
BW : Integer; {button width}
|
|
BH : Integer; {button height}
|
|
LBW : Integer; {large button width}
|
|
M1 : Integer; {margin between buttons}
|
|
M2 : Integer; {left and right edge margins}
|
|
M3 : Integer; {margin between panel and frst row of buttons}
|
|
M4 : Integer; {margin between memory buttons and other buttons}
|
|
TM : Integer; {area where the panel is placed}
|
|
X : Integer;
|
|
Y : Integer;
|
|
PW : Integer; {panel width}
|
|
B : TOvcCalculatorButton;
|
|
begin
|
|
if not HandleAllocated then
|
|
Exit;
|
|
|
|
{set panel height based on font}
|
|
cAdjustHeight;
|
|
|
|
for B := Low(cButtons) to High(cButtons) do
|
|
cButtons[B].Visible := True;
|
|
|
|
CW := ClientWidth;
|
|
|
|
if Width <= 200 then begin
|
|
M1 := 2;
|
|
M2 := 4;
|
|
end else begin
|
|
M1 := 4;
|
|
M2 := 6;
|
|
end;
|
|
{save left/right/top/bottom margin value}
|
|
cMargin := M2;
|
|
|
|
M4 := M2;
|
|
if coShowMemoryButtons in FOptions then begin
|
|
BW := (CW - 3*M2 - 4*M1) div 6;
|
|
M4 := CW - 2*M2 - 6*BW - 4*M1;
|
|
end else begin
|
|
BW := (CW - 2*M2 - 4*M1) div 5;
|
|
if (CW - 2*M2 - 4*M1) div 6 >= 4 then
|
|
Inc(M2, 2)
|
|
else if (CW - 2*M2 - 4*M1) div 6 >= 2 then
|
|
Inc(M2, 1);
|
|
end;
|
|
|
|
{button height, using an estimate for TM}
|
|
TM := M2 + M2 + cPanel.Height;
|
|
|
|
if coShowTape in FOptions then
|
|
TM := TM + M2 + cTape.Height;
|
|
|
|
BH := (ClientHeight - TM - M2 - 4*M1) div 5;
|
|
|
|
{calculate actual area below panel}
|
|
M3 := ClientHeight - M2 - cPanel.Height - 5*BH - 4*M1 - M2;
|
|
|
|
{calculate actual height of area above buttons}
|
|
TM := M2 + M3 + cPanel.Height;
|
|
|
|
{large button width}
|
|
if coShowClearTapeButton in FOptions then
|
|
LBW := (5*BW + 3*M1 - 2*M1) div 4
|
|
else
|
|
LBW := (4*BW + 3*M1 - 2*M1) div 3;
|
|
|
|
{calculate the width of the edit window}
|
|
cMargin := M2;
|
|
if coShowMemoryButtons in FOptions then
|
|
PW := 6*BW + M4 + 4*M1
|
|
else
|
|
PW := 5*BW + 4*M1;
|
|
|
|
if coShowTape in FOptions then
|
|
PW := PW - cScrBarWidth;
|
|
|
|
|
|
{position tape display and edit panel}
|
|
if coShowTape in FOptions then begin
|
|
cTape.Visible := True;
|
|
cTape.SetBounds(cMargin, cMargin, PW + cScrBarWidth, cTape.Height);
|
|
cPanel.SetBounds(cMargin + 2, cTape.Height + M2 +
|
|
cMargin, PW, cPanel.Height);
|
|
end else begin
|
|
cTape.Visible := False;
|
|
cPanel.SetBounds(cMargin, cMargin, PW, cPanel.Height);
|
|
end;
|
|
|
|
{calculate # of characters required to fill display space}
|
|
{"FontWidth div 2" makes sure there is no cut off charaters}
|
|
if coShowTape in FOptions then
|
|
cTape.TapeDisplaySpace := (cTape.Width - cScrBarWidth - (cGetFontWidth div 2))
|
|
div cGetFontWidth
|
|
else
|
|
cTape.TapeDisplaySpace := (cPanel.Width - (cGetFontWidth div 2)) div cGetFontWidth;
|
|
|
|
cTape.InitializeTape;
|
|
|
|
{redraw the edit panel and Tape}
|
|
cRefreshDisplays;
|
|
|
|
{memory column}
|
|
if coShowMemoryButtons in FOptions then begin
|
|
X := M2;
|
|
Y := TM;
|
|
cButtons[cbMemClear].Position := Rect(X, Y, X+BW, Y+BH);
|
|
cButtons[cbMemClear].Caption := GetOrphStr(SCCalcMC);
|
|
|
|
Y := TM + BH + M1;
|
|
cButtons[cbMemRecall].Position := Rect(X, Y, X+BW, Y+BH);
|
|
cButtons[cbMemRecall].Caption := GetOrphStr(SCCalcMR);
|
|
|
|
Y := TM + 2*BH + 2*M1;
|
|
cButtons[cbMemStore].Position := Rect(X, Y, X+BW, Y+BH);
|
|
cButtons[cbMemStore].Caption := GetOrphStr(SCCalcMS);
|
|
|
|
Y := TM + 3*BH + 3*M1;
|
|
cButtons[cbMemAdd].Position := Rect(X, Y, X+BW, Y+BH);
|
|
cButtons[cbMemAdd].Caption := GetOrphStr(SCCalcMPlus);
|
|
|
|
Y := TM + 4*BH + 4*M1;
|
|
cButtons[cbMemSub].Position := Rect(X, Y, X+BW, Y+BH);
|
|
cButtons[cbMemSub].Caption := GetOrphStr(SCCalcMMinus);
|
|
end else
|
|
for B := cbMemClear to cbMemSub do
|
|
cButtons[B].Visible := False;
|
|
|
|
{row 1 - large buttons}
|
|
Y := TM;
|
|
if coShowMemoryButtons in FOptions then
|
|
if coShowClearTapeButton in FOptions then
|
|
X := BW + M2 + M4
|
|
else
|
|
X := 2*BW + M4 + M2 + M1
|
|
else
|
|
if coShowClearTapeButton in FOptions then
|
|
X := M2
|
|
else
|
|
X := BW + M2 + M1;
|
|
|
|
cButtons[cbTape].Position := Rect(X, Y, X+LBW, Y+BH);
|
|
cButtons[cbTape].Caption := GetOrphStr(SCCalcCT);
|
|
|
|
if coShowClearTapeButton in FOptions then begin
|
|
cButtons[cbTape].Visible := True;
|
|
Inc(X, LBW+M1);
|
|
if ((BW+M1)*5 - (LBW+M1)*4) >= 3 then
|
|
Inc(X, 1);
|
|
end else begin
|
|
cButtons[cbTape].Visible := False;
|
|
end;
|
|
|
|
cButtons[cbBack].Position := Rect(X, Y, X+LBW, Y+BH);
|
|
cButtons[cbBack].Caption := GetOrphStr(SCCalcBack);
|
|
|
|
Inc(X, LBW+M1);
|
|
if coShowClearTapeButton in FOptions then begin
|
|
if ((BW+M1)*5 - (LBW+M1)*4) >= 2 then
|
|
Inc(X, 1);
|
|
end else begin
|
|
if ((BW+M1)*4 - (LBW+M1)*3) >= 2 then
|
|
Inc(X, 1);
|
|
end;
|
|
cButtons[cbClearEntry].Position := Rect(X, Y, X+LBW, Y+BH);
|
|
cButtons[cbClearEntry].Caption := GetOrphStr(SCCalcCE);
|
|
|
|
Inc(X, LBW+M1);
|
|
if coShowClearTapeButton in FOptions then begin
|
|
if ((BW+M1)*5 - (LBW+M1)*4) >= 1 then
|
|
Inc(X, 1);
|
|
end else begin
|
|
if ((BW+M1)*4 - (LBW+M1)*3) >= 1 then
|
|
Inc(X, 1);
|
|
end;
|
|
cButtons[cbClear].Position := Rect(X, Y, X+LBW, Y+BH);
|
|
cButtons[cbClear].Caption := GetOrphStr(SCCalcC);
|
|
|
|
{row 2}
|
|
Y := TM + BH + M1;
|
|
if coShowMemoryButtons in FOptions then
|
|
X := M2 + BW + M4
|
|
else
|
|
X := M2;
|
|
cButtons[cb7].Position := Rect(X, Y, X+BW, Y+BH);
|
|
cButtons[cb7].Caption := '7';
|
|
|
|
Inc(X, BW+M1);
|
|
cButtons[cb8].Position := Rect(X, Y, X+BW, Y+BH);
|
|
cButtons[cb8].Caption := '8';
|
|
|
|
Inc(X, BW+M1);
|
|
cButtons[cb9].Position := Rect(X, Y, X+BW, Y+BH);
|
|
cButtons[cb9].Caption := '9';
|
|
|
|
Inc(X, BW+M1);
|
|
cButtons[cbDiv].Position := Rect(X, Y, X+BW, Y+BH);
|
|
cButtons[cbDiv].Caption := '/';
|
|
|
|
Inc(X, BW+M1);
|
|
cButtons[cbSqrt].Position := Rect(X, Y, X+BW, Y+BH);
|
|
cButtons[cbSqrt].Caption := GetOrphStr(SCCalcSqrt);
|
|
|
|
{row 3}
|
|
Y := TM + 2*BH + 2*M1;
|
|
if coShowMemoryButtons in FOptions then
|
|
X := M2 + BW + M4
|
|
else
|
|
X := M2;
|
|
cButtons[cb4].Position := Rect(X, Y, X+BW, Y+BH);
|
|
cButtons[cb4].Caption := '4';
|
|
|
|
Inc(X, BW+M1);
|
|
cButtons[cb5].Position := Rect(X, Y, X+BW, Y+BH);
|
|
cButtons[cb5].Caption := '5';
|
|
|
|
Inc(X, BW+M1);
|
|
cButtons[cb6].Position := Rect(X, Y, X+BW, Y+BH);
|
|
cButtons[cb6].Caption := '6';
|
|
|
|
Inc(X, BW+M1);
|
|
cButtons[cbMul].Position := Rect(X, Y, X+BW, Y+BH);
|
|
cButtons[cbMul].Caption := '*';
|
|
|
|
Inc(X, BW+M1);
|
|
cButtons[cbPercent].Position := Rect(X, Y, X+BW, Y+BH);
|
|
cButtons[cbPercent].Caption := '%';
|
|
|
|
{row 4}
|
|
Y := TM + 3*BH + 3*M1;
|
|
if coShowMemoryButtons in FOptions then
|
|
X := M2 + BW + M4
|
|
else
|
|
X := M2;
|
|
cButtons[cb1].Position := Rect(X, Y, X+BW, Y+BH);
|
|
cButtons[cb1].Caption := '1';
|
|
|
|
Inc(X, BW+M1);
|
|
cButtons[cb2].Position := Rect(X, Y, X+BW, Y+BH);
|
|
cButtons[cb2].Caption := '2';
|
|
|
|
Inc(X, BW+M1);
|
|
cButtons[cb3].Position := Rect(X, Y, X+BW, Y+BH);
|
|
cButtons[cb3].Caption := '3';
|
|
|
|
Inc(X, BW+M1);
|
|
cButtons[cbSub].Position := Rect(X, Y, X+BW, Y+BH);
|
|
cButtons[cbSub].Caption := '-';
|
|
|
|
Inc(X, BW+M1);
|
|
cButtons[cbInvert].Position := Rect(X, Y, X+BW, Y+BH);
|
|
cButtons[cbInvert].Caption := '1/x';
|
|
|
|
{row 5}
|
|
Y := TM + 4*BH + 4*M1;
|
|
if coShowMemoryButtons in FOptions then
|
|
X := M2 + BW + M4
|
|
else
|
|
X := M2;
|
|
cButtons[cb0].Position := Rect(X, Y, X+BW, Y+BH);
|
|
cButtons[cb0].Caption := '0';
|
|
|
|
Inc(X, BW+M1);
|
|
cButtons[cbChangeSign].Position := Rect(X, Y, X+BW, Y+BH);
|
|
cButtons[cbChangeSign].Caption := '+/-';
|
|
|
|
Inc(X, BW+M1);
|
|
cButtons[cbDecimal].Position := Rect(X, Y, X+BW, Y+BH);
|
|
cButtons[cbDecimal].Caption := DecimalSeparator;
|
|
|
|
Inc(X, BW+M1);
|
|
cButtons[cbAdd].Position := Rect(X, Y, X+BW, Y+BH);
|
|
cButtons[cbAdd].Caption := '+';
|
|
|
|
Inc(X, BW+M1);
|
|
cButtons[cbEqual].Position := Rect(X, Y, X+BW, Y+BH);
|
|
cButtons[cbEqual].Caption := '=';
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.cClearAll;
|
|
begin
|
|
if not HandleAllocated then
|
|
Exit;
|
|
|
|
cEngine.ClearAll;
|
|
FLastOperand := 0;
|
|
DisplayValue := 0;
|
|
FDisplayStr := '0';
|
|
cMinus0 := False;
|
|
cTape.InitializeTape;
|
|
cPanel.Caption := StringOfChar(' ',
|
|
(cTape.TapeDisplaySpace
|
|
- Length('0')
|
|
- Length(CalcDisplayString[cbNone]))
|
|
) + '0' + ' ';
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.cColorChange(Sender : TObject);
|
|
begin
|
|
{update panel background color}
|
|
if Assigned(cPanel) then begin
|
|
cPanel.Color := FColors.Display;
|
|
cPanel.Font.Color := FColors.DisplayTextColor;
|
|
{update the main font color}
|
|
if not (csLoading in ComponentState) and (Font <> nil) then
|
|
Font.Color := FColors.DisplayTextColor;
|
|
end;
|
|
|
|
if Assigned(cTape) then begin
|
|
cTape.TapeColor := FColors.Display;
|
|
end;
|
|
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.cDisplayError;
|
|
begin
|
|
cSetDisplayString('****** ');
|
|
cEngine.State := [csLocked]; {user will have to clear this}
|
|
MessageBeep(0);
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.cDrawCalcButton(const Button : TOvcButtonInfo; const Pressed : Boolean);
|
|
var
|
|
TR : TRect;
|
|
Buf : array[0..255] of Char;
|
|
begin
|
|
if Button.Visible then begin
|
|
TR := DrawButtonFace(Canvas, Button.Position, 1, bsNew, False, Pressed, False);
|
|
StrPLCopy(Buf, Button.Caption, 255);
|
|
DrawText(Canvas.Handle, Buf, StrLen(Buf), TR,
|
|
DT_CENTER or DT_VCENTER or DT_SINGLELINE);
|
|
|
|
if Focused and (Button.Caption = '=') then
|
|
cDrawFocusState;
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.cDrawFocusState;
|
|
var
|
|
R : TRect;
|
|
begin
|
|
R := cButtons[cbEqual].Position;
|
|
InflateRect(R, -3, -3);
|
|
{$IFNDEF LCL}
|
|
Canvas.DrawFocusRect(R);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.cDrawSizeLine;
|
|
var
|
|
OldPen : TPen;
|
|
begin
|
|
if (cSizing) then
|
|
with Canvas do begin
|
|
OldPen := TPen.Create;
|
|
try
|
|
OldPen.Assign(Pen);
|
|
Pen.Color := clBlack;
|
|
Pen.Mode := pmXor;
|
|
Pen.Style := psDot;
|
|
Pen.Width := 1;
|
|
MoveTo(0, cSizeOffset);
|
|
LineTo(ClientWidth, cSizeOffset);
|
|
finally
|
|
Canvas.Pen := OldPen;
|
|
OldPen.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.cEvaluate(const Button : TOvcCalculatorButton);
|
|
begin
|
|
if csValid in cEngine.State then begin
|
|
try
|
|
{evaluate the expression}
|
|
if cEngine.AddOperation(CalcButtontoOperation[Button]) then begin
|
|
DisplayValue := cEngine.TopOperand;
|
|
if Button in [cbAdd, cbSub, cbMul, cbDiv, cbEqual, cbPercent, cbNone] then
|
|
if (Button in [cbAdd, cbSub, cbMul, cbDiv]) and (cLastButton = Button) then
|
|
cTape.AddToTape(cFormatString(LastOperand), CalcDisplayString[Button])
|
|
else
|
|
cTape.AddToTape(FDisplayStr, CalcDisplayString[Button]);
|
|
if (Button = cbEqual) and (cEngine.LastOperation = coEqual) then begin
|
|
if coShowItemCount in FOptions then
|
|
cTape.AddToTapeLeft(Format('%3.3d',[cEngine.OperationCount+1]));
|
|
cTape.AddToTape(cFormatString(DisplayValue), CalcDisplayString[cbSubTotal]);
|
|
cTape.SpaceTape(TapeSeparatorChar);
|
|
end;
|
|
FDisplayStr := cFormatString(DisplayValue);
|
|
end;
|
|
except
|
|
cDisplayError;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TOvcCustomCalculator.cFormatString(const Value : Extended) : string;
|
|
begin
|
|
if cEngine.Decimals = 0 then
|
|
Result := Format('%g',[Value])
|
|
else if cEngine.Decimals < 0 then
|
|
Result := Format('%.*f',[-cEngine.Decimals, Value])
|
|
else
|
|
Result := Format('%.*f',[cEngine.Decimals, Value]);
|
|
end;
|
|
|
|
function TOvcCustomCalculator.cGetFontWidth : Integer;
|
|
var
|
|
DC : hDC;
|
|
SaveFont : hFont;
|
|
Size : TSize;
|
|
begin
|
|
if not assigned(cPanel) then begin
|
|
Result := 8; {Return something resonable }
|
|
Exit;
|
|
end;
|
|
DC := GetDC(0);
|
|
SaveFont := SelectObject(DC, cPanel.Font.Handle);
|
|
GetTextExtentPoint(DC, ' 0123456789', 11, Size);
|
|
Result := Round(Size.cx/11);
|
|
SelectObject(DC, SaveFont);
|
|
ReleaseDC(0, DC);
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.cInvalidateIndicator;
|
|
begin
|
|
InvalidateRect(Handle, @cButtons[cbMemRecall].Position, False);
|
|
InvalidateRect(Handle, @cButtons[cbMemClear].Position, False);
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.cRefreshDisplays;
|
|
begin
|
|
if not cPanel.HandleAllocated then
|
|
Exit;
|
|
|
|
cTape.RefreshDisplays;
|
|
{ DisplayValue := DisplayValue; }
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.cSetDisplayString(const Value : string);
|
|
var
|
|
DSpace : Integer;
|
|
begin
|
|
try
|
|
if cPanel.HandleAllocated then begin
|
|
DSpace := cTape.TapeDisplaySpace
|
|
- Length(Value)
|
|
- Length(CalcDisplayString[cbNone]);
|
|
cPanel.Caption := StringOfChar(' ', DSpace) + Value + ' ';
|
|
end;
|
|
except
|
|
cDisplayError;
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.cTapeFontChange(Sender : TObject);
|
|
begin
|
|
cPanel.Font := TapeFont;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.SetBorderStyle(const Value : TBorderStyle);
|
|
begin
|
|
if Value <> FBorderStyle then begin
|
|
FBorderStyle := Value;
|
|
{$IFNDEF LCL}
|
|
RecreateWnd;
|
|
{$ELSE}
|
|
RecreateWnd(Self);
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
function TOvcCustomCalculator.GetDecimals : Integer;
|
|
begin
|
|
Result := cEngine.Decimals;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.SetDecimals(const Value : Integer);
|
|
begin
|
|
if Value <> cEngine.Decimals then begin
|
|
cEngine.Decimals := Value;
|
|
ccalculateLook;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
function TOvcCustomCalculator.GetMemory : Extended;
|
|
begin
|
|
Result := cEngine.Memory;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.SetMemory(const Value : Extended);
|
|
begin
|
|
if Value <> cEngine.Memory then begin
|
|
cEngine.Memory := Value;
|
|
cCalculateLook;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.SetMaxPaperCount(const Value : Integer);
|
|
begin
|
|
if Value <> cTape.MaxPaperCount then begin
|
|
cTape.MaxPaperCount := Value;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
function TOvcCustomCalculator.GetMaxPaperCount : Integer;
|
|
begin
|
|
Result := cTape.MaxPaperCount;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.SetOptions(const Value : TOvcCalculatorOptions);
|
|
begin
|
|
if Value <> FOptions then begin
|
|
FOptions := Value;
|
|
|
|
|
|
cTape.ShowTape := coShowTape in FOptions;
|
|
cTape.Visible := coShowTape in FOptions;
|
|
cEngine.ShowSeparatePercent := coShowSeparatePercent in FOptions;
|
|
|
|
cCalculateLook;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
function TOvcCustomCalculator.GetTape : TStrings;
|
|
begin
|
|
Result := cTape.Tape;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.SetTape(const Value : TStrings);
|
|
begin
|
|
cTape.Tape := Value;
|
|
end;
|
|
|
|
function TOvcCustomCalculator.GetTapeFont : TFont;
|
|
begin
|
|
Result := cTape.Font;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.SetTapeFont(const Value : TFont);
|
|
begin
|
|
cTape.Font := Value;
|
|
end;
|
|
|
|
function TOvcCustomCalculator.GetTapeHeight : Integer;
|
|
begin
|
|
Result := cTape.Height;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.SetTapeHeight(const Value : Integer);
|
|
begin
|
|
cTape.Height := Value;
|
|
cCalculateLook;
|
|
Invalidate;
|
|
end;
|
|
|
|
function TOvcCustomCalculator.GetVisible : Boolean;
|
|
begin
|
|
Result := inherited Visible;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.SetVisible(const Value : Boolean);
|
|
begin
|
|
inherited Visible := Value;
|
|
|
|
cTape.Visible := cTape.ShowTape;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.SetDisplay(const Value : Extended);
|
|
var
|
|
ValueString : string;
|
|
begin
|
|
try
|
|
FDisplay := Value;
|
|
if cPanel.HandleAllocated then begin
|
|
ValueString := cFormatString(Value);
|
|
cSetDisplayString(ValueString);
|
|
end;
|
|
except
|
|
cDisplayError;
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.SetDisplayStr(const Value : string);
|
|
begin
|
|
FDisplayStr := Value;
|
|
while (Length(FDisplayStr) > 0) and (FDisplayStr[1] = ' ') do
|
|
FDisplayStr := Copy(FDisplayStr, 2, Length(FDisplayStr) - 1);
|
|
end;
|
|
|
|
function TOvcCustomCalculator.GetOperand : Extended;
|
|
begin
|
|
Result := cEngine.TopOperand;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.SetOperand(const Value : Extended);
|
|
begin
|
|
if Value = cEngine.TopOperand then
|
|
Exit;
|
|
cEngine.PushOperand(Value);
|
|
end;
|
|
|
|
{$IFNDEF LCL}
|
|
procedure TOvcCustomCalculator.CMCtl3DChanged(var Msg : TMessage);
|
|
begin
|
|
inherited;
|
|
|
|
if (csLoading in ComponentState) or not HandleAllocated then
|
|
Exit;
|
|
|
|
if NewStyleControls and (FBorderStyle = bsSingle) then
|
|
{$IFNDEF LCL}
|
|
RecreateWnd;
|
|
{$ENDIF}
|
|
|
|
Invalidate;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TOvcCustomCalculator.CMDesignHitTest(var Msg : TCMDesignHitTest);
|
|
begin
|
|
Msg.Result := LongInt(cOverBar);
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.CMEnter(var Msg : TMessage);
|
|
var
|
|
R : TRect;
|
|
begin
|
|
inherited;
|
|
|
|
{invalidate the "=" button to ensure that the focus rect is painted}
|
|
R := cButtons[cbEqual].Position;
|
|
InvalidateRect(Handle, @R, False);
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.CMExit(var Msg : TMessage);
|
|
var
|
|
R : TRect;
|
|
begin
|
|
inherited;
|
|
|
|
{invalidate the "=" button to ensure that the focus rect is painted}
|
|
R := cButtons[cbEqual].Position;
|
|
InvalidateRect(Handle, @R, False);
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.CMFontChanged(var Msg : TMessage);
|
|
begin
|
|
inherited;
|
|
|
|
if not (csLoading in ComponentState) and Assigned(cPanel) then begin
|
|
cPanel.Color := FColors.Display;
|
|
cPanel.Font.Color := FColors.DisplayTextColor;
|
|
FColors.FCalcColors[2] := Font.Color;
|
|
end;
|
|
|
|
cCalculateLook;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.WMEraseBkgnd(var Msg : TWMEraseBkgnd);
|
|
begin
|
|
Msg.Result := 1; {don't erase background, just say we did}
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.WMGetText(var Msg : TWMGetText);
|
|
begin
|
|
if not cPanel.HandleAllocated then
|
|
Exit;
|
|
|
|
Msg.Result := SendMessage(cPanel.Handle, WM_GETTEXT,
|
|
TMessage(Msg).wParam, TMessage(Msg).lParam);
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.WMGetTextLength(var Msg : TWMGetTextLength);
|
|
begin
|
|
if not cPanel.HandleAllocated then
|
|
Exit;
|
|
|
|
Msg.Result := SendMessage(cPanel.Handle, WM_GETTEXTLENGTH,
|
|
TMessage(Msg).wParam, TMessage(Msg).lParam);
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.WMKeyDown(var Msg : TWMKeyDown);
|
|
begin
|
|
if Msg.CharCode = Ord('M') then begin
|
|
if ({$IFNDEF LCL} GetAsyncKeyState(VK_CONTROL) {$ELSE} GetKeyState(VK_CONTROL) {$ENDIF} and $8000) <> 0 then begin
|
|
PressButton(cbMemStore);
|
|
end;
|
|
end else if Msg.CharCode = VK_RETURN then
|
|
PressButton(cbEqual);
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.WMSetText(var Msg : TWMSetText);
|
|
var
|
|
I : Integer;
|
|
C : AnsiChar;
|
|
begin
|
|
cClearAll;
|
|
for I := 0 to Pred(StrLen(Msg.Text)) do begin
|
|
C := Msg.Text[I];
|
|
KeyPress(C);
|
|
end;
|
|
Msg.Result := 1{true};
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.WMNCHitTest(var Msg : TWMNCHitTest);
|
|
begin
|
|
inherited;
|
|
|
|
cHitTest.X := Msg.Pos.X;
|
|
cHitTest.Y := Msg.Pos.Y;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.WMSetCursor(var Msg : TWMSetCursor);
|
|
var
|
|
vHitTest : TPoint;
|
|
|
|
procedure SetNewCursor(C : HCursor);
|
|
begin
|
|
{$IFNDEF LCL}
|
|
SetCursor(C);
|
|
{$ELSE}
|
|
LclIntf.SetCursor(C); {Don't call control's SetCursor!}
|
|
{$ENDIF}
|
|
Msg.Result := Ord(True);
|
|
end;
|
|
|
|
begin
|
|
if not (coShowTape in FOptions) then
|
|
Exit;
|
|
|
|
if csDesigning in ComponentState then begin
|
|
if (Msg.HitTest = HTCLIENT) then begin
|
|
cOverBar := False;
|
|
vHitTest := ScreenToClient(cHitTest);
|
|
if vHitTest.Y > cTape.Top + cTape.Height then
|
|
if vHitTest.Y < cTape.Top + cTape.Height+4 then
|
|
cOverBar := True;
|
|
end;
|
|
|
|
{set appropriate cursor}
|
|
if cOverBar then
|
|
SetNewCursor(cTabCursor)
|
|
else
|
|
inherited;
|
|
end else
|
|
inherited;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.WMCancelMode(var Msg : TMessage);
|
|
begin
|
|
inherited;
|
|
|
|
cSizing := False;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.WMKillFocus(var Msg : TWMKillFocus);
|
|
begin
|
|
inherited;
|
|
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.WMLButtonDown(var Msg : TWMMouse);
|
|
begin
|
|
inherited;
|
|
|
|
{are we currently showing a sizing cursor? if so the user wants to
|
|
resize a column/row}
|
|
if (cOverBar) then begin
|
|
cSizeOffset := Msg.YPos;
|
|
cSizing := True;
|
|
cDrawSizeLine;
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.WMLButtonUp(var Msg : TWMMouse);
|
|
var
|
|
Form : TForm;
|
|
begin
|
|
inherited;
|
|
|
|
if (cSizing) then begin
|
|
cDrawSizeLine;
|
|
cSizing := False;
|
|
cTape.Height := cSizeOffset - 8;
|
|
cCalculateLook;
|
|
|
|
Refresh;
|
|
if (csDesigning in ComponentState) then begin
|
|
Form := TForm(GetParentForm(Self));
|
|
if (Form <> nil) and (Form.Designer <> nil) then
|
|
Form.Designer.Modified;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.WMMouseMove(var Msg : TWMMouse);
|
|
begin
|
|
inherited;
|
|
|
|
if (cSizing) then begin
|
|
cDrawSizeLine;
|
|
if Msg.YPos >= calcDefMinSize + cTape.Top then
|
|
if Msg.YPos <= Height - calcDefMinSize then
|
|
cSizeOffset := Msg.YPos + 2
|
|
else
|
|
cSizeOffset := Height - calcDefMinSize
|
|
else
|
|
cSizeOffset := calcDefMinSize + cTape.Top;
|
|
cDrawSizeLine;
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.CopyToClipboard;
|
|
begin
|
|
Clipboard.AsText := Text;
|
|
end;
|
|
|
|
constructor TOvcCustomCalculator.Create(AOwner : TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
if cPopup then
|
|
ControlStyle := ControlStyle + [csClickEvents, csFramed] - [csCaptureMouse]
|
|
else
|
|
ControlStyle := ControlStyle + [csClickEvents, csFramed, csCaptureMouse];
|
|
|
|
Color := clBtnFace;
|
|
TabStop := True;
|
|
Width := 200;
|
|
Font.Name := 'MS Sans Serif';
|
|
Font.Size := 8;
|
|
Font.Style := [];
|
|
cDecimalEntered := False;
|
|
cSizing := False;
|
|
cScrBarWidth := 18;
|
|
|
|
{create edit control}
|
|
cPanel := TOvcCalcPanel.Create(Self);
|
|
cPanel.Parent := Self;
|
|
cPanel.ParentFont := False;
|
|
cPanel.Font.Name := 'Courier New';
|
|
cPanel.Font.Size := 10;
|
|
cPanel.Font.Style := [];
|
|
{$IFNDEF LCL}
|
|
cPanel.ParentCtl3D := True;
|
|
{$ENDIF}
|
|
cPanel.Alignment := taLeftJustify;
|
|
cPanel.BevelOuter := bvLowered;
|
|
cPanel.BorderStyle := bsNone;
|
|
cPanel.Color := clWindow;
|
|
cPanel.BevelWidth := 2;
|
|
cPanel.Caption := '0 ';
|
|
|
|
{set property defaults}
|
|
FBorderStyle := bsNone;
|
|
Height := 140;
|
|
FTapeSeparatorChar := '_';
|
|
FOptions := [coShowMemoryButtons, coShowItemCount];
|
|
FColors := TOvcCalcColors.Create;
|
|
FColors.OnChange := cColorChange;
|
|
|
|
{assign default color scheme}
|
|
FColors.FCalcColors := CalcScheme[cscalcWindows];
|
|
|
|
{create tape}
|
|
cTape := TOvcCalcTape.Create(Self, Length(CalcDisplayString[cbNone]));
|
|
cTape.ShowTape := False;
|
|
cTape.TapeColor := clWindow;
|
|
cTape.MaxPaperCount := 9999;
|
|
TapeHeight := Height div 3;
|
|
TapeFont.OnChange := cTapeFontChange;
|
|
TapeFont.Name := 'Courier New';
|
|
TapeFont.Size := 10;
|
|
TapeFont.Style := [];
|
|
cTape.Visible := cTape.ShowTape;
|
|
|
|
cEngine := TOvcBasicCalculatorEngine.Create;
|
|
cEngine.Decimals := 2;
|
|
cEngine.ShowSeparatePercent := False;
|
|
|
|
if csDesigning in ComponentState then
|
|
cTabCursor := Screen.Cursors[crVSplit];
|
|
end;
|
|
|
|
constructor TOvcCustomCalculator.CreateEx(AOwner : TComponent; AsPopup : Boolean);
|
|
begin
|
|
cPopup := AsPopup;
|
|
Create(AOwner);
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.CreateParams(var Params : TCreateParams);
|
|
const
|
|
BorderStyles : array[TBorderStyle] of LongInt = (0, WS_BORDER);
|
|
begin
|
|
inherited CreateParams(Params);
|
|
|
|
with Params do begin
|
|
Style := LongInt(Style) or BorderStyles[FBorderStyle];
|
|
if cPopup then begin
|
|
Style := WS_POPUP or WS_BORDER;
|
|
WindowClass.Style := WindowClass.Style or CS_SAVEBITS;
|
|
end;
|
|
end;
|
|
|
|
if NewStyleControls and (Ctl3D or cPopup) and (FBorderStyle = bsSingle) then begin
|
|
if not cPopup then
|
|
Params.Style := Params.Style and not WS_BORDER;
|
|
Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.CreateWnd;
|
|
begin
|
|
inherited CreateWnd;
|
|
|
|
cCalculateLook;
|
|
cClearAll;
|
|
|
|
cPanel.Color := FColors.Display;
|
|
end;
|
|
|
|
destructor TOvcCustomCalculator.Destroy;
|
|
begin
|
|
cTape.Free;
|
|
cTape := nil;
|
|
|
|
cEngine.Free;
|
|
cEngine := nil;
|
|
|
|
FColors.Free;
|
|
FColors := nil;
|
|
|
|
cTabCursor := 0;
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.KeyDown(var Key : Word; Shift : TShiftState);
|
|
begin
|
|
inherited KeyDown(Key, Shift);
|
|
|
|
case Key of
|
|
VK_DELETE : if Shift = [] then
|
|
PressButton(cbClearEntry);
|
|
VK_F9 : if Shift = [] then
|
|
PressButton(cbChangeSign);
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.KeyPress(var Key : Char);
|
|
begin
|
|
inherited KeyPress(Key);
|
|
|
|
case Key of
|
|
'0' : PressButton(cb0);
|
|
'1' : PressButton(cb1);
|
|
'2' : PressButton(cb2);
|
|
'3' : PressButton(cb3);
|
|
'4' : PressButton(cb4);
|
|
'5' : PressButton(cb5);
|
|
'6' : PressButton(cb6);
|
|
'7' : PressButton(cb7);
|
|
'8' : PressButton(cb8);
|
|
'9' : PressButton(cb9);
|
|
|
|
'+' : PressButton(cbAdd);
|
|
'-' : PressButton(cbSub);
|
|
'*' : PressButton(cbMul);
|
|
'/' : PressButton(cbDiv);
|
|
|
|
'.' : PressButton(cbDecimal);
|
|
'=' : PressButton(cbEqual);
|
|
'r' : PressButton(cbInvert);
|
|
'%' : PressButton(cbPercent);
|
|
'@' : PressButton(cbSqrt);
|
|
|
|
^L : PressButton(cbMemClear); {^L}
|
|
^R : PressButton(cbMemRecall); {^R}
|
|
^P : PressButton(cbMemAdd); {^P}
|
|
^S : PressButton(cbMemSub); {^S}
|
|
^T : PressButton(cbTape); {^T}
|
|
|
|
^C : CopyToClipboard; {^C}{copy}
|
|
^V : PasteFromClipboard; {^V}{paste}
|
|
|
|
#8 : PressButton(cbBack); {backspace}
|
|
#27 : PressButton(cbClear); {esc}
|
|
else
|
|
if Key = DecimalSeparator then
|
|
PressButton(cbDecimal);
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
|
|
var
|
|
B : TOvcCalculatorButton;
|
|
begin
|
|
SetFocus;
|
|
|
|
if Button = mbLeft then begin
|
|
cDownButton := cbNone;
|
|
for B := Low(cButtons) to High(cButtons) do
|
|
if cButtons[B].Visible and PtInRect(cButtons[B].Position, Point(X,Y)) then begin
|
|
if (B in [cbMemClear, cbMemRecall]) and (cEngine.Memory = 0) then
|
|
Exit;
|
|
cDownButton := B;
|
|
InvalidateRect(Handle, @cButtons[cDownButton].Position, False);
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.MouseUp(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
|
|
begin
|
|
if cDownButton = cbNone then
|
|
Exit;
|
|
|
|
InvalidateRect(Handle, @cButtons[cDownButton].Position, False);
|
|
|
|
{if still over the button...}
|
|
if PtInRect(cButtons[cDownButton].Position, Point(X,Y)) then
|
|
PressButton(cDownButton);
|
|
|
|
cDownButton := cbNone;
|
|
|
|
inherited MouseUp(Button, Shift, X, Y);
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.PasteFromClipboard;
|
|
var
|
|
I : Integer;
|
|
C : AnsiChar;
|
|
S : string;
|
|
begin
|
|
S := Clipboard.AsText;
|
|
if S > '' then begin
|
|
cClearAll;
|
|
for I := 1 to Length(S) do begin
|
|
C := S[I];
|
|
if (C in ['0'..'9', DecimalSeparator, '.', '+', '-', '*', '/', '=', '%']) then
|
|
KeyPress(C);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.PressButton(Button : TOvcCalculatorButton);
|
|
|
|
procedure Initialize;
|
|
begin
|
|
if (cLastButton <> cbClear) and (Button = cbClear) then begin
|
|
cClearAll;
|
|
cTape.SpaceTape(TapeSeparatorChar);
|
|
end;
|
|
|
|
if (csLocked in cEngine.State) then begin
|
|
MessageBeep(0);
|
|
Exit;
|
|
end;
|
|
|
|
{this logic is here to make cbEqual clear all the second time}
|
|
if (cLastButton in [cbEqual, cbClear, cbNone]) and (Button = cbEqual) then begin
|
|
Button := cbClear;
|
|
cClearAll;
|
|
end;
|
|
|
|
if (cLastButton = cbPercent) and (Button in [cbAdd, cbSub, cbMul, cbDiv, cbEqual]) then
|
|
cEvaluate(Button)
|
|
else if ((((cLastButton in [cbEqual, cbMemRecall]) and
|
|
(Button in [cbAdd, cbSub, cbMul, cbDiv])))) and
|
|
cEngine.AddOperand(StrToFloat(FDisplayStr), CalcButtontoOperation[Button]) then begin
|
|
cEvaluate(Button);
|
|
end else if (Button = cbMemStore) then begin
|
|
if (cLastButton <> cbEqual) then
|
|
cEvaluate(Button);
|
|
SetMemory(DisplayValue);
|
|
end else if cEngine.AddOperand(LastOperand, CalcButtontoOperation[Button]) then begin
|
|
cEvaluate(Button);
|
|
|
|
{remove special operations from stack}
|
|
if Button in [cbInvert, cbSqrt, cbEqual] then
|
|
LastOperand := cEngine.PopOperand;
|
|
end;
|
|
end;
|
|
|
|
procedure NumberButton;
|
|
var
|
|
D : Extended;
|
|
DP : Integer;
|
|
begin
|
|
begin
|
|
if cEngine.LastOperation = coEqual then begin
|
|
{clear pending operations if last command was =}
|
|
cClearAll;
|
|
end;
|
|
|
|
if csClear in cEngine.State then begin
|
|
if (Decimals < 0) then begin
|
|
FDisplayStr := '0.' + StringOfChar('0', -Decimals);
|
|
end else begin
|
|
FDisplayStr := '';
|
|
cDecimalEntered := False;
|
|
end;
|
|
end;
|
|
|
|
FDisplayStr := FDisplayStr + cButtons[Button].Caption[1];
|
|
if cMinus0 then begin
|
|
FDisplayStr := '-' + FDisplayStr;
|
|
cMinus0 := False;
|
|
end;
|
|
|
|
if (Decimals < 0) and not cDecimalEntered then begin
|
|
if Pos(DecimalSeparator, FDisplayStr) > 0 then begin
|
|
DP := Pos(DecimalSeparator, FDisplayStr);
|
|
if FDisplayStr[1] = '0' then
|
|
FDisplayStr := Copy(FDisplayStr,2,DP-2) +
|
|
Copy(FDisplayStr,DP+1,1) +
|
|
DecimalSeparator +
|
|
Copy(FDisplayStr,DP+2,Length(FDisplayStr) - DP)
|
|
else
|
|
FDisplayStr := Copy(FDisplayStr,1,DP-1) +
|
|
Copy(FDisplayStr,DP+1,1) +
|
|
DecimalSeparator +
|
|
Copy(FDisplayStr,DP+2,Length(FDisplayStr) - DP);
|
|
end;
|
|
end;
|
|
D := StrToFloat(FDisplayStr);
|
|
LastOperand := D;
|
|
if (D <> 0) or
|
|
(Pos(DecimalSeparator, FDisplayStr) > 0) then begin
|
|
DisplayValue := D;
|
|
cSetDisplayString(FDisplayStr);
|
|
cEngine.State := [csValid];
|
|
end else begin
|
|
FDisplayStr := '0';
|
|
DisplayValue := D;
|
|
cEngine.State := [csValid, csClear];
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure DecimalButton;
|
|
var
|
|
D : Extended;
|
|
begin
|
|
{check if the decimal was first character entered after a command}
|
|
if csClear in cEngine.State then begin
|
|
FDisplayStr := '0' + DecimalSeparator;
|
|
cSetDisplayString(FDisplayStr);
|
|
cDecimalEntered := True;
|
|
cEngine.State := [csValid];
|
|
end;
|
|
|
|
{check if there is already a decimal separator in the string}
|
|
if Pos(DecimalSeparator, FDisplayStr) = 0 then begin
|
|
FDisplayStr := FDisplayStr + DecimalSeparator;
|
|
if (pos(DecimalSeparator, FDisplayStr) = 1) then
|
|
FDisplayStr := '0' + FDisplayStr;
|
|
D := StrToFloat(FDisplayStr);
|
|
cSetDisplayString(FDisplayStr);
|
|
LastOperand := D;
|
|
cEngine.State := [csValid];
|
|
cDecimalEntered := True;
|
|
end;
|
|
end;
|
|
|
|
procedure BackButton;
|
|
var
|
|
D : Extended;
|
|
DP : Integer;
|
|
SaveSign : string;
|
|
begin
|
|
if FDisplayStr = '' then exit;
|
|
D := StrToFloat(FDisplayStr);
|
|
if D <> 0 then begin
|
|
if Length(FDisplayStr) > 1 then begin
|
|
if (Decimals < 0) and not cDecimalEntered then begin
|
|
if Pos(DecimalSeparator, FDisplayStr) > 0 then begin
|
|
if FDisplayStr[1] = '-' then begin
|
|
SaveSign :='-';
|
|
FDisplayStr := Copy(FDisplayStr,2,Length(FDisplayStr)-1);
|
|
end else begin
|
|
SaveSign :='';
|
|
end;
|
|
DP := Pos(DecimalSeparator, FDisplayStr);
|
|
FDisplayStr := '0' + Copy(FDisplayStr,1,DP-2) +
|
|
DecimalSeparator +
|
|
Copy(FDisplayStr,DP-1,1) +
|
|
Copy(FDisplayStr,DP+1,Length(FDisplayStr) - DP);
|
|
if (FDisplayStr[1] = '0') and (FDisplayStr[2] <> '.') then
|
|
FDisplayStr := Copy(FDisplayStr,2,Length(FDisplayStr)-1);
|
|
FDisplayStr := SaveSign + FDisplayStr;
|
|
end;
|
|
end;
|
|
FDisplayStr := Copy(FDisplayStr, 1, Length(FDisplayStr)-1);
|
|
LastOperand := StrToFloat(FDisplayStr);
|
|
cSetDisplayString(FDisplayStr);
|
|
end else begin
|
|
LastOperand := 0;
|
|
cMinus0 := False;
|
|
DisplayValue := LastOperand;
|
|
cEngine.State := [csValid, csClear];
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure ClearEntryButton;
|
|
begin
|
|
begin
|
|
FDisplayStr := '';
|
|
LastOperand := 0;
|
|
cMinus0 := False;
|
|
DisplayValue := LastOperand;
|
|
end;
|
|
end;
|
|
|
|
procedure ChangeSignButton;
|
|
begin
|
|
if Length(FDisplayStr) > 0 then begin
|
|
if FDisplayStr[1] <> '-' then begin
|
|
FDisplayStr := '-' + FDisplayStr;
|
|
LastOperand := StrToFloat(FDisplayStr);
|
|
cSetDisplayString(FDisplayStr);
|
|
end else begin
|
|
FDisplayStr := Copy(FDisplayStr, 2, Length(FDisplayStr)-1);
|
|
LastOperand := StrToFloat(FDisplayStr);
|
|
cSetDisplayString(FDisplayStr);
|
|
end;
|
|
DisplayValue := LastOperand;
|
|
end else begin
|
|
LastOperand := 0;
|
|
cMinus0 := not cMinus0;
|
|
DisplayValue := LastOperand;
|
|
if cMinus0 then
|
|
FDisplayStr := '-';
|
|
cEngine.State := [csValid, csClear];
|
|
end;
|
|
end;
|
|
|
|
procedure ClearTapeButton;
|
|
var
|
|
I : Integer;
|
|
begin
|
|
with Tape do begin
|
|
for I := 0 to Count - 1 do begin
|
|
Strings[I] := '';
|
|
end;
|
|
cTape.RefreshDisplays;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if not HandleAllocated then
|
|
Exit;
|
|
|
|
{simulate a button down if needed}
|
|
if cDownButton = cbNone then begin
|
|
cDownButton := Button;
|
|
InvalidateRect(Handle, @cButtons[cDownButton].Position, False);
|
|
Update;
|
|
end;
|
|
|
|
try try
|
|
Initialize;
|
|
case Button of
|
|
cb0..cb9 : NumberButton;
|
|
cbDecimal : DecimalButton;
|
|
cbBack : BackButton;
|
|
cbClearEntry : ClearEntryButton;
|
|
cbMemStore,
|
|
cbMemClear,
|
|
cbMemAdd,
|
|
cbMemSub : cInvalidateIndicator;
|
|
cbChangeSign : ChangeSignButton;
|
|
cbTape : ClearTapeButton;
|
|
cbSqrt,
|
|
cbInvert : {};
|
|
end;
|
|
except
|
|
cDisplayError;
|
|
end;
|
|
finally
|
|
{simulate a button up, if the mouse button is up or we aren't focused}
|
|
if not Focused or ({$IFNDEF LCL} GetAsyncKeyState(GetLeftButton) {$ELSE} GetKeyState(GetLeftButton) {$ENDIF} and $8000 = 0) then begin
|
|
InvalidateRect(Handle, @cButtons[cDownButton].Position, False);
|
|
cDownButton := cbNone;
|
|
Update;
|
|
end;
|
|
end;
|
|
|
|
cLastButton := Button;
|
|
if Assigned(FOnButtonPressed) then
|
|
FOnButtonPressed(Self, Button);
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.PushOperand(const Value : Extended);
|
|
begin
|
|
cEngine.PushOperand(Value);
|
|
LastOperand := Value;
|
|
DisplayValue := Value;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.Paint;
|
|
var
|
|
B : TOvcCalculatorButton;
|
|
begin
|
|
Canvas.Font := Font;
|
|
Canvas.Brush.Color := clBtnFace;
|
|
Canvas.FillRect(ClientRect);
|
|
|
|
if Ctl3D then begin
|
|
cPanel.BevelOuter := bvLowered;
|
|
cPanel.BorderStyle := bsNone;
|
|
end else begin
|
|
cPanel.BevelOuter := bvNone;
|
|
cPanel.BorderStyle := bsSingle;
|
|
end;
|
|
|
|
{draw buttons}
|
|
for B := Low(cButtons) to High(cButtons) do begin
|
|
if (B in [cbMemClear, cbMemRecall, cbMemStore, cbMemAdd, cbMemSub]) then begin
|
|
if (B in [cbMemClear, cbMemRecall]) and (cEngine.Memory = 0) then
|
|
Canvas.Font.Color := FColors.DisabledMemoryButtons
|
|
else
|
|
Canvas.Font.Color := FColors.MemoryButtons;
|
|
end else if (B in [cbBack, cbClearEntry, cbClear, cbTape]) then
|
|
Canvas.Font.Color := FColors.EditButtons
|
|
else if (B in [cbAdd, cbSub, cbMul, cbDiv, cbEqual]) then
|
|
Canvas.Font.Color := FColors.OperatorButtons
|
|
else if (B in [cb0..cb9, cbDecimal]) then
|
|
Canvas.Font.Color := FColors.NumberButtons
|
|
else if (B in [cbInvert, cbChangeSign, cbPercent, cbSqrt]) then
|
|
Canvas.Font.Color := FColors.FunctionButtons;
|
|
|
|
cDrawCalcButton(cButtons[B], (B = cDownButton));
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcCustomCalculator.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
|
|
begin
|
|
if Height <> AHeight then
|
|
if coShowTape in FOptions then
|
|
if Top <> ATop then begin
|
|
if TapeHeight + (AHeight - Height) > calcDefMinSize then begin
|
|
TapeHeight := TapeHeight + (AHeight - Height);
|
|
end else begin
|
|
TapeHeight := calcDefMinSize;
|
|
end
|
|
end;
|
|
|
|
inherited Setbounds(ALeft, ATop, AWidth, AHeight);
|
|
|
|
cCalculateLook;
|
|
end;
|
|
|
|
|
|
end.
|