An early example of an InForm project.
The program uses the following InForm objects:
Form
Frame
MenuBar
Button
Label
Unzip the file and extract the folder into your PEQB64 directory. In the IDE make sure that you have the Run Option “Save EXE in source folder” checked.
Terry Ritchie's Calculator.zip (Size: 119.21 KB / Downloads: 7)
The program uses the following InForm objects:
Form
Frame
MenuBar
Button
Label
Unzip the file and extract the folder into your PEQB64 directory. In the IDE make sure that you have the Run Option “Save EXE in source folder” checked.
Terry Ritchie's Calculator.zip (Size: 119.21 KB / Downloads: 7)
Code: (Select All)
': ____ ____ ____ ____ ____ ____ ____ ____ ____ ____
': ||C |||A |||L |||C |||U |||L |||A |||T |||O |||R ||
': ||__|||__|||__|||__|||__|||__|||__|||__|||__|||__||
': |/__\|/__\|/__\|/__\|/__\|/__\|/__\|/__\|/__\|/__\|
':
': QB64 Calculator V1.1
': Terry Ritchie - 08/29/18
':
': Built as a clone of the Windows 7 standard calculator
': An exersize in getting to know the InForm library
':
': This program uses
': InForm-PE for QB64-PE - v1.5.8 based upon InForm by Fellippe Heitor
': Copyright (c) 2025 QB64 Phoenix Edition Team
': https://github.com/QB64-Phoenix-Edition/InForm-PE
'----------------------------------------------------------------------------------------------------------------------
OPTION _EXPLICIT
': Program constants: -------------------------------------------------------------------------------------------------
CONST EQUATE = 0
CONST ADDITION = 1
CONST SUBTRACTION = 2
CONST MULTIPLICATION = 3
CONST DIVISION = 4
': Controls' IDs: -----------------------------------------------------------------------------------------------------
DIM SHARED Calculator AS LONG
DIM SHARED frmResults AS LONG
DIM SHARED mnuEdit AS LONG
DIM SHARED mnuHelp AS LONG
DIM SHARED butMC AS LONG
DIM SHARED butMR AS LONG
DIM SHARED butMS AS LONG
DIM SHARED butMplus AS LONG
DIM SHARED butMminus AS LONG
DIM SHARED butBS AS LONG
DIM SHARED butCE AS LONG
DIM SHARED butC AS LONG
DIM SHARED butSign AS LONG
DIM SHARED butSQR AS LONG
DIM SHARED but7 AS LONG
DIM SHARED but8 AS LONG
DIM SHARED but9 AS LONG
DIM SHARED butDivide AS LONG
DIM SHARED butPercent AS LONG
DIM SHARED but4 AS LONG
DIM SHARED but5 AS LONG
DIM SHARED but6 AS LONG
DIM SHARED butMultiply AS LONG
DIM SHARED butReciprocate AS LONG
DIM SHARED but1 AS LONG
DIM SHARED but2 AS LONG
DIM SHARED but3 AS LONG
DIM SHARED butSubtract AS LONG
DIM SHARED but0 AS LONG
DIM SHARED butPoint AS LONG
DIM SHARED butAdd AS LONG
DIM SHARED butEqual AS LONG
DIM SHARED mnuCopy AS LONG
DIM SHARED mnuPaste AS LONG
DIM SHARED mnuAbout AS LONG
DIM SHARED lblAnswer AS LONG
DIM SHARED lblMemory AS LONG
DIM SHARED lblHistory AS LONG
': Program variables: -------------------------------------------------------------------------------------------------
DIM SHARED operand$ ' current operand
DIM SHARED history$ ' calculation history
DIM SHARED operand1 AS DOUBLE ' first operand enetered
DIM SHARED operand2 AS DOUBLE ' second operand entered
DIM SHARED operator AS INTEGER ' current operator selected
DIM SHARED operator$(4)
DIM SHARED previousoperator AS INTEGER ' previous operator saved
DIM SHARED resetoperand AS INTEGER ' True when operand entry needs reset
DIM SHARED memory AS DOUBLE ' value stored in memory
DIM SHARED nohistory AS INTEGER
': External modules: --------------------------------------------------------------------------------------------------
'$INCLUDE:'InForm\InForm.bi'
'$INCLUDE:'InForm\xp.uitheme'
'$INCLUDE:'Calculator.frm'
': Program procedures: ------------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------------------------------
SUB ALERT () ' ALERT()
'------------------------------------------------------------------------------------------------------------------
DIM i AS LONG
PLAY "MBQ0" ' play in the background and disable volume ramping
FOR i = 800 TO 2000 STEP 100
SOUND i, .2
NEXT
FOR i = 2000 TO 50 STEP -100
SOUND i, .2
NEXT
END SUB
'----------------------------------------------------------------------------------------------------------------------
FUNCTION CLEAN$ (n AS DOUBLE) ' CLEAN$()
'------------------------------------------------------------------------------------------------------------------
' Return number (n) as a string with no leading/trailing spaces
' Add leading zero if necessary
DIM c$ ' n converted to a clean string
c$ = LTRIM$(RTRIM$(STR$(n))) ' create clean string
IF ASC(c$, 1) = 46 THEN ' first character a decimal point?
c$ = "0" + c$ ' yes, add leading zero
ELSEIF ASC(c$, 1) = 45 AND ASC(c$, 2) = 46 THEN ' no, minus sign then decimal point?
c$ = "-0" + RIGHT$(c$, LEN(c$) - 1) ' yes, add leading zero
END IF
CLEAN$ = c$ ' return cleaned string
END FUNCTION
'----------------------------------------------------------------------------------------------------------------------
SUB UPDATEOPERAND (n$) ' UPDATEOPERAND()
'------------------------------------------------------------------------------------------------------------------
' Add user entries to operand
' Keep operand to a max length of 16 numbers (not including decimal point)
' Reset user operand input as needed
' Keep leading zero for decimal values between one and negative one
DIM olen AS INTEGER ' operand length
IF resetoperand THEN ' new operand input?
operand$ = "" ' yes, reset operand
resetoperand = False ' reset trigger
END IF
IF n$ = "." THEN ' adding decimal point?
IF INSTR(operand$, ".") = 0 THEN ' yes, already a decimal point?
IF operand$ = "" THEN ' no, has operand been reset?
n$ = "0." ' yes, add leading zero
END IF
ELSE ' yes, decimal point exists
n$ = "" ' ignore user request for decimal point
END IF
END IF
operand$ = operand$ + n$ ' update operand with user entry
olen = LEN(operand$) ' get length of operand
IF INSTR(operand$, ".") > 0 THEN olen = olen - 1 ' don't count decimal point if preset
IF olen > 16 THEN operand$ = LEFT$(operand$, LEN(operand$) - 1) ' keep operand within 16 number limit
END SUB
'----------------------------------------------------------------------------------------------------------------------
SUB CALCULATE () ' CALCULATE()
'------------------------------------------------------------------------------------------------------------------
' Calculate operand values based on operator previously used
' Store result back into current operand
SELECT CASE previousoperator ' which operator to use?
CASE ADDITION ' add the operands
operand$ = CLEAN$(operand1 + operand2) ' perform clculation
CASE SUBTRACTION ' subtract the operands
operand$ = CLEAN$(operand1 - operand2) ' perform calculation
CASE MULTIPLICATION ' multiply the operands
operand$ = CLEAN$(operand1 * operand2) ' perform calculation
CASE DIVISION ' divide the operands
IF operand2 = 0 THEN ' dividing by zero?
ALERT ' get user's attention
operand$ = "Can't divide by zero!" ' yes, not in this universe!
ELSE ' no, physics is safe for now
operand$ = CLEAN$(operand1 / operand2) ' perform calculation
END IF
END SELECT
END SUB
'----------------------------------------------------------------------------------------------------------------------
SUB COMMITOPERAND () ' COMMITOPERAND()
'------------------------------------------------------------------------------------------------------------------
' Get value of current operand
' Calculate operands if necessary
' Save current operand value
' Remember the operator that invoked this routine
operand2 = VAL(operand$) ' store value of current operand
IF previousoperator THEN ' previous operator selected?
CALCULATE ' yes, calculate
END IF
operand1 = VAL(operand$) ' move current total to previous value
previousoperator = operator ' move current operator to previous operator
resetoperand = True ' trigger an operand reset
END SUB
'----------------------------------------------------------------------------------------------------------------------
SUB SCANKEYBOARD () ' SCANKEYBOARD()
'------------------------------------------------------------------------------------------------------------------
' Scan the keyboard for user keystrokes
' Invoke the appropriate button for the desired key
DIM k$ ' key pressed by user
DIM ctrl AS INTEGER
k$ = INKEY$ ' look for a key press
IF k$ <> "" THEN ' was a key pressed?
SELECT CASE k$ ' yes, which one?
CASE "0" ' zero key pressed
__UI_Click (but0) ' manually click the zero button
CASE "1" ' etc..
__UI_Click (but1) ' etc..
CASE "2"
__UI_Click (but2)
CASE "3"
__UI_Click (but3)
CASE "4"
__UI_Click (but4)
CASE "5"
__UI_Click (but5)
CASE "6"
__UI_Click (but6)
CASE "7"
__UI_Click (but7)
CASE "8"
__UI_Click (but8)
CASE "9"
__UI_Click (but9)
CASE "."
__UI_Click (butPoint)
CASE "+"
__UI_Click (butAdd)
CASE "-"
__UI_Click (butSubtract)
CASE "*"
__UI_Click (butMultiply)
CASE "/"
__UI_Click (butDivide)
CASE "%"
__UI_Click (butPercent)
CASE "=", CHR$(13) ' treat ENTER and = the same
__UI_Click (butEqual)
CASE CHR$(8) ' backspace key pressed
__UI_Click (butBS)
CASE "c", "C" ' CTRL-C copy
ctrl = _KEYDOWN(100305) OR _KEYDOWN(100306)
IF ctrl THEN BEEP
' Will need to investigate how to capture CTRL-C and CTRL-V
' Neither the code above or below works
CASE "v", "V" ' CTRL-V paste
IF __UI_CtrlIsDown THEN ' is CTRL key presses?
BEEP
END IF
END SELECT
END IF
END SUB
'----------------------------------------------------------------------------------------------------------------------
SUB ADDHISTORY (h$) ' ADDHISTORY()
'------------------------------------------------------------------------------------------------------------------
IF nohistory THEN
nohistory = False
ELSE
history$ = history$ + h$
END IF
END SUB
'----------------------------------------------------------------------------------------------------------------------
': Event procedures: --------------------------------------------------------------------------------------------------
SUB __UI_BeforeInit
END SUB
SUB __UI_OnLoad
operator$(1) = " + " ' define operator strings
operator$(2) = " - "
operator$(3) = " * "
operator$(4) = " / "
END SUB
SUB __UI_BeforeUpdateDisplay
'This event occurs at approximately 30 frames per second.
'You can change the update frequency by calling SetFrameRate DesiredRate%
DIM answer$ ' current operand displayed
SCANKEYBOARD ' process keys pressed by user
Caption(lblHistory) = history$ + operator$(operator) ' update history display
answer$ = operand$ ' copy operand
IF answer$ = "" THEN answer$ = "0" ' set to zero if empty
Caption(lblAnswer) = answer$ ' display current operand
IF memory THEN ' does memory have value?
Caption(lblMemory) = "M" ' yes, apply screen indication
ELSE ' no
Caption(lblMemory) = "" ' remove screen indication
END IF
END SUB
SUB __UI_BeforeUnload
'If you set __UI_UnloadSignal = False here you can
'cancel the user's request to close.
END SUB
SUB __UI_Click (id AS LONG)
SELECT CASE id
CASE Calculator
CASE frmResults
CASE mnuEdit
CASE mnuHelp
': memory buttons: ----------------------------------------------------------------------------------------
CASE butMC ' memory clear clicked
memory = 0 ' reset memory value
CASE butMR ' memory recall clicked
IF memory THEN ' memory available?
operand$ = CLEAN$(memory) ' Yes, make it the current operand
resetoperand = True ' trigger an operand reset
END IF
CASE butMS ' memory store clicked
memory = VAL(operand$) ' overwrite memory with current operand
resetoperand = True ' trigger an operand reset
CASE butMplus ' memory addition clicked
memory = memory + VAL(operand$) ' add current operand to memory
resetoperand = True ' trigger an operand reset
CASE butMminus ' memory subtraction clicked
memory = memory - VAL(operand$) ' subtract current operand from memory
resetoperand = True ' trigger an operand reset
': clear buttons: -----------------------------------------------------------------------------------------
CASE butCE ' clear entry clicked
operand$ = "" ' reset current operand
CASE butC ' clear clicked
operand1 = 0 ' initialize all values
operand2 = 0
operator = 0
previousoperator = 0
operand$ = ""
history$ = ""
CASE butBS ' backspace clicked
IF LEN(operand$) THEN ' characters in operand?
operand$ = LEFT$(operand$, LEN(operand$) - 1) ' yes, remove right-most character
END IF
': calculation buttons: -----------------------------------------------------------------------------------
CASE butReciprocate ' reciprocate clicked
IF VAL(operand$) THEN ' dividing by zero?
ADDHISTORY (operator$(previousoperator) + "Reciproc(" + operand$ + ")")
nohistory = True ' skip operand history next time
operator = EQUATE
operand$ = CLEAN$(1 / VAL(operand$)) ' no, calculate reciprocate
ELSE ' yes, physics will collapse!
ALERT ' get user's attention
operand$ = "Can't divide by zero!" ' report error to user
END IF
resetoperand = True ' trigger an operand reset
CASE butSQR ' square root clicked
IF VAL(operand$) >= 0 THEN ' positive value?
ADDHISTORY (operator$(previousoperator) + "SQRT(" + operand$ + ")")
nohistory = True ' skip operand history next time
operator = EQUATE
operand$ = CLEAN$(SQR(VAL(operand$))) ' yes, calculate square root
ELSE ' no, value is negative
ALERT ' get user's attention
operand$ = "Invalid input!" ' nice try buddy
END IF
resetoperand = True ' trigger an operand reset
CASE butPercent ' percent clicked
operand$ = CLEAN$(operand1 * VAL(operand$) / 100) ' calculate percentage of previous operand
resetoperand = True
CASE butSign ' sign clicked
IF VAL(operand$) THEN ' value equal to zero?
operand$ = CLEAN$(-VAL(operand$)) ' no, reverse sign of operand
END IF
': number buttons: ----------------------------------------------------------------------------------------
CASE but0 ' zero clicked
IF VAL(operand$) OR INSTR(operand$, ".") THEN ' ok to add a zero?
UPDATEOPERAND ("0") ' yes, append zero
END IF
CASE but1 ' one clicked
UPDATEOPERAND ("1") ' append one
CASE but2 ' etc..
UPDATEOPERAND ("2") ' etc..
CASE but3
UPDATEOPERAND ("3")
CASE but4
UPDATEOPERAND ("4")
CASE but5
UPDATEOPERAND ("5")
CASE but6
UPDATEOPERAND ("6")
CASE but7
UPDATEOPERAND ("7")
CASE but8
UPDATEOPERAND ("8")
CASE but9
UPDATEOPERAND ("9")
CASE butPoint
UPDATEOPERAND (".")
': operator buttons: --------------------------------------------------------------------------------------
CASE butDivide ' divide clicked
ADDHISTORY (operator$(previousoperator) + operand$)
operator = DIVISION ' remember operator selected
COMMITOPERAND ' save operand
CASE butMultiply ' multiply clicked
ADDHISTORY (operator$(previousoperator) + operand$)
operator = MULTIPLICATION ' remember operator selected
COMMITOPERAND ' save operand
CASE butSubtract ' subtract clicked
ADDHISTORY (operator$(previousoperator) + operand$)
operator = SUBTRACTION ' remember operator selected
COMMITOPERAND ' save operand
CASE butAdd ' addition clicked
ADDHISTORY (operator$(previousoperator) + operand$)
operator = ADDITION ' remember operator selected
COMMITOPERAND ' save operand
CASE butEqual ' equal clicked
history$ = ""
operator = EQUATE ' remember operator selected
COMMITOPERAND ' save operand
previousoperator = 0
CASE mnuCopy
CASE mnuPaste
CASE mnuAbout
MessageBox "InForm Calculator v1.1" + STRING$(2, 10) + "Terry Ritchie - 08/29/18", Caption(Calculator), MsgBox_Information
CASE lblAnswer
CASE lblMemory
CASE lblHistory
END SELECT
END SUB
SUB __UI_MouseEnter (id AS LONG)
SELECT CASE id
CASE Calculator
CASE frmResults
CASE mnuEdit
CASE mnuHelp
CASE butMC
CASE butMR
CASE butMS
CASE butMplus
CASE butMminus
CASE butBS
CASE butCE
CASE butC
CASE butSign
CASE butSQR
CASE but7
CASE but8
CASE but9
CASE butDivide
CASE butPercent
CASE but4
CASE but5
CASE but6
CASE butMultiply
CASE butReciprocate
CASE but1
CASE but2
CASE but3
CASE butSubtract
CASE but0
CASE butPoint
CASE butAdd
CASE butEqual
CASE mnuCopy
CASE mnuPaste
CASE mnuAbout
CASE lblAnswer
CASE lblMemory
CASE lblHistory
END SELECT
END SUB
SUB __UI_MouseLeave (id AS LONG)
SELECT CASE id
CASE Calculator
CASE frmResults
CASE mnuEdit
CASE mnuHelp
CASE butMC
CASE butMR
CASE butMS
CASE butMplus
CASE butMminus
CASE butBS
CASE butCE
CASE butC
CASE butSign
CASE butSQR
CASE but7
CASE but8
CASE but9
CASE butDivide
CASE butPercent
CASE but4
CASE but5
CASE but6
CASE butMultiply
CASE butReciprocate
CASE but1
CASE but2
CASE but3
CASE butSubtract
CASE but0
CASE butPoint
CASE butAdd
CASE butEqual
CASE mnuCopy
CASE mnuPaste
CASE mnuAbout
CASE lblAnswer
CASE lblMemory
CASE lblHistory
END SELECT
END SUB
SUB __UI_FocusIn (id AS LONG)
SELECT CASE id
CASE butMC
CASE butMR
CASE butMS
CASE butMplus
CASE butMminus
CASE butBS
CASE butCE
CASE butC
CASE butSign
CASE butSQR
CASE but7
CASE but8
CASE but9
CASE butDivide
CASE butPercent
CASE but4
CASE but5
CASE but6
CASE butMultiply
CASE butReciprocate
CASE but1
CASE but2
CASE but3
CASE butSubtract
CASE but0
CASE butPoint
CASE butAdd
CASE butEqual
END SELECT
END SUB
SUB __UI_FocusOut (id AS LONG)
'This event occurs right before a control loses focus.
'To prevent a control from losing focus, set __UI_KeepFocus = True below.
SELECT CASE id
CASE butMC
CASE butMR
CASE butMS
CASE butMplus
CASE butMminus
CASE butBS
CASE butCE
CASE butC
CASE butSign
CASE butSQR
CASE but7
CASE but8
CASE but9
CASE butDivide
CASE butPercent
CASE but4
CASE but5
CASE but6
CASE butMultiply
CASE butReciprocate
CASE but1
CASE but2
CASE but3
CASE butSubtract
CASE but0
CASE butPoint
CASE butAdd
CASE butEqual
END SELECT
END SUB
SUB __UI_MouseDown (id AS LONG)
SELECT CASE id
CASE Calculator
CASE frmResults
CASE mnuEdit
CASE mnuHelp
CASE butMC
CASE butMR
CASE butMS
CASE butMplus
CASE butMminus
CASE butBS
CASE butCE
CASE butC
CASE butSign
CASE butSQR
CASE but7
CASE but8
CASE but9
CASE butDivide
CASE butPercent
CASE but4
CASE but5
CASE but6
CASE butMultiply
CASE butReciprocate
CASE but1
CASE but2
CASE but3
CASE butSubtract
CASE but0
CASE butPoint
CASE butAdd
CASE butEqual
CASE mnuCopy
CASE mnuPaste
CASE mnuAbout
CASE lblAnswer
CASE lblMemory
CASE lblHistory
END SELECT
END SUB
SUB __UI_MouseUp (id AS LONG)
SELECT CASE id
CASE Calculator
CASE frmResults
CASE mnuEdit
CASE mnuHelp
CASE butMC
CASE butMR
CASE butMS
CASE butMplus
CASE butMminus
CASE butBS
CASE butCE
CASE butC
CASE butSign
CASE butSQR
CASE but7
CASE but8
CASE but9
CASE butDivide
CASE butPercent
CASE but4
CASE but5
CASE but6
CASE butMultiply
CASE butReciprocate
CASE but1
CASE but2
CASE but3
CASE butSubtract
CASE but0
CASE butPoint
CASE butAdd
CASE butEqual
CASE mnuCopy
CASE mnuPaste
CASE mnuAbout
CASE lblAnswer
CASE lblMemory
CASE lblHistory
END SELECT
END SUB
SUB __UI_KeyPress (id AS LONG)
'When this event is fired, __UI_KeyHit will contain the code of the key hit.
'You can change it and even cancel it by making it = 0
SELECT CASE id
CASE butMC
CASE butMR
CASE butMS
CASE butMplus
CASE butMminus
CASE butBS
CASE butCE
CASE butC
CASE butSign
CASE butSQR
CASE but7
CASE but8
CASE but9
CASE butDivide
CASE butPercent
CASE but4
CASE but5
CASE but6
CASE butMultiply
CASE butReciprocate
CASE but1
CASE but2
CASE but3
CASE butSubtract
CASE but0
CASE butPoint
CASE butAdd
CASE butEqual
END SELECT
END SUB
SUB __UI_TextChanged (id AS LONG)
SELECT CASE id
CASE lblAnswer
CASE lblMemory
CASE lblHistory
END SELECT
END SUB
SUB __UI_ValueChanged (id AS LONG)
SELECT CASE id
CASE lblAnswer
CASE lblMemory
CASE lblHistory
END SELECT
END SUB
SUB __UI_FormResized
END SUB
'$INCLUDE:'InForm\InForm.ui'
