home *** CD-ROM | disk | FTP | other *** search
- unit BCalcWin;
-
- {************************************************************************
- * *
- * Calculator User Interface *
- * *
- ************************************************************************}
-
- { Author: John Zaitseff <J.Zaitseff@unsw.edu.au>
- Date: 6th November, 1996.
- Version: 1.2
-
- This file provides the user interface code for the Base Calculator.
- Note that the Tag property of buttons, radio buttons and check-boxes
- is used for two purposes: as the context-sensitive help identifier,
- and as the "keypress value" + some offset. The TagOfsXXX identifiers
- list the offsets used. If these are changed, the help file and parts
- of this code must also be changed.
-
- This program, including this file, is under the terms of the GNU
- General Public License.
- }
-
- interface
-
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls, ExtCtrls, Menus, Clipbrd, ComCtrls, Registry, Calc;
-
- const
- BeepType = mb_IconExclamation;
- RegKeyPrefix = '\Software\Zaitseff\Base Calculator\1.2';
-
- TagOfsNumKey = 2000;
- TagOfsOpsKey = 3000;
-
- type
- { Base Calculator window class }
- TBaseCalcWin = class(TForm)
- Result : TLabel;
- Background : TLabel;
- MemOcc : TLabel;
- BaseGB : TGroupBox;
- DecRB : TRadioButton;
- HexRB : TRadioButton;
- BinRB : TRadioButton;
- OctRB : TRadioButton;
- SizeGB : TGroupBox;
- Size8RB : TRadioButton;
- Size16RB : TRadioButton;
- Size32RB : TRadioButton;
- SignedCB : TCheckBox;
- ClrBtn : TButton;
- LeftBtn : TButton;
- MInBtn : TButton;
- MRBtn : TButton;
- NotBtn : TButton;
- AndBtn : TButton;
- OrBtn : TButton;
- NegBtn : TButton;
- XorBtn : TButton;
- EqvBtn : TButton;
- Btn0 : TButton;
- Btn1 : TButton;
- Btn2 : TButton;
- Btn3 : TButton;
- Btn4 : TButton;
- Btn5 : TButton;
- Btn6 : TButton;
- Btn7 : TButton;
- Btn8 : TButton;
- Btn9 : TButton;
- BtnA : TButton;
- BtnB : TButton;
- BtnC : TButton;
- BtnD : TButton;
- BtnE : TButton;
- BtnF : TButton;
- MulBtn : TButton;
- DivBtn : TButton;
- SubBtn : TButton;
- ModBtn : TButton;
- AddBtn : TButton;
- MPlusBtn : TButton;
- EqualsBtn : TButton;
- MainMenu : TMainMenu;
- FileMenu : TMenuItem;
- ExitMI : TMenuItem;
- EditMenu : TMenuItem;
- CopyMI : TMenuItem;
- PasteMI : TMenuItem;
- HelpMenu : TMenuItem;
- HelpTopicsMI : TMenuItem;
- AboutMI : TMenuItem;
- N1 : TMenuItem;
- ValueMI : TMenuItem;
- N2 : TMenuItem;
- PopupEditMenu : TPopupMenu;
- CopyPMI : TMenuItem;
- PastePMI : TMenuItem;
- N3 : TMenuItem;
- ValuePMI : TMenuItem;
- PopupWhatMenu : TPopupMenu;
- WhatPMI : TMenuItem;
-
- procedure FormCreate (Sender : TObject);
- procedure FormClose (Sender : TObject; var Action : TCloseAction);
- procedure FormDestroy (Sender : TObject);
- procedure FormKeyDown (Sender : TObject; var Key : Word; Shift : TShiftState);
- procedure BaseRBClick (Sender : TObject);
- procedure SignedCBClick (Sender : TObject);
- procedure SizeCBClick (Sender : TObject);
- procedure NumBtnClick (Sender : TObject);
- procedure OpBtnClick (Sender : TObject);
- procedure ClrBtnClick (Sender : TObject);
- procedure LeftBtnClick (Sender : TObject);
- procedure MInBtnClick (Sender : TObject);
- procedure MRBtnClick (Sender : TObject);
- procedure MPlusBtnClick (Sender : TObject);
- procedure ExitMIClick (Sender : TObject);
- procedure EditMenuClick (Sender : TObject);
- procedure CopyMIClick (Sender : TObject);
- procedure PasteMIClick (Sender : TObject);
- procedure ValueMIClick (Sender : TObject);
- procedure HelpTopicsMIClick (Sender : TObject);
- procedure AboutMIClick (Sender : TObject);
- procedure WhatPMIClick (Sender : TObject);
-
- private
- Calc : TCalculator;
- RegData : TRegistry;
-
- procedure CalcUpdateDisplay;
- procedure CalcUpdateButtons;
- procedure CalcEnableNumKeys;
- procedure CalcEnableClipboardOps;
- end;
-
- var
- BaseCalcWin : TBaseCalcWin;
-
- implementation
-
- uses
- About, Value;
-
- {$R *.DFM}
-
- type
- { Items to store in the Registry }
- TRegStorage = packed record
- Mode : TCalcMode;
- Signed : boolean;
- Size : TCalcSize
- end;
-
-
- { Update the calculator display }
- procedure TBaseCalcWin.CalcUpdateDisplay;
-
- begin
- { Set the Memory indicator on or off }
- if Calc.MemoryOccupied then
- MemOcc.Caption := 'M'
- else
- MemOcc.Caption := ' ';
-
- { Display the actual value }
- if Calc.InError then
- Result.Caption := 'Error'
- else
- Result.Caption := Calc.CurrentString
- end;
-
- { Update the various radio buttons and check boxes to reflect the current
- state of the calculator. Note that setting Checked to True for any
- radio button automatically resets the others in that group. }
- procedure TBaseCalcWin.CalcUpdateButtons;
-
- begin
- case Calc.Mode of
- Decimal : DecRB.Checked := True;
- Hexadecimal : HexRB.Checked := True;
- Binary : BinRB.Checked := True;
- Octal : OctRB.Checked := True
- end;
- SignedCB.Checked := Calc.Signed;
-
- case Calc.Size of
- Size8 : Size8RB.Checked := True;
- Size16 : Size16RB.Checked := True;
- Size32 : Size32RB.Checked := True
- end
- end;
-
- { Enable the number keys, depending on the current mode }
- procedure TBaseCalcWin.CalcEnableNumKeys;
-
- begin
- { The brute-force method! }
- case Calc.Mode of
- Decimal : begin
- Btn2.Enabled := True;
- Btn3.Enabled := True;
- Btn4.Enabled := True;
- Btn5.Enabled := True;
- Btn6.Enabled := True;
- Btn7.Enabled := True;
- Btn8.Enabled := True;
- Btn9.Enabled := True;
- BtnA.Enabled := False;
- BtnB.Enabled := False;
- BtnC.Enabled := False;
- BtnD.Enabled := False;
- BtnE.Enabled := False;
- BtnF.Enabled := False
- end;
- Hexadecimal : begin
- Btn2.Enabled := True;
- Btn3.Enabled := True;
- Btn4.Enabled := True;
- Btn5.Enabled := True;
- Btn6.Enabled := True;
- Btn7.Enabled := True;
- Btn8.Enabled := True;
- Btn9.Enabled := True;
- BtnA.Enabled := True;
- BtnB.Enabled := True;
- BtnC.Enabled := True;
- BtnD.Enabled := True;
- BtnE.Enabled := True;
- BtnF.Enabled := True
- end;
- Binary : begin
- Btn2.Enabled := False;
- Btn3.Enabled := False;
- Btn4.Enabled := False;
- Btn5.Enabled := False;
- Btn6.Enabled := False;
- Btn7.Enabled := False;
- Btn8.Enabled := False;
- Btn9.Enabled := False;
- BtnA.Enabled := False;
- BtnB.Enabled := False;
- BtnC.Enabled := False;
- BtnD.Enabled := False;
- BtnE.Enabled := False;
- BtnF.Enabled := False
- end;
- Octal : begin
- Btn2.Enabled := True;
- Btn3.Enabled := True;
- Btn4.Enabled := True;
- Btn5.Enabled := True;
- Btn6.Enabled := True;
- Btn7.Enabled := True;
- Btn8.Enabled := False;
- Btn9.Enabled := False;
- BtnA.Enabled := False;
- BtnB.Enabled := False;
- BtnC.Enabled := False;
- BtnD.Enabled := False;
- BtnE.Enabled := False;
- BtnF.Enabled := False
- end
- end
- end;
-
- { Enable menu items under the Edit menu and popup depending on the
- calculator state }
- procedure TBaseCalcWin.CalcEnableClipboardOps;
-
- var
- B : boolean;
-
- begin
- { Copy and Value menu items enabled if calculator is not in error }
- B := not Calc.InError;
- CopyMI.Enabled := B;
- CopyPMI.Enabled := B;
- ValueMI.Enabled := B;
- ValuePMI.Enabled := B;
-
- { Paste menu item enabled if clipboard has appropriate format available }
- B := Clipboard.HasFormat(CF_TEXT);
- PasteMI.Enabled := B;
- PastePMI.Enabled := B
- end;
-
-
- { Create the actual calculator state machine and initialise it with values
- stored in the Registry }
- procedure TBaseCalcWin.FormCreate (Sender : TObject);
-
- var
- CalcState : TRegStorage;
-
- begin
- Calc := TCalculator.Create;
- RegData := TRegistry.Create;
-
- Calc.ClearAll;
-
- { Use Registry to get the previous calculator settings }
- RegData.RootKey := HKEY_CURRENT_USER;
- if RegData.OpenKey(RegKeyPrefix, False) and
- (RegData.ReadBinaryData('CalcState', CalcState,
- sizeof(CalcState)) = sizeof(CalcState)) then
- begin
- { Registry path RegKeyPrefix exists and registry key "CalcState"
- contains valid data }
- with CalcState do
- begin
- Calc.Mode := Mode;
- Calc.Signed := Signed;
- Calc.Size := Size
- end
- end
- else
- begin
- { The registry key does not exist or is not valid: use default values }
- Calc.Mode := Decimal;
- Calc.Signed := True;
- Calc.Size := Size32
- end;
- RegData.CloseKey;
-
- CalcUpdateDisplay;
- CalcUpdateButtons;
- CalcEnableNumKeys;
-
- CalcEnableClipboardOps
- end;
-
- { Save the current settings of the calculator into the registry }
- procedure TBaseCalcWin.FormClose (Sender : TObject; var Action : TCloseAction);
-
- var
- CalcState : TRegStorage;
-
- begin
- { Close WinHelp, if it was opened }
- Application.HelpCommand(Help_Quit,0);
-
- { Use Registry to save the current calculator settings }
- RegData.RootKey := HKEY_CURRENT_USER;
- if RegData.OpenKey(RegKeyPrefix, True) then
- begin
- with CalcState do
- begin
- Mode := Calc.Mode;
- Signed := Calc.Signed;
- Size := Calc.Size
- end;
-
- RegData.WriteBinaryData('CalcState', CalcState, sizeof(CalcState))
- end;
- RegData.CloseKey
- end;
-
- { Free up memory associated with this application }
- procedure TBaseCalcWin.FormDestroy (Sender : TObject);
-
- begin
- RegData.Free;
- Calc.Free
- end;
-
- { Handle keypresses in the application. Note that the active control
- will still get the key, even if Key is set to 0. Hence, <ENTER> will
- still activate the control, even if handled here. Menu shortcuts are
- also handled automatically. }
- procedure TBaseCalcWin.FormKeyDown (Sender : TObject; var Key : Word; Shift : TShiftState);
-
- const
- VK_PLEQ = 187; { '+' '=' }
- VK_UNDER = 189; { '_' '-' }
- VK_QUEST = 191; { '?' '/' }
- VK_TILDE = 192; { '~' '`' }
- VK_BAR = 220; { '|' '\' }
-
- type
- TBtnType = (bt_None, bt_Btn, bt_RadioBtn, bt_CheckBox);
-
- var
- Btn : ^TWinControl;
- BtnType : TBtnType;
-
- begin
- { If keypress is simply <SHIFT> or <CTRL>, abort trying to handle it }
- if (Key = VK_SHIFT) or (Key = VK_CONTROL) then
- exit;
-
- BtnType := bt_None;
-
- if (Shift = []) or (Shift = [ssShift]) then
- begin
- { Handle shifted and unshifted keys in (almost) the same way }
- BtnType := bt_Btn;
- case Key of
- VK_BACK : Btn := @LeftBtn;
- VK_RETURN : Btn := @EqualsBtn;
- VK_ESCAPE : Btn := @ClrBtn;
- Ord('0') : if Shift = [] then
- Btn := @Btn0
- else { ')' }
- BtnType := bt_None;
- Ord('1') : if Shift = [] then
- Btn := @Btn1
- else { '!' }
- Btn := @NotBtn;
- Ord('2') : if Shift = [] then
- Btn := @Btn2
- else { '@' }
- BtnType := bt_None;
- Ord('3') : if Shift = [] then
- Btn := @Btn3
- else { '#' }
- Btn := @EqvBtn;
- Ord('4') : if Shift = [] then
- Btn := @Btn4
- else { '$' }
- BtnType := bt_None;
- Ord('5') : if Shift = [] then
- Btn := @Btn5
- else { '%' }
- Btn := @ModBtn;
- Ord('6') : if Shift = [] then
- Btn := @Btn6
- else { '^' }
- Btn := @XorBtn;
- Ord('7') : if Shift = [] then
- Btn := @Btn7
- else { '&' }
- Btn := @AndBtn;
- Ord('8') : if Shift = [] then
- Btn := @Btn8
- else { '*' }
- Btn := @MulBtn;
- Ord('9') : if Shift = [] then
- Btn := @Btn9
- else { '(' }
- BtnType := bt_None;
- Ord('A') : Btn := @BtnA;
- Ord('B') : Btn := @BtnB;
- Ord('C') : Btn := @BtnC;
- Ord('D') : Btn := @BtnD;
- Ord('E') : Btn := @BtnE;
- Ord('F') : Btn := @BtnF;
- Ord('I') : Btn := @MInBtn;
- Ord('M') : Btn := @MPlusBtn;
- Ord('R') : Btn := @MRBtn;
- VK_NUMPAD0 : Btn := @Btn0;
- VK_NUMPAD1 : Btn := @Btn1;
- VK_NUMPAD2 : Btn := @Btn2;
- VK_NUMPAD3 : Btn := @Btn3;
- VK_NUMPAD4 : Btn := @Btn4;
- VK_NUMPAD5 : Btn := @Btn5;
- VK_NUMPAD6 : Btn := @Btn6;
- VK_NUMPAD7 : Btn := @Btn7;
- VK_NUMPAD8 : Btn := @Btn8;
- VK_NUMPAD9 : Btn := @Btn9;
- VK_MULTIPLY : Btn := @MulBtn;
- VK_ADD : Btn := @AddBtn;
- VK_SUBTRACT : Btn := @SubBtn;
- VK_DIVIDE : Btn := @DivBtn;
- VK_PLEQ : if Shift = [] then { '=' }
- Btn := @EqualsBtn
- else { '+' }
- Btn := @AddBtn;
- VK_UNDER : if Shift = [] then { '-' }
- Btn := @SubBtn
- else { '_' }
- Btn := @NegBtn;
- VK_QUEST : if Shift = [] then { '/' }
- Btn := @DivBtn
- else { '?' }
- BtnType := bt_None;
- VK_TILDE : if Shift = [] then { '`' }
- BtnType := bt_None
- else { '~' }
- Btn := @NotBtn;
- VK_BAR : if Shift = [] then { '\' }
- Btn := @ModBtn
- else { '|' }
- Btn := @OrBtn;
- else
- BtnType := bt_None
- end
- end
- else if Shift = [ssCtrl] then
- begin
- { Handle unshifted control keys }
- BtnType := bt_RadioBtn;
- case Key of
- Ord('1') : Btn := @Size16RB;
- Ord('2') : Btn := @Size32RB;
- Ord('3') : Btn := @Size32RB;
- Ord('6') : Btn := @Size16RB;
- Ord('8') : Btn := @Size8RB;
- Ord('B') : Btn := @BinRB;
- Ord('D') : Btn := @DecRB;
- Ord('H') : Btn := @HexRB;
- Ord('O') : Btn := @OctRB;
- Ord('S') : begin
- Btn := @SignedCB;
- BtnType := bt_CheckBox
- end
- else
- BtnType := bt_None
- end
- end;
-
- { Handle "clicking" the appropriate control type }
- case BtnType of
- bt_None : { Nothing };
- bt_Btn : begin
- if Btn^.Enabled then
- begin
- Btn^.SetFocus;
- TButton(Btn^).Click
- end
- else
- MessageBeep(BeepType);
- Key := 0
- end;
- bt_RadioBtn : begin
- if Btn^.Enabled then
- begin
- Btn^.SetFocus;
- TRadioButton(Btn^).Checked := True
- end
- else
- MessageBeep(BeepType);
- Key := 0
- end;
- bt_CheckBox : begin
- if Btn^.Enabled then
- begin
- Btn^.SetFocus;
- TCheckBox(Btn^).Checked := not TCheckBox(Btn^).Checked
- end
- else
- MessageBeep(BeepType);
- Key := 0
- end
- end
- end;
-
- { Handle selecting one of the base (mode) radio buttons }
- procedure TBaseCalcWin.BaseRBClick (Sender : TObject);
-
- begin
- if Calc.InError then
- Calc.ClearOperations;
-
- if Sender = DecRB then
- Calc.Mode := Decimal
- else if Sender = HexRB then
- Calc.Mode := Hexadecimal
- else if Sender = BinRB then
- Calc.Mode := Binary
- else if Sender = OctRB then
- Calc.Mode := Octal;
-
- CalcEnableNumKeys;
- CalcUpdateButtons;
- CalcUpdateDisplay
- end;
-
- { Handle checking or unchecking the Signed check box }
- procedure TBaseCalcWin.SignedCBClick (Sender : TObject);
-
- begin
- if Calc.InError then
- Calc.ClearOperations;
-
- Calc.Signed := TCheckBox(Sender).Checked;
-
- CalcUpdateButtons;
- CalcUpdateDisplay
- end;
-
- { Handle selecting one of the size radio buttons }
- procedure TBaseCalcWin.SizeCBClick (Sender : TObject);
-
- begin
- if Calc.InError then
- Calc.ClearOperations;
-
- if Sender = Size8RB then
- Calc.Size := Size8
- else if Sender = Size16RB then
- Calc.Size := Size16
- else if Sender = Size32RB then
- Calc.Size := Size32;
-
- CalcUpdateButtons;
- CalcUpdateDisplay
- end;
-
- { Handle selecting one of the number keys '0' - '9' and 'A' - 'F' }
- procedure TBaseCalcWin.NumBtnClick (Sender : TObject);
-
- begin
- if Calc.InError then
- MessageBeep(BeepType)
- else
- begin
- if Calc.AppendDigit(TControl(Sender).Tag - TagOfsNumKey) then
- CalcUpdateDisplay
- else
- MessageBeep(BeepType)
- end
- end;
-
- { Handle selecting one of the operation keys, including Equals }
- procedure TBaseCalcWin.OpBtnClick (Sender : TObject);
-
- begin
- if Calc.InError then
- MessageBeep(BeepType)
- else
- begin
- if not Calc.HandleKey(TCalcKey(TControl(Sender).Tag - TagOfsOpsKey)) then
- MessageBeep(BeepType);
- CalcUpdateDisplay
- end
- end;
-
- { Handle selecting the Clear button }
- procedure TBaseCalcWin.ClrBtnClick (Sender : TObject);
-
- begin
- Calc.ClearOperations;
- CalcUpdateDisplay
- end;
-
- { Handle selecting the Backspace (<-) button }
- procedure TBaseCalcWin.LeftBtnClick (Sender : TObject);
-
- begin
- if Calc.Backspace then
- CalcUpdateDisplay
- else
- MessageBeep(BeepType)
- end;
-
- { Handle selecting the Memory In button }
- procedure TBaseCalcWin.MInBtnClick (Sender : TObject);
-
- begin
- if Calc.InError then
- begin
- MessageBeep(BeepType);
- exit
- end;
-
- Calc.StoreCurrentInMem;
- CalcUpdateDisplay
- end;
-
- { Handle selecting the Memory Retrieve button }
- procedure TBaseCalcWin.MRBtnClick (Sender : TObject);
-
- begin
- if Calc.InError then
- begin
- MessageBeep(BeepType);
- exit
- end;
-
- Calc.RetrieveMemory;
- CalcUpdateDisplay
- end;
-
- { Handle selecting the Memory Add button }
- procedure TBaseCalcWin.MPlusBtnClick (Sender : TObject);
-
- begin
- if not Calc.AddToMemoryKey then
- MessageBeep(BeepType);
- CalcUpdateDisplay
- end;
-
- { Handle the Exit menu (or ALT+F4) }
- procedure TBaseCalcWin.ExitMIClick (Sender : TObject);
-
- begin
- Close
- end;
-
- { Handle the user clicking on the Edit menu or selecting the popup
- menu with the right mouse button }
- procedure TBaseCalcWin.EditMenuClick (Sender : TObject);
-
- begin
- CalcEnableClipboardOps
- end;
-
- { Handle selecting the Copy menu item. The Delphi encapsulation handles
- almost all of the details }
- procedure TBaseCalcWin.CopyMIClick (Sender : TObject);
-
- begin
- Clipboard.AsText := Calc.CurrentString
- end;
-
- { Handle selecting the Paste menu item. Only text can be pasted, and
- pasting is aborted if an illegal character is encountered }
- procedure TBaseCalcWin.PasteMIClick (Sender : TObject);
-
- var
- S : string;
- C : char;
- I, D : integer;
-
- begin
- if not Clipboard.HasFormat(CF_TEXT) then
- begin
- MessageBeep(BeepType);
- exit
- end;
-
- S := Clipboard.AsText;
- for I := 1 to length(S) do
- begin
- C := UpCase(S[I]);
- if C in ['0'..'9'] then
- D := Ord(C) - Ord('0')
- else if C in ['A'..'F'] then
- D := Ord(C) - Ord('A') + 10
- else
- begin
- MessageBeep(BeepType);
- break { Terminate the "for" loop }
- end;
-
- if not Calc.AppendDigit(D) then
- begin
- MessageBeep(BeepType);
- break
- end
- end;
-
- CalcUpdateDisplay
- end;
-
- { Display the Value dialog box on selecting the menu item }
- procedure TBaseCalcWin.ValueMIClick (Sender : TObject);
-
- begin
- with Calc do
- begin
- ValueWin.SDecEdit.Text := ValToStr(CurrentValue, Decimal, True, Size);
- ValueWin.UDecEdit.Text := ValToStr(CurrentValue, Decimal, False, Size);
- ValueWin.HexEdit.Text := ValToStr(CurrentValue, Hexadecimal, False, Size);
- ValueWin.BinEdit.Text := ValToStr(CurrentValue, Binary, False, Size);
- ValueWin.OctEdit.Text := ValToStr(CurrentValue, Octal, False, Size)
- end;
- ValueWin.ShowModal
- end;
-
- { Show the help topics available using WinHelp }
- procedure TBaseCalcWin.HelpTopicsMIClick (Sender : TObject);
-
- begin
- Application.HelpCommand(HELP_FINDER,0)
- end;
-
- { Show the About dialog box }
- procedure TBaseCalcWin.AboutMIClick (Sender : TObject);
-
- begin
- AboutWin.ShowModal
- end;
-
- { Display the context-sensitive help related to the button under which the
- "What's This?" menu was chosen. }
- procedure TBaseCalcWin.WhatPMIClick (Sender : TObject);
-
- begin
- Application.HelpCommand(HELP_CONTEXTPOPUP,
- TControl(PopupWhatMenu.PopupComponent).Tag)
- end;
-
- end.
-