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 #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
Created on 30 October 2021; last edit 30 October 2021
To
Domain Home. | To Dale's Notebook index. | To Programs index. |