File "nimocalc.inc"
Path: /nimoclock/inc/nimocalc.inc
File size: 18.13 KB
MIME-type: text/plain
Charset: utf-8
%IDC_INPUT_TEXTBOX = 1011
%IDC_RESULT_LABEL = 1012
%IDC_COMBO_BDHO = 1013
%IDC_HISTORY_TEXTBOX = 1014
MACRO SyntaxError = IIF$(LNG="FR", "Erreur de syntaxe", "Syntax error")
MACRO OutOfBounds = IIF$(LNG="FR", "Hors limite", "Out of bounds")
'--------------------------------------------------------------------------------
FUNCTION ConvertBHO(value AS STRING) AS STRING
'Convert binary / hexadecimal / octal notations to decimal number
LOCAL notation AS STRING, RES AS STRING
notation = LCASE$(LEFT$(value, 1))
RES = UCASE$(MID$(value, 2))
IF notation = "b" THEN ' Binary notation
IF REMOVE$(RES, ANY "01") <> "" THEN
RES = SyntaxError
ELSE
RES = TRIM$(STR$(VAL("&B0" & RES)))
END IF
ELSEIF notation = "h" THEN ' Hexadecimal notation
IF REMOVE$(RES, ANY "0123456789ABCDEF") <> "" THEN
RES = SyntaxError
ELSE
RES = TRIM$(STR$(VAL("&H0" & RES)))
END IF
ELSEIF notation = "o" THEN ' Octal notation
IF REMOVE$(RES, ANY "01234567") <> "" THEN
RES = SyntaxError
ELSE
RES = TRIM$(STR$(VAL("&O0" & RES)))
END IF
END IF
FUNCTION = RES
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
FUNCTION FormattedEval(Equation AS STRING, bdho AS LONG) AS STRING
'Top-level function: formats the result of a mathematic
'expression evaluated thanks to the Eval() function
LOCAL RES AS STRING
LOCAL integ AS STRING
LOCAL decim AS STRING
LOCAL pwr AS STRING
LOCAL period AS INTEGER
LOCAL ten AS INTEGER
LOCAL value AS EXT
LOCAL i AS LONG
IF TRIM$(Equation) = "" THEN
FUNCTION = ""
EXIT FUNCTION
END IF
RES = Eval(Equation)
IF INSTR(RES, SyntaxError) <> 0 THEN
FUNCTION = SyntaxError
EXIT FUNCTION
ELSEIF INSTR(RES, OutOfBounds) <> 0 THEN
FUNCTION = OutOfBounds
EXIT FUNCTION
END IF
' formatting the result (res) nicely
period = INSTR(RES, ".")
ten = INSTR(RES, "E")
IF bdho <> 2 AND (period > 0 OR ten > 0) THEN ' Bin, Hex and Oct don't support floats or exponents
FUNCTION = OutOfBounds
EXIT FUNCTION
END IF
IF period = 1 THEN ' res = .123456
RES = "0" & RES
INCR period
END IF
IF ten = 0 THEN
ten = LEN(RES)
pwr = ""
ELSE
pwr = $SPC & MID$(RES, ten)
DECR ten
END IF
IF period = 0 THEN ' integer number
integ = LEFT$(RES, ten)
decim = ""
ELSE ' floating point number
integ = LEFT$(RES, period - 1)
decim = MID$(RES, period + 1, ten - period)
decim = LEFT$(decim, 6)
END IF
value = VAL(integ)
IF bdho <> 2 AND ABS(value) >= 2^32 THEN ' Bin, Hex and Oct cannot represent an integer >= 2^32
FUNCTION = OutOfBounds
EXIT FUNCTION
END IF
SELECT CASE bdho
CASE 1 : ' Bin
integ = BIN$(value)
IF LEN(integ) MOD 4 <> 0 THEN integ = STRING$(4 - LEN(integ) MOD 4, "0") & integ
FOR i = LEN(integ) - 3 TO 4 STEP -4
integ = LEFT$(integ, i-1) & $SPC & MID$(integ, i)
NEXT
integ = "b" & integ
CASE 2 : ' Dec
integ = FORMAT$(value, "#,")
REPLACE "," WITH $SPC IN integ
CASE 3 : ' Hex
integ = HEX$(value)
IF LEN(integ) MOD 2 = 1 THEN integ = "0" & integ
FOR i = LEN(integ) - 1 TO 3 STEP -2
integ = LEFT$(integ, i-1) & $SPC & MID$(integ, i)
NEXT
integ = "h" & integ
CASE 4 : ' Oct
integ = OCT$(value)
i = LEN(integ) - 2
WHILE i > 1
integ = LEFT$(integ, i-1) & $SPC & MID$(integ, i)
i = i - 3
WEND
integ = "o" & integ
END SELECT
IF period = 0 THEN ' integer number
RES = integ & pwr
ELSE ' floating point number
RES = integ & IIF$(LNG="FR", " , ", " . ") & decim & pwr
END IF
FUNCTION = Equation & " = " & RES
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
FUNCTION Eval(Equation AS STRING) AS STRING
'Clean up then evaluate a full written expression, chunk by chunk
'(a chunk = a content between parentheses), thanks to Solve()
LOCAL RES AS STRING
LOCAL TmpEquation AS STRING
LOCAL Chunk AS STRING
LOCAL OpenBracket AS INTEGER, CloseBracket AS INTEGER
TmpEquation = Equation
REPLACE $SPC WITH "" IN TmpEquation
' user typed "=" somewhere (or copied/pasted from history) -> syntax error
IF INSTR(TmpEquation, "=") <> 0 THEN
FUNCTION = SyntaxError
EXIT FUNCTION
END IF
' user typed an operand / * ^ at beginning of line -> syntax error
IF INSTR("*/^", LEFT$(TmpEquation, 1)) <> 0 THEN
FUNCTION = SyntaxError
EXIT FUNCTION
END IF
' user typed several operands but without any number -> syntax error
IF TALLY(TmpEquation, ANY "*/^+-") > 1 AND TALLY(TmpEquation, ANY "0123456789") = 0 THEN
FUNCTION = SyntaxError
EXIT FUNCTION
END IF
' user typed + or - at beginning of line -> ignore
IF LEN(TmpEquation) = 1 AND INSTR("+-", TmpEquation) <> 0 THEN
FUNCTION = "0"
EXIT FUNCTION
END IF
' french decimal delimiter is "," -> replace it with "."
REPLACE "," WITH "." IN TmpEquation
' handle percentages
REPLACE "%" WITH "/100" IN TmpEquation
' complete number of opening brackets with closing brackets if different
OpenBracket = TALLY(TmpEquation, "(")
CloseBracket = TALLY(TmpEquation, ")")
IF OpenBracket > CloseBracket THEN TmpEquation = TmpEquation & STRING$(OpenBracket-CloseBracket, ")")
IF CloseBracket > OpenBracket THEN TmpEquation = STRING$(CloseBracket-OpenBracket, "(") & TmpEquation
' replace ")(" with ")*("
REPLACE ")(" WITH ")*(" IN TmpEquation
' if user is typing a new operand (at end of line) then ignore it :
WHILE INSTR("*+-/^(", RIGHT$(TmpEquation,1)) <> 0 AND TmpEquation <> ""
TmpEquation = LEFT$(TmpEquation, LEN(TmpEquation)-1)
WEND
' if user is typing a new operand (in MIDDLE of line, before a closing bracket) then ignore it :
REPLACE "-)" WITH ")" IN TmpEquation
REPLACE "*)" WITH ")" IN TmpEquation
REPLACE "/)" WITH ")" IN TmpEquation
REPLACE "+)" WITH ")" IN TmpEquation
REPLACE "^)" WITH ")" IN TmpEquation
' be a little permissive with opening bracket as well
REPLACE "(*" WITH "(" IN TmpEquation
REPLACE "(/" WITH "(" IN TmpEquation
REPLACE "(^" WITH "(" IN TmpEquation
REPLACE "*" WITH " * " IN TmpEquation
REPLACE "+" WITH " + " IN TmpEquation
REPLACE "-" WITH " - " IN TmpEquation
REPLACE "/" WITH " / " IN TmpEquation
REPLACE "^" WITH " ^ " IN TmpEquation
REPLACE "(" WITH " ( " IN TmpEquation
REPLACE ")" WITH " ) " IN TmpEquation
WHILE INSTR(TmpEquation, SPACE$(2)) <> 0
REPLACE SPACE$(2) WITH $SPC IN TmpEquation
WEND
TmpEquation = TRIM$(TmpEquation)
' leading minus
IF LEFT$(TmpEquation, 2) = "- " THEN TmpEquation = "-" & RIGHT$(TmpEquation, LEN(TmpEquation) - 2)
REPLACE "* - " WITH "* -" IN TmpEquation
REPLACE "/ - " WITH "/ -" IN TmpEquation
REPLACE "+ - " WITH "- " IN TmpEquation
REPLACE "- - " WITH "+ " IN TmpEquation
REPLACE "^ - " WITH "^ -" IN TmpEquation
REPLACE "( - " WITH "( -" IN TmpEquation
' leading plus
IF LEFT$(TmpEquation, 2) = "+ " THEN TmpEquation = RIGHT$(TmpEquation, LEN(TmpEquation) - 2)
REPLACE "* + " WITH "* " IN TmpEquation
REPLACE "/ + " WITH "/ " IN TmpEquation
REPLACE "+ + " WITH "+ " IN TmpEquation
REPLACE "- + " WITH "- " IN TmpEquation
REPLACE "^ + " WITH "^ " IN TmpEquation
REPLACE "( + " WITH "( " IN TmpEquation
' expression is all cleaned up and good to go -> parse it in main loop!
DO
CloseBracket = INSTR(TmpEquation, ")")
IF CloseBracket = 0 THEN
RES = Solve(TmpEquation)
EXIT LOOP
END IF
FOR OpenBracket = CloseBracket TO 1 STEP -1
IF MID$(TmpEquation, OpenBracket, 1) = "(" THEN EXIT FOR
NEXT OpenBracket
Chunk = MID$(TmpEquation, OpenBracket + 1, CloseBracket - OpenBracket - 1)
REPLACE "(" & Chunk & ")" WITH Solve(Chunk) IN TmpEquation
IF INSTR(TmpEquation, SyntaxError) <> 0 THEN
RES = SyntaxError
EXIT LOOP
ELSEIF INSTR(TmpEquation, OutOfBounds) <> 0 THEN
RES = OutOfBounds
EXIT LOOP
END IF
LOOP
FUNCTION = RES
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
FUNCTION Solve(inEquation AS STRING) AS STRING
'Solve an equation following an operand priority policy, thanks
'ro recursive calls to the TreatFirstOperand() function
LOCAL TmpEq AS STRING
LOCAL notation AS STRING
LOCAL m AS INTEGER
LOCAL n AS INTEGER
TmpEq = TRIM$(InEquation)
IF TmpEq = "" THEN
FUNCTION = "0"
EXIT FUNCTION
END IF
' operand at end of line -> syntax error
' operand at beginning of line -> syntax error (except "-")
IF INSTR("*+-/^(", RIGHT$(TmpEq,1)) <> 0 OR _
INSTR("*+/^(", LEFT$(TmpEq,1)) <> 0 THEN
FUNCTION = SyntaxError
EXIT FUNCTION
END IF
' treat all operations in order of operands priority :
' first, power operand ^
WHILE INSTR(TmpEq, " ^ ") <> 0
TmpEq = TreatFirstOperand(TmpEq, "^") : GOSUB checkErr
WEND
' then, multiply * and divide / (in same priority, from left to right)
m = INSTR(TmpEq, " * ")
n = INSTR(TmpEq, " / ")
WHILE m <> 0 OR n <> 0
IF m = 0 THEN m = LEN(TmpEq)
IF n = 0 THEN n = LEN(TmpEq)
IF m < n THEN
TmpEq = TreatFirstOperand(TmpEq, "*") : GOSUB checkErr
ELSE
TmpEq = TreatFirstOperand(TmpEq, "/") : GOSUB checkErr
END IF
m = INSTR(TmpEq, " * ")
n = INSTR(TmpEq, " / ")
WEND
' finally, addition + and substraction - (in same priority, from left to right)
m = INSTR(TmpEq, " + ")
n = INSTR(TmpEq, " - ")
WHILE m <> 0 OR n <> 0
IF m = 0 THEN m = LEN(TmpEq)
IF n = 0 THEN n = LEN(TmpEq)
IF m < n THEN
TmpEq = TreatFirstOperand(TmpEq, "+") : GOSUB checkErr
ELSE
TmpEq = TreatFirstOperand(TmpEq, "-") : GOSUB checkErr
END IF
m = INSTR(TmpEq, " + ")
n = INSTR(TmpEq, " - ")
WEND
' now all that is left is a number, is it represented in non-decimal notation? if yes convert it
IF INSTR("bho", LCASE$(LEFT$(TmpEq, 1))) <> 0 THEN TmpEq = ConvertBHO(TmpEq)
IF REMOVE$(TmpEq, ANY "0123456789.E+-") <> "" THEN
FUNCTION = SyntaxError
EXIT FUNCTION
END IF
FUNCTION = TmpEq
EXIT FUNCTION
checkErr:
'-------
IF INSTR(TmpEq, SyntaxError) <> 0 THEN
FUNCTION = SyntaxError
EXIT FUNCTION
ELSEIF INSTR(TmpEq, OutOfBounds) <> 0 THEN
FUNCTION = OutOfBounds
EXIT FUNCTION
END IF
RETURN
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
FUNCTION TreatFirstOperand(oneEquation AS STRING, Oper AS STRING) AS STRING
'Solve a single operation for the first occurence of the operand 'Oper'
LOCAL oneEq AS STRING
LOCAL Result AS DOUBLE
LOCAL Space1 AS INTEGER, Space2 AS INTEGER, Space3 AS INTEGER
LOCAL Cond1 AS STRING, Cond2 AS STRING, notation AS STRING
LOCAL value1 AS EXT, value2 AS EXT
oneEq = TRIM$(oneEquation)
Space2 = INSTR(oneEq, $SPC & Oper & $SPC)
IF Space2 <> 0 THEN
Space1 = INSTR(Space2 - LEN(oneEq) - 2, oneEq, $SPC) + 1
Space3 = INSTR(Space2 + 3, oneEq, $SPC)
IF Space3 = 0 THEN Space3 = LEN(oneEq) ELSE DECR Space3
Cond1 = MID$(oneEq, Space1, Space2 - Space1)
Cond2 = MID$(oneEq, Space2 + 3, Space3 - Space2 - 2)
IF INSTR("bho", LCASE$(LEFT$(Cond1, 1))) <> 0 THEN Cond1 = ConvertBHO(Cond1)
IF INSTR("bho", LCASE$(LEFT$(Cond2, 1))) <> 0 THEN Cond2 = ConvertBHO(Cond2)
IF INSTR(Cond1, ANY "0123456789") = 0 OR _
INSTR(Cond2, ANY "0123456789") = 0 THEN
FUNCTION = SyntaxError
EXIT FUNCTION
END IF
value1 = VAL(Cond1)
value2 = VAL(Cond2)
SELECT CASE Oper
CASE "^" :
IF (value1 < 0 AND FRAC(value2) <> 0) OR (value1 > 1 AND ABS(value2 * LOG(value1)) > 11355) THEN
FUNCTION = OutOfBounds
EXIT FUNCTION
END IF
Result = value1 ^ value2
CASE "*" :
IF LOG(ABS(value1)) + LOG(ABS(value2)) > 1135 THEN
FUNCTION = OutOfBounds
EXIT FUNCTION
END IF
Result = value1 * value2
CASE "/" :
IF value2 <> 0 THEN Result = value1 / value2 ELSE Result = 0
CASE "+" :
Result = value1 + value2
CASE "-" :
Result = value1 - value2
END SELECT
REPLACE MID$(oneEq, Space1, Space3 - Space1 + 1) WITH TRIM$(STR$(Result)) IN oneEq
END IF
FUNCTION = oneEq
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
CALLBACK FUNCTION ProcCalcDialog()
LOCAL equation AS STRING
LOCAL n AS INTEGER
LOCAL i AS LONG, j AS LONG, bdho AS LONG
STATIC buffer AS STRING
STATIC result AS STRING
SELECT CASE CB.MSG
CASE %WM_INITDIALOG
CONTROL SET FOCUS CB.HNDL, %IDC_INPUT_TEXTBOX
DIALOG POST CB.HNDL, %WM_USER, 0, 0
CASE %WM_USER
SLEEP 500
SetForegroundWindow CB.HNDL
CASE %WM_SIZE ' user resized the window
IF CB.WPARAM = %SIZE_MAXIMIZED OR CB.WPARAM = %SIZE_RESTORED THEN
' First let's check if the window has been downsized to an unusable size.
' I reckon the minimum usable size (no overlapped or collapsed controls, etc.) is 200 x 76 dialog units
' If the user tried to resize smaller than that, we'll restore the dialog to those dimensions.
' Always go out of your way to protect inept users from themselves.
DIALOG GET SIZE CB.HNDL TO i, j
i = MAX(200, i)
j = MAX(76, j)
DIALOG SET SIZE CB.HNDL, i, j
' Now resize and move controls as appropriate
CONTROL SET SIZE CB.HNDL, %IDC_INPUT_TEXTBOX, i - 9, 15
CONTROL SET SIZE CB.HNDL, %IDC_RESULT_LABEL, i - 9 - 32, 15
CONTROL SET LOC CB.HNDL, %IDC_COMBO_BDHO, i - 36, 20
CONTROL SET SIZE CB.HNDL, %IDC_HISTORY_TEXTBOX, i - 9, j - 64
' Invalidate and redraw the dialog to prevent graphic glitches
DIALOG REDRAW CB.HNDL
END IF
CASE %WM_COMMAND
SELECT CASE CB.CTL
CASE %IDC_COMBO_BDHO
IF CB.CTLMSG = %CBN_SELENDOK THEN
CONTROL GET TEXT CB.HNDL, %IDC_INPUT_TEXTBOX TO equation
COMBOBOX GET SELECT CB.HNDL, %IDC_COMBO_BDHO TO bdho
result = FormattedEval(equation, bdho)
CONTROL SET TEXT CB.HNDL, %IDC_RESULT_LABEL, result
CONTROL SET FOCUS CB.HNDL, %IDC_INPUT_TEXTBOX
END IF
CASE %IDC_INPUT_TEXTBOX
IF CB.CTLMSG = %EN_CHANGE THEN
CONTROL GET TEXT CB.HNDL, %IDC_INPUT_TEXTBOX TO equation
n = INSTR(equation, $CRLF)
IF n = 0 THEN ' user typed something
IF equation <> buffer THEN
buffer = equation
COMBOBOX GET SELECT CB.HNDL, %IDC_COMBO_BDHO TO bdho
result = FormattedEval(buffer, bdho)
CONTROL SET TEXT CB.HNDL, %IDC_RESULT_LABEL, result
END IF
ELSE ' user hit Return key
IF result <> "" AND result <> SyntaxError AND result <> OutOfBounds THEN
CONTROL GET TEXT CB.HNDL, %IDC_HISTORY_TEXTBOX TO buffer
CONTROL SET TEXT CB.HNDL, %IDC_HISTORY_TEXTBOX, result & $CRLF & buffer
buffer = ""
result = ""
CONTROL SET TEXT CB.HNDL, %IDC_INPUT_TEXTBOX, ""
CONTROL SET TEXT CB.HNDL, %IDC_RESULT_LABEL, ""
ELSE
CONTROL SET TEXT CB.HNDL, %IDC_INPUT_TEXTBOX, REMOVE$(equation, $CRLF)
END IF
END IF
END IF
END SELECT
END SELECT
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
THREAD FUNCTION ShowCalcDialog(BYVAL noVar AS DWORD) AS LONG
LOCAL lRslt AS LONG
LOCAL w AS LONG, h AS LONG, i AS LONG
LOCAL hDlg AS DWORD
LOCAL hFont0 AS DWORD
LOCAL bdho() AS STRING
DIALOG NEW 0, "nimo calc", , , 264, 96, %WS_MINIMIZEBOX OR %WS_SYSMENU _
OR %WS_THICKFRAME OR %WS_EX_LEFT, TO hDlg
DIALOG SET ICON hDlg, "ICO2"
DIM bdho(1 TO 4)
ARRAY ASSIGN bdho() = "Bin", "Dec", "Hex", "Oct"
CONTROL ADD TEXTBOX, hDlg, %IDC_INPUT_TEXTBOX, "", 2, 5, 255, 15, %WS_BORDER OR _
%ES_MULTILINE OR %ES_WANTRETURN OR %ES_AUTOVSCROLL
CONTROL ADD LABEL, hDlg, %IDC_RESULT_LABEL, "", 2, 20, 230, 15, %SS_NOWORDWRAP
CONTROL ADD COMBOBOX, hDlg, %IDC_COMBO_BDHO, bdho(), 232, 20, 30, 20*4, _
%CBS_DROPDOWNLIST OR %CBS_HASSTRINGS OR %WS_TABSTOP
COMBOBOX SELECT hDlg, %IDC_COMBO_BDHO, 2 ' Dec
CONTROL ADD TEXTBOX, hDlg, %IDC_HISTORY_TEXTBOX, "", 2, 35, 255, 40, _
%ES_MULTILINE OR %ES_READONLY OR %WS_VSCROLL
FONT NEW "Tahoma", 12, 1 TO hFont0
CONTROL SET FONT hDlg, %IDC_INPUT_TEXTBOX, hFont0
CONTROL SET FONT hDlg, %IDC_RESULT_LABEL, hFont0
CONTROL SET FONT hDlg, %IDC_HISTORY_TEXTBOX, hFont0
DIALOG SHOW MODAL hDlg, CALL ProcCalcDialog TO lRslt
FONT END hFont0
FUNCTION = lRslt
END FUNCTION
'--------------------------------------------------------------------------------