Calculator With (Virtual) Tape

Warning - This program is not complete. For test only. Version zero dot 2 (maybe). Only number entry, addition (+), equals (=), clear all (ClrAll) and Exit work at this time.

Currently uses RPN ( Reverse Polish notation). Where the first operand is an accumulating variable. User enters the second operand and the operator. Digits of second operand are right justified in a column on the virtual tape, followed by a one space column and then the operator symbol at far right. Enter as many operands and operators as needed. After the last, enter equals (=). The accumulated value and "=" will be shown on the "tape". The user may continue with the accumulated value and more operands, or restart at zero by clicking "Clr All".

Go to download link.


CalcTape.bas Source Code
' CalcTape.bas
#compile exe
#dim all
#resource manifest, 1, "..\XPTheme.xml"
#resource icon, 101, "..\DY032W.ico"
#resource icon, 102, "..\DY032T.ico"
#resource icon, 105, "..\QuestionRed.ico"
#resource icon, 106, "..\QuestionAmber.ico"
#resource versioninfo
#resource fileversion 0, 0, 0, 2
#resource stringinfo "0409", "0000"
#resource version$ "FileVersion", "0.0.0.2"
#resource version$ "LegalCopyright", "Copyright 2019 Dale Yarker"
#resource version$ "ProductName", "Calculator with virtual tape."
#include "WinUser.inc"
global gAccumulate as currencyx
global ghButtons(), ghMainDlg as dword
global gpPrevCB as long ptr
%wm_syscommand = &H0112&
'Custom messages . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
%dm_KeyVal = %wm_user + 501
'%dm_ShiftChg = %wm_user + 502
'Control IDs . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
%ID_ExitBtn       = &h3FA&
%ID_TapeLstBx     = &h3FB&
%ID_NumEntryTxtBx = &h3FC&
%ID_BkspBtn       = &h3FD&
%ID_ClrEntryBtn   = &h3FE&
%ID_ClrAllBtn     = &h3FF&
'numeric keypad controls ID numbers  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .
%ID_Dig0Btn       = &h400& '1024
%ID_Dig1Btn       = &h401&
%ID_Dig2Btn       = &h402&
%ID_Dig3Btn       = &h403&
%ID_Dig4Btn       = &h404&
%ID_Dig5Btn       = &h405&
%ID_Dig6Btn       = &h406&
%ID_Dig7Btn       = &h407&
%ID_Dig8Btn       = &h408&
%ID_Dig9Btn       = &h409&
%ID_AddtnBtn      = &h40A& 'Operation and decimal point
%ID_DecimalPtBtn  = &h40B&
%ID_PosNegBtn     = &h40C&
%ID_DivideBtn     = &h40D&
%ID_MltplyBtn     = &h40E&
%ID_MinusBtn      = &h40F&
%ID_EqualsBtn     = &h410&
'position and sizes   .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .
%Col1Pos = 5 : %Col2Pos = 29 : %Col3Pos = 53 : %Col4Pos = 77
%ColWdth = 21 : %ColX2Wdth = 45
%Row1Pos = 40 : %Row2Pos = 63 : %Row3Pos = 86 : %Row4Pos = 109 : %Row5Pos = 132
%RowHght = 20 : %RowX2Hght = 43
union CurXQd
  qd as quad
  cx as currencyx
end union
'===============================================================================
'Edit tape
%ID_EdTpNumLbl = &h421&
%ID_EdTpOpLbl  = &h422&
%ID_EdTpNumTxtBx = &h423&
%ID_EdTpOpTxtBx  = &h424&
%ID_EdTpItemDoneBtn = &h425&
'-------------------------------------------------------------------------------
sub ReCalcTape(byval hParent as dword)
  local OnTapeCnt, Cntr as long
  local ItemStr as string
  local ItemVal as currencyx
  gAccumulate = 0
  listbox get count hParent, %ID_TapeLstBx to OnTapeCnt
  for Cntr = 1 to OnTapeCnt
    listbox get text hParent, %ID_TapeLstBx, Cntr to ItemStr
    ItemVal = val(left$(ItemStr, -2))
    select case const$ right$(ItemStr, 1)
      case "+"
        gAccumulate += ItemVal
      case "-"
        gAccumulate -= ItemVal
      case "*"
        gAccumulate *= ItemVal
      case "/", "\"
        gAccumulate /= ItemVal
      case "="
        listbox set text hParent, %ID_TapeLstBx, Cntr, _
           format$(gAccumulate, "0.00;-0.00;0.00") + " ="
    end select
  next
end sub
'-------------------------------------------------------------------------------
callback function EditTapeDlgCB() as long
  local OpStr, NumberStr, TmpStr as string
  local ItemCnt, CurItem as long
  local hParent as dword
  if cb.msg = %wm_command and cb.ctl = %ID_EdTpItemDoneBtn and _
                                                    cb.ctlmsg = %bn_clicked then
    dialog get user cb.hndl, 1& to hParent
    control get text cb.hndl, %ID_EdTpNumTxtBx to NumberStr
    control get text cb.hndl, %ID_EdTpNumTxtBx to OpStr
    listbox set text hParent, %ID_TapeLstBx, 2&,   OpStr   'NumberStr + " " +

    ReCalcTape hParent
    dialog end cb.hndl
  end if
   'take old value out of accumulate
end function
'-------------------------------------------------------------------------------
sub EditOnTape(byval hParent as dword)

  local OldNumStr, TmpStr as string
  local hEditTapeDlg, hTapeFont as dword
  local ParentLocX, ParentLocY, ParentWdth, ParentHght as long
  local OldValue as currencyx
  font new "Terminal", 12, 0, 0, 0, 0 to hTapeFont
         '   listbox get select cb.hndl, %ID_TapeLstBx to Result
         '   listbox get text cb.hndl, %ID_TapeLstBx, Result to TmpStr
         '   control set user cb.hndl, %ID_TapeLstBx, 1, Result
  TmpStr = "-12345678jg123456.78"
  dialog get loc hParent to ParentLocX, ParentLocY
  dialog get size hParent to ParentWdth, ParentHght
 ' ? str$(ParentX) + " " + str$(ParentY)
  dialog new hParent, "Edit an on-tape entry.", _
     ((ParentLocX - (ParentWdth \ 2)) - (117 )), _
     (ParentLocY - (ParentHght \ 2)) + (50 ), 99, 42 to hEditTapeDlg
  dialog set user hEditTapeDlg, 1&, hParent
  dialog set color hEditTapeDlg, -1, &h0088FFFF&
  control add label, hEditTapeDlg, %ID_EdTpNumLbl, "Number", 5, 1, 80, 9, _
     %ss_center, %ws_ex_left
  control add label, hEditTapeDlg, %ID_EdTpOpLbl, "Op", 83, 1, 11, 9, _
     %ss_center, %ws_ex_left
  control set color hEditTapeDlg, %ID_EdTpNumLbl, -1, &h0088FFFF&
  control set color hEditTapeDlg, %ID_EdTpOpLbl,  -1, &h0088FFFF&
  control add textbox, hEditTapeDlg, %ID_EdTpNumTxtBx, TmpStr, 5, 10, 78, 10, _
     %es_right or %ws_border, %ws_ex_clientedge
  control add textbox, hEditTapeDlg, %ID_EdTpOpTxtBx, "+",    84, 10, 10, 10, _
     %es_center or %ws_border, %ws_ex_clientedge
  control set font hEditTapeDlg, %ID_EdTpNumTxtBx, hTapeFont
  control set font hEditTapeDlg, %ID_EdTpOpTxtBx, hTapeFont
  control add button, hEditTapeDlg, %ID_EdTpItemDoneBtn, "Item Edit Done", _
     5, 25, 89, 12
  dialog show modal hEditTapeDlg call EditTapeDlgCB

  font end hTapeFont
end sub
'===============================================================================
'MainDlg section
'-------------------------------------------------------------------------------
'Verify program exit verify popup
%ID_RedQuesIcon = &h431&
%ID_MsgLbl      = &h432&
%ID_ExitYesBtn  = &h434&
%ID_ExitNoBtn  =  &h01&
%BackgrdColor  = &h00E0E0FF&
callback function ExitMsgCB() as long
  local Result as long
  if cb.msg = %wm_command then
    if cb.ctlmsg = %bn_clicked then
      select case as const cb.ctl
        case %ID_ExitYesBtn
          Result = 0
        case %ID_ExitNoBtn
          Result = -1
      end select
      dialog end cb.hndl, Result
    end if
  end if
end function
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
function ExitMsgBox(byval hParent as dword) as long
  local ParentLocX, ParentLocY, Result as long
  local hExitMsgBx as dword
  dialog get loc hParent to ParentLocX, ParentLocY
  dialog new hParent, "Verify Exit Program",&H080000000  ,&H080000000 , _ 'ParentLocX , ParentLocY , _
     174, 60 to hExitMsgBx
  dialog set color hExitMsgBx, -1, %BackgrdColor
  control add imagex, hExitMsgBx, %ID_RedQuesIcon, "#105", 0, 7, 24, 24, _
     %ss_icon, %ws_ex_left or %ws_ex_transparent
  control set color hExitMsgBx, %ID_RedQuesIcon, -1, %BackgrdColor
  control add label, hExitMsgBx, %ID_MsgLbl, _
     "Are you sure you want to exit this application?" + $$crlf + $$crlf + _
     $$dq + "Yes" + $$dq + " to verify exit," + $$crlf + _
     $$dq + "No" + $$dq + " to abort the exit.", 24, 3, 145, 33
  control set color hExitMsgBx, %ID_MsgLbl, -1, %BackgrdColor
  control add button, hExitMsgBx, %ID_ExitYesBtn, "Yes, goodbye.", _
     5, 40, 53, 15, %bs_center or %bs_notify or %bs_vcenter or %ws_tabstop, _
     %ws_ex_left
  control add button, hExitMsgBx, %ID_ExitNoBtn, "No, I'm not exiting.",  _
     63, 40, 106, 15, %bs_center or %bs_notify or %bs_vcenter or %ws_tabstop, _
     %ws_ex_left
  dialog show modal hExitMsgBx call ExitMsgCB to Result
  function = Result
end function
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
'Verify Clear All verify popup
%ID_AmbrQuesIcon = &h431&
%ID_ClrAllMsgLbl      = &h432&
%ID_ClrAllYesBtn  = &h434&
%ID_ClrAllNoBtn  =  &h01&
%AmbrBckgrdClr  = &h00E0E0FF&
callback function ClrAllMsgCB() as long
  local Result as long
  if cb.msg = %wm_command then
    if cb.ctlmsg = %bn_clicked then
      select case as const cb.ctl
        case %ID_ClrAllYesBtn
          Result = 0
        case %ID_ClrAllNoBtn
          Result = -1
      end select
      dialog end cb.hndl, Result
    end if
  end if
end function
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
function ClrAllMsgBox(byval hParent as dword) as long
  local ParentLocX, ParentLocY, Result as long
  local hClrAllMsgBx as dword
  dialog get loc hParent to ParentLocX, ParentLocY
  dialog new hParent, "Verify Exit Program",&H080000000  ,&H080000000 , _ 'ParentLocX , ParentLocY , _
     174, 60 to hClrAllMsgBx
  dialog set color hClrAllMsgBx, -1, %AmbrBckgrdClr
  control add imagex, hClrAllMsgBx, %ID_AmbrQuesIcon, "#105", 0, 7, 24, 24, _
     %ss_icon, %ws_ex_left or %ws_ex_transparent
  control set color hClrAllMsgBx, %ID_RedQuesIcon, -1, %AmbrBckgrdClr
  control add label, hClrAllMsgBx, %ID_MsgLbl, _
     "Are you sure you want to exit this application?" + $$crlf + $$crlf + _
     $$dq + "Yes" + $$dq + " to verify exit," + $$crlf + _
     $$dq + "No" + $$dq + " to abort the exit.", 24, 3, 145, 33
  control set color hClrAllMsgBx, %ID_MsgLbl, -1, %AmbrBckgrdClr
  control add button, hClrAllMsgBx, %ID_ExitYesBtn, "Yes, goodbye.", _
     5, 40, 53, 15, %bs_center or %bs_notify or %bs_vcenter or %ws_tabstop, _
     %ws_ex_left
  control add button, hClrAllMsgBx, %ID_ExitNoBtn, "No, I'm not exiting.",  _
     63, 40, 106, 15, %bs_center or %bs_notify or %bs_vcenter or %ws_tabstop, _
     %ws_ex_left
  dialog show modal hClrAllMsgBx call ExitMsgCB to Result
  function = Result
end function
'-------------------------------------------------------------------------------


'Subclass to capture keys
function FromKeyBdProc(byval hCtlWFocus as dword, _
                       byval Msg as long, _
                       byval wParam as long, _
                       byval lParam as long) as long
  local FoundAt,wParamOut as long
  static ShiftState as long
  select case as long Msg
    case %wm_keydown
      if wParam = %vk_shift then
        ShiftState = -1 '   .  .  .  .  . set shifted true, shift key is pressed
      end if
    case %wm_keyup
      if wParam = %vk_shift then
        ShiftState = 0 '  .  .  reset shifted false, shift key has been released
      end if
      array scan ghButtons(), = hCtlWFocus, to FoundAt
      if FoundAt then
        select case as long wParam
          case &h30& to &h37&, &h39&, &h60& to &h69&
            wParamOut = &h10& or (wParam and &h0000000F&)
            dialog post ghMainDlg, %dm_KeyVal, wParamOut, 0
          case &h38& '  .  .  .  .  .  .  .  .  .  . keybd 8 shifted is multiply
            if ShiftState then
              wParamOut = &h20& or &h0E& 'multiply
            else
              wParamOut = &h10 or &h08&  'numeral 8
            end if
            dialog post ghMainDlg, %dm_KeyVal, wParamOut, 0
          case &hBB '  .  .  .  .  .  .  .  .  .  .  .  . keybd = shifted is add
            if ShiftState then
              wParamOut = &h20& or &h0A& 'add
            else
              wParamOut = &h20& or &h09& 'equals/enter
            end if
          case &h6D&, &hBD& ' .  .  .  .  .  .  .  .  .  .  .  .  .  .  subtract
            wParamOut = &h20& or &h0F
          case &h6F&, &hBF& ' .  .  .  .  .  .  .  .  .  .  .  .  .  .  . divide
            wParamOut = &h20& or &h01

        end select
        dialog post ghMainDlg, %dm_KeyVal, wParamOut, 0
      end if

  end select
  function = CallWindowProc(gpPrevCB, hCtlWFocus, Msg, wParam, lParam)
end function
'-------------------------------------------------------------------------------
callback function MainDlgCB() as long
  local TmpStr as string
  local Result, Cntr as long
  local pResult as long ptr
  local TmpQd as quad
  static EnterBxBin as CurXQd
  static DPSet, PosNegSet as long
  if cb.msg = %wm_initdialog then
      dialog redraw cb.hndl
  end if
  select case as long cb.msg
    case %wm_initdialog
      for Cntr = %ID_BkspBtn to %ID_EqualsBtn
        gpPrevCB = SetWindowLongPtr(ghButtons(Cntr), %gwlp_wndproc, codeptr(FromKeyBdProc))
      next
    case %wm_syscommand
      if cb.wparam =%sc_close then
        Result = ExitMsgBox(cb.hndl)
        if Result = -1 then
          function = -1
        elseif Result = 0 then
          exit function
        end if
      end if
    case %wm_command
      select case as long cb.ctl
        case %ID_TapeLstBx
          if cb.ctlmsg = %lbn_dblclk then
            EditOnTape(cb.hndl)
          end if
        case %ID_BkspBtn
        case %ID_ClrEntryBtn
        case %ID_ClrAllBtn
          Result = msgbox("Are you sure you want" + $crlf + _
                          "to delete everything?", %mb_yesno or _
                          %mb_defbutton2 or %mb_taskmodal or %mb_iconquestion, _
                          "Verify Clear All")
          if Result = %idno then
            exit function
          elseif Result = %idyes then
            control set text cb.hndl, %ID_NumEntryTxtBx, ""
            listbox reset cb.hndl, %ID_TapeLstBx
            EnterBxBin.qd = 0
            gAccumulate = 0
          end if
        case %ID_ExitBtn
          dialog post cb.hndl, %wm_syscommand, %sc_close, 0
        case %ID_Dig0Btn to %ID_Dig9Btn 'Number buttons   .  .  .  .  .  .  .  .
          if cb.ctlmsg = %bn_clicked then
            gosub NumericDigSub
          end if
        case %ID_DecimalPtBtn
          if cb.ctlmsg = %bn_clicked then
            gosub DecimalPtSub
          end if
        case %ID_AddtnBtn
          if cb.ctlmsg = %bn_clicked then
            gosub AddtnSub
          end if
        case %ID_EqualsBtn
          gosub EnterEqualSub
        case %ID_PosNegBtn '.  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .
          if PosNegSet = 0 then
            PosNegSet = -1
            control set text cb.hndl, %ID_PosNegBtn, "+(-)"
          else
            PosNegSet = 0
            control set text cb.hndl, %ID_PosNegBtn, "(+)-"
          end if
       '   if isfalse EnterBxBin.cx = 0 then
       '     if EnterBxBin.cx > 0 and PosNegSet then
       '       EnterBxBin.cx *= -1
       '     elseif EnterBxBin.cx < 0 and isfalse PosNegSet then
        '      EnterBxBin.cx *= -1
       '     end if
       '     control set text cb.hndl, %ID_NumEntryTxtBx, ""
       '   end if
        case %dm_KeyVal
        '  if cb.wparam = &h38& and gShiftSet = -1 then
         '   gosub MultiplySub
        '    exit function
        '  end if
          select case as long cb.wparam
            case %vk_return '0D from keydb and keypad, used as =

            case &h030& to &h039&, &h60& to &h69& 'keybd and numeric keypad
              gosub NumericDigSub

            case %VK_Multiply
            case %VK_Add
           ' case '%VK_Seperator
            case %VK_Subtract
            case %VK_Decimal '
            case %VK_Divide
            case %VK_0 to %VK_9, %VK_NumPad0 to %VK_NumPad9
            case &h4E? 'n
            case &h50? 'p    'keyup   wparam  numpad 0 -h30 kybd h60numpad
          end select
        case %wm_keydown
          select case as long cb.wparam

            'Dig = cb.wparam and &h0000000F&
          end select
    case %wm_notify
    case %wm_help
      pResult = cb.lparam + 8 'ID of Control clicked on is 3 item in UDT
                              'pointed to by lpararm. ((0, 4, 8; 8 is 3rd))
      Result = @pResult       'Result has ID where help cursor clicked
      HelpPopup Result        'Help display procedure.
        end select
  end select
  '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  'Subroutines number digits, add, subtract, etc because there are 2 or 3
  'sources for each. Normal keyboard, controls on the dialog, and maybe
  'a numeric keypad.
  exit function 'don't accidentally "fall" into subroutines
  '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
  DecimalPtSub:
    if DPSet then
      DPSet = 0
      control set text cb.hndl, %ID_DecimalPtBtn, "(.)"
    else
      DPSet = -1
      control set text cb.hndl, %ID_DecimalPtBtn, "."
    end if
  return
  DecimalPtOffSub: 'called by all operations buttons
    DPSet = 0
    control set text cb.hndl, %ID_DecimalPtBtn, "(.)"
    control redraw cb.hndl, %ID_DecimalPtBtn
  return
  NumericDigSub: ' .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .
    if DPSet then
      TmpQd = EnterBxBin.qd
      EnterBxBin.qd \= 100
      EnterBxBin.qd *= 100
      TmpQd = ((TmpQd * 10) + (cb.ctl and &h0000000F&)) mod 100
      EnterBxBin.qd += TmpQd
    else
      EnterBxBin.qd = (EnterBxBin.qd * 10) + ((cb.ctl and &h0000000F&) * 100)
    end if
    control set text cb.hndl, %ID_NumEntryTxtBx, _
       format$(EnterBxBin.cx, "0.00;-0.00;0.00")
  return
  AddtnSub: '.  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .
    gosub DecimalPtOffSub
    gAccumulate += EnterBxBin.cx
    listbox add cb.hndl, %ID_TapeLstBx, format$(EnterBxBin.cx, "0.00;-0.00;0.00") + " +"
    EnterBxBin.cx = 0
    control set text cb.hndl, %ID_NumEntryTxtBx, ""
  return
  SubtrctSub: ' .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .

  return


  EnterEqualSub: ' .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .
    listbox add cb.hndl, %ID_TapeLstBx, format$(gAccumulate, "0.00;-0.00;0.00") + " ="
    control set text cb.hndl, %ID_NumEntryTxtBx, ""

  return
end function
'-------------------------------------------------------------------------------
function pbmain () as long
  MainDlg
end function
'-------------------------------------------------------------------------------
function MainDlg () as long
  local Desk_X_SzPx, Desk_Y_SzPx, Tape_X_SzPx, Tape_Y_SzPx, Cntr as long
  local  hTapeFont, hDispFont, hNumKeyFont as dword
 ' local TmpStr as string
  desktop get client to Desk_X_SzPx, Desk_Y_SzPx
  dim  ghButtons(%ID_BkspBtn to %ID_EqualsBtn)
  'fonts used  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  font new "Terminal", 10, 0, 1, 0, 0 to hTapeFont
  font new "Terminal", 14, 0, 1, 0, 0 to hDispFont
  font new "Lucidia Console", 14, 1, 1, 0, 0 to hNumKeyFont
  dialog default font "MS Sans Serif", 12, 0, 1
  'the dialog and controls - - - - - - - - - - - - - - - - - - - - - - - - - - -
  dialog new 0, "Calculator w/editable tape", , , 203, 174, %ds_3dlook or _
     %ds_contexthelp or %ds_modalframe or %ds_nofailcreate or %ds_setfont or _
     %ws_caption or %ws_clipsiblings or %ws_dlgframe or %ws_popup or _
     %ws_sysmenu, %ws_ex_contexthelp or %ws_ex_left or %ws_ex_ltrreading _
                                                                     to ghMainDlg
  dialog set color ghMainDlg, -1&, &hE0E0E0&
  dialog set icon ghMainDlg, "#102"
  control add button, ghMainDlg, %ID_BkspBtn, "Bk Spc", 5, 5, 29, 12
  control add button, ghMainDlg, %ID_ClrEntryBtn, "Clr Entry", 37, 5, 29, 12
  control add button, ghMainDlg, %ID_ClrAllBtn, "Clr All", 69, 5, 29, 12
  control add textbox, ghMainDlg, %ID_NumEntryTxtBx, "", 4, 22, 95, 13, _
     %es_right or %ws_border, %ws_ex_clientedge
  control set font ghMainDlg, %ID_NumEntryTxtBx, hDispFont
  'on-screen numeric keypad -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -
  control add button, ghMainDlg, %ID_PosNegBtn, "+(-)", %Col1Pos, %Row1Pos, _
                                                       %ColWdth, %RowHght
  control add button, ghMainDlg, %ID_DivideBtn, "/",    %Col2Pos, %Row1Pos, _
                                                       %ColWdth, %RowHght
  control add button, ghMainDlg, %ID_MltplyBtn, "*",    %Col3Pos, %Row1Pos, _
                                                       %ColWdth, %RowHght
  control add button, ghMainDlg, %ID_MinusBtn,  "-",    %Col4Pos, %Row1Pos, _
                                                       %ColWdth, %RowHght
  control add button, ghMainDlg, %ID_Dig7Btn,   "7",    %Col1Pos, %Row2Pos, _
                                                       %ColWdth, %RowHght
  control add button, ghMainDlg, %ID_Dig8Btn,   "8",    %Col2Pos, %Row2Pos, _
                                                       %ColWdth, %RowHght
  control add button, ghMainDlg, %ID_Dig9Btn,   "9",    %Col3Pos, %Row2Pos, _
                                                       %ColWdth, %RowHght
  control add button, ghMainDlg, %ID_AddtnBtn,  "+",    %Col4Pos, %Row2Pos, _
                                                       %ColWdth, %RowX2Hght
  control add button, ghMainDlg, %ID_Dig4Btn,   "4",    %Col1Pos, %Row3Pos, _
                                                       %ColWdth, %RowHght
  control add button, ghMainDlg, %ID_Dig5Btn,   "5",    %Col2Pos, %Row3Pos, _
                                                       %ColWdth, %RowHght
  control add button, ghMainDlg, %ID_Dig6Btn,   "6",    %Col3Pos, %Row3Pos, _
                                                       %ColWdth, %RowHght
  control add button, ghMainDlg, %ID_Dig1Btn,   "1",    %Col1Pos, %Row4Pos, _
                                                       %ColWdth, %RowHght
  control add button, ghMainDlg, %ID_Dig2Btn,   "2",    %Col2Pos, %Row4Pos, _
                                                       %ColWdth, %RowHght
  control add button, ghMainDlg, %ID_Dig3Btn,   "3",    %Col3Pos, %Row4Pos, _
                                                       %ColWdth, %RowHght
  control add button, ghMainDlg, %ID_EqualsBtn, "=",    %Col4Pos, %Row4Pos, _
                                                       %ColWdth, %RowX2Hght
  control add button, ghMainDlg, %ID_Dig0Btn,   "0",    %Col1Pos, %Row5Pos, _
                                                       %ColX2Wdth, %RowHght
  control add button, ghMainDlg, %ID_DecimalPtBtn, "(.)", _
                                                       %Col3Pos, %Row5Pos, _
                                                       %ColWdth, %RowHght
  'Set numeric pad font  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -
  for Cntr = %ID_Dig0Btn to %ID_EqualsBtn
    control set font ghMainDlg, Cntr,hNumKeyFont
  next
  control add listbox, ghMainDlg, %ID_TapeLstBx, , 104, 4, 98 - 6, 170, _
     %lbs_disablenoscroll or %lbs_notify or %ws_vscroll, _
     %ws_ex_right or %ws_ex_staticedge
  control set font ghMainDlg, %ID_TapeLstBx, hTapeFont
  control add button, ghMainDlg, %ID_ExitBtn, "Exit", %Col3Pos, 157, _
                                                    %ColX2Wdth, 12
  '
  for Cntr = %ID_BkspBtn to %ID_EqualsBtn
    control handle ghMainDlg, Cntr to ghButtons(Cntr)
  next
  '
  dialog show modal ghMainDlg call MainDlgCB
  '
  font end hTapeFont
  font end hDispFont
  font end hNumKeyFont
end function
'-------------------------------------------------------------------------------
sub HelpPopup(byval Control_ID as long)
  local HelpStr, TitleStr as wstring
  select case as long Control_ID
    case %ID_BkspBtn
       TitleStr = "Backspace key or Bk Spc button."
       HelpStr = "Removes last units position digit in the Entry box."
    case %ID_ClrEntryBtn
       TitleStr = "Clr Entry button."
       HelpStr = "Clears entire entry from Entry box." + $$crlf + $$crlf + _
                 "To edit an entry sent to the tape, double" + $$crlf + _
                 "on the item in the tape listbox."
    case %ID_ClrAllBtn
      TitleStr = "Clr All button."
      HelpStr = "Clears entry and tape boxes, and memory of" + $$crlf + _
                "all entries." + $$crlf + $$crlf + _
                "There is a message box to verify or" + $$crlf + _
                "abort the clear."
    case %ID_NumEntryTxtBx
      TitleStr = "The Entry box."
      HelpStr = "Number digits from keyboard, number buttons, or" + $$crlf + _
                "numeric keypad. They enter at the units position" + $$crlf + _
                "and previous digits are moved left. When the" + $crlf + _
                "decimal point is ON, only tenths and hundredths" + $$crlf + _
                "positions are affected."
    case %ID_TapeLstBx
      TitleStr = "Tape display listbox."
      HelpStr = "Show the last number that was in the entry" + $$crlf + _
                "box, and the operation that placed it." + $$crlf + $$crlf + _
                "Double click on item to move back to the" + $$crlf + _
                "entry box for editing."
    case %ID_ExitBtn
      TitleStr = "Exit button and cation bar X."
      HelpStr = "Exit the program. Nothing retained." + $$crlf + $$crlf + _
                "There is a message box to verify or" + $$crlf + _
                "abort the exit."
    'numeric keypad controls ID numbers .  .  .  .  .  .  .  .  .  .  .  .  .  .
    case %ID_Dig0Btn to %ID_Dig9Btn


   ' case

    case %ID_AddtnBtn   'Operation and decimal point
    case %ID_DecimalPtBtn
      TitleStr = "Decimal Point button."
      HelpStr = "Turns enter fraction on and off. When on only" + $$crlf + _
                "the two fraction digits are affected. When off" + $$crlf + _
                "the current integer part is multiplied by ten" + $$crlf + _
                "and the new digit is inserted in the units position." + _
                $$crlf + _
                "Any operation key/button turns the decimal point off. " + _
                $$crlf + $$crlf + $$dq + "(.)" + $$dq + " for OFF, " + _
                $$dq + "." + $$dq + " for ON."
    case %ID_PosNegBtn
    case %ID_DivideBtn
    case %ID_MltplyBtn
    case %ID_MinusBtn
    case %ID_EqualsBtn

  end select
  msgbox HelpStr, %mb_ok or %mb_iconinformation or %mb_taskmodal, TitleStr
end sub

Download Source Code
Get CalcWithTapeSource.zip contains CalcTape.bas, four icons and XPTheme.xml. (If you have a compiler, then you probably have the manifest.)

Created on 30 October 2021; last edit 30 October 2021

To Domain Home.

home
To Dale's Notebook index.
notebook
To Programs index.
programs