Simppeli testiviritelmä laskimen toteuttamisesta LibreOffice - Basic ympäristössä.
' Projektin komponentit:
' Valintaikkuna (Dialog1)
' Valintaikkunan ohjausobjektit:
' 1 Selitekenttä (Label1)
' Ominaisuudet: Tasaus -> Oikea, taustaväri Valkoinen
' 19 Painiketta (CommandButton1 - CommandButton19)
' Selitteet: (painikkeessa näkyvä teksti)
' 1 - 9, 0, CE, /, X , , (pilkku), -, +, (, ), =
' Lisätietoja (Tag arvo) sama kuin painikkeen teksti
' paitsi X jonka tag -arvoksi tulee *
' Jokainen painike on sidottu tapahtumiin seuraavasti:
' Näppäintä painettu -> ButtonKeyDown
' Näppäin vapautettu -> ButtonKeyUp
' Hiiren painiketta painettu -> ButtonMouseDown
' Hiiren painike vapautettu -> ButtonMouseUp
'Module1:
REM ***** STARBASIC CALCULAATTORI *****
REM LICENCE DWYFW (Tee mitä *****a ikinä haluat)
Private oDlg As Object
Private oDisplay As Object
Private LastActive As Object
Sub ShowDialog
DialogLibraries.LoadLibrary("Standard")
oDlg = CreateUnoDialog(DialogLibraries.Standard.Dialog1)
oDisplay = oDlg.getControl("Label1")
CenterDialog
oDlg.execute()
oDlg.dispose()
End Sub
Sub CenterDialog
Dim oSize As New com.sun.star.awt.Size, factor As Double
Dim oCC, oComponentWindow, oTopWindowPosSize
oCC = ThisComponent.getCurrentController()
oComponentWindow = oCC.ComponentWindow
oTopWindowPosSize = oComponentWindow.Toolkit.ActiveTopWindow.getPosSize()
oSize.Width = oDlg.Model.Width
oSize.Height = oDlg.Model.Height
factor = oSize.Width / oDlg.convertSizeToPixel(oSize, com.sun.star.util.MeasureUnit.APPFONT).Width
With oDlg.Model
.PositionX = (factor * oTopWindowPosSize.Width - .Width) / 2
.PositionY = (factor * oTopWindowPosSize.Height - .Height) / 2
End With
End Sub
Sub ButtonMouseDown(oEvent)
If oEvent.Buttons = 2 Then Exit Sub
oEvent.Source.setFocus()
End Sub
Sub ButtonMouseUp(oEvent)
If oEvent.Buttons = 2 Then Exit Sub
HandleKeyChars oEvent.Source.Model.Tag
Validation
End Sub
Sub Validation
If InStr(oDisplay.Model.Label, "=") > 0 Then
oDisplay.Model.Label = Replace(oDisplay.Model.Label, "=", "")
End If
If Left(oDisplay.Model.Label,1) = "=" Then
oDisplay.Model.Label = ""
ElseIf Left(oDisplay.Model.Label,1) = "+" Then
oDisplay.Model.Label = ""
ElseIf Left(oDisplay.Model.Label,1) = "/" Then
oDisplay.Model.Label = ""
ElseIf Left(oDisplay.Model.Label,1) = "*" Then
oDisplay.Model.Label = ""
ElseIf Left(oDisplay.Model.Label,1) = ")" Then
oDisplay.Model.Label = ""
End If
If Len(oDisplay.Model.Label) = 2 Then
If oDisplay.Model.Label = "--" Then
oDisplay.Model.Label = "-"
ElseIf oDisplay.Model.Label = "-(" Then
oDisplay.Model.Label = "-"
ElseIf oDisplay.Model.Label = "-)" Then
oDisplay.Model.Label = "-"
ElseIf oDisplay.Model.Label = "-/" Then
oDisplay.Model.Label = "-"
ElseIf oDisplay.Model.Label = "-*" Then
oDisplay.Model.Label = "-"
ElseIf oDisplay.Model.Label = "-+" Then
oDisplay.Model.Label = "-"
End If
End If
If Len(oDisplay.Model.Label) > 2 Then
If Right(oDisplay.Model.Label, 2) = "-)" Then
oDisplay.Model.Label = Left(oDisplay.Model.Label, Len(oDisplay.Model.Label) - 1)
ElseIf Right(oDisplay.Model.Label, 2) = "-/" Then
oDisplay.Model.Label = Left(oDisplay.Model.Label, Len(oDisplay.Model.Label) - 1)
ElseIf Right(oDisplay.Model.Label, 2) = "-*" Then
oDisplay.Model.Label = Left(oDisplay.Model.Label, Len(oDisplay.Model.Label) - 1)
ElseIf Right(oDisplay.Model.Label, 2) = "-+" Then
oDisplay.Model.Label = Left(oDisplay.Model.Label, Len(oDisplay.Model.Label) - 1)
ElseIf Right(oDisplay.Model.Label, 2) = "-)" Then
oDisplay.Model.Label = Left(oDisplay.Model.Label, Len(oDisplay.Model.Label) - 1)
ElseIf Right(oDisplay.Model.Label, 3) = "---" Then
oDisplay.Model.Label = Left(oDisplay.Model.Label, Len(oDisplay.Model.Label) - 2)
End If
End If
If Len(oDisplay.Model.Label) > 2 Then
Dim slock As Integer, elock As Integer
For i% = 1 To Len(oDisplay.Model.Label)
If Mid(oDisplay.Model.Label, i, 1) = "(" Then
slock = slock + 1
ElseIf Mid(oDisplay.Model.Label, i, 1) = ")" Then
elock = elock + 1
End If
If elock > slock Then
oDisplay.Model.Label = Left(oDisplay.Model.Label, Len(oDisplay.Model.Label) - 1)
End If
Next i
If Right(oDisplay.Model.Label, 3) = "---" Then
oDisplay.Model.Label = Left(oDisplay.Model.Label, Len(oDisplay.Model.Label) - 1)
End If
End If
End Sub
Sub ButtonKeyDown(oEvent)
Dim keyChar As String
oEvent.Source.setFocus()
Select Case oEvent.KeyCode - 256
Case 1
keyChar = "1"
oDlg.getControl("CommandButton" & keyChar).setFocus()
Case 2
keyChar = "2"
oDlg.getControl("CommandButton" & keyChar).setFocus()
Case 3
keyChar = "3"
oDlg.getControl("CommandButton" & keyChar).setFocus()
Case 4
keyChar = "4"
oDlg.getControl("CommandButton" & keyChar).setFocus()
Case 5
keyChar = "5"
oDlg.getControl("CommandButton" & keyChar).setFocus()
Case 6
keyChar = "6"
oDlg.getControl("CommandButton" & keyChar).setFocus()
Case 7
keyChar = "7"
oDlg.getControl("CommandButton" & keyChar).setFocus()
Case 8
keyChar = "8"
oDlg.getControl("CommandButton" & keyChar).setFocus()
Case 9
keyChar = "9"
oDlg.getControl("CommandButton" & keyChar).setFocus()
Case 0
keyChar = "0"
oDlg.getControl("CommandButton10").setFocus()
Case Else
keyChar = ""
End Select
If oEvent.Modifiers AND 1 And oEvent.KeyCode - 256 = 7 Then
keyChar = "/"
oDlg.getControl("CommandButton16").setFocus()
ElseIf oEvent.Modifiers AND 1 And oEvent.KeyCode - 256 = 8 Then
keyChar = "("
oDlg.getControl("CommandButton18").setFocus()
ElseIf oEvent.Modifiers AND 1 And oEvent.KeyCode - 256 = 9 Then
keyChar = ")"
oDlg.getControl("CommandButton19").setFocus()
ElseIf oEvent.Modifiers AND 1 And oEvent.KeyCode - 256 = 0 Then
keyChar = "="
oDlg.getControl("CommandButton15").setFocus()
End If
If oEvent.KeyCode = 1280 Then
keyChar = "="
oDlg.getControl("CommandButton15").setFocus()
ElseIf oEvent.KeyCode = 1283 Then
keyChar = "CE"
oDlg.getControl("CommandButton17").setFocus()
ElseIf oEvent.KeyCode = 1287 Then
keyChar = "+"
oDlg.getControl("CommandButton11").setFocus()
ElseIf oEvent.KeyCode = 1288 Then
keyChar = "-"
oDlg.getControl("CommandButton12").setFocus()
ElseIf oEvent.KeyCode = 1292 Or oEvent.KeyCode = 1309 Then
keyChar = ","
oDlg.getControl("CommandButton14").setFocus()
ElseIf oEvent.KeyCode = 1318 Then
keyChar = "*"
oDlg.getControl("CommandButton13").setFocus()
End If
If keyChar <> "" Then
HandleKeyChars keyChar
End If
End Sub
Sub ButtonKeyUp(oEvent)
Validation
End Sub
Sub HandleKeyChars(key As String)
Dim calcStr As String, i As Integer
calcStr = oDisplay.Model.Label
oDisplay.Model.Label = calcStr
If Len(oDisplay.Model.Label) = 1 Then
Select Case oDisplay.Model.Label
Case "/", "*", "+", ","
oDisplay.Model.Label = "" : Exit Sub
Case Else
End Select
End If
Dim pairs() As String
pairs = Split("/,+,*",",")
If Len(calcStr) > 1 Then
Dim hlp As String : hlp = Mid(calcStr, Len(calcStr) - 1, 1)
If hlp = "+" Or hlp = "-" Or hlp = "/" Or hlp = "*" Or hlp = "," Then
For i = 0 To Ubound(pairs)
If Right(calcStr, 1) = pairs(i) Then
calcStr = Left(calcStr, Len(calcStr) - 1)
oDisplay.Model.Label = calcStr : Exit Sub
End If
Next I
End If
End If
calcStr = Replace(calcStr, "++", "+")
calcStr = Replace(calcStr, "+-", "+")
calcStr = Replace(calcStr, "+/", "+")
calcStr = Replace(calcStr, "+*", "+")
If Len(calcStr) > 1 And Right(calcStr, 2) = "++" Then
calcStr = Left(calcStr, Len(calcStr) -1)
oDisplay.Model.Label = calcStr
End If
Dim lpCnt As Integer, rpCnt As Integer
If Len(calcStr) > 0 Then
For i = 1 to Len(calcStr)
If Mid(calcStr, i, 1) = "(" Then lpCnt = lpCnt + 1
If Mid(calcStr, i, 1) = ")" Then rpCnt = rpCnt + 1
Next i
If rpCnt > lpCnt Then
oDisplay.Model.Label = Left(calcStr, Len(calcStr) -1)
End If
End If
If key = "=" And Len(calcStr) > 2 Then
If Right(oDisplay.Model.Label, 1) = "/" Or Right(oDisplay.Model.Label, 1) = "*" _
Or Right(oDisplay.Model.Label, 1) = "-" Or Right(oDisplay.Model.Label, 1) = "+" _
Or Right(oDisplay.Model.Label, 1) = "(" Then
oDisplay.Model.Align = 1
oDisplay.Model.Label = "VIRHE: lopussa " & Right(oDisplay.Model.Label, 1)
Wait 1500
oDisplay.Model.Align = 2
oDisplay.Model.Label = ""
Exit Sub
End If
oDisplay.Model.Label = EvalExpr(calcStr) : Exit Sub
End If
If key = "CE" Then
oDisplay.Model.Label = "" : Exit Sub
End If
If key = "(" Then
If Right(oDisplay.Model.Label, 1) <> "+" And Right(oDisplay.Model.Label, 1) <> "-" And _
Right(oDisplay.Model.Label, 1) <> "/" And Right(oDisplay.Model.Label, 1) <> "*" Then
If Len(oDisplay.Model.Label) > 0 Then Exit Sub
End If
End If
If key = ")" Then
If Right(oDisplay.Model.Label, 1) = "+" Or Right(oDisplay.Model.Label, 1) = "-" Or _
Right(oDisplay.Model.Label, 1) = "/" Or Right(oDisplay.Model.Label, 1) = "*" Or _
oDisplay.Model.Label = "" And InStr(oDisplay.Model.Label, ")") = 0 And _
Instr(oDisplay.Model.Label,"/") = 0 And Instr(oDisplay.Model.Label,"*") = 0 And _
Instr(oDisplay.Model.Label,"-") = 0 And Instr(oDisplay.Model.Label,"+") = 0 Then
Exit Sub
End If
End If
If Right(oDisplay.Model.Label, 1) = "(" Then
If key = "/" Or key = "*" Or key = "+" Then
Exit Sub
End If
End If
If Right(oDisplay.Model.Label, 1) = "(" And key = ")" Then Exit Sub
oDisplay.Model.Label = oDisplay.Model.Label & key
End Sub
' PARSERI
' (kykenee hieman enempään ja vähän päälle sen
' mitä jaksoin lätkiä nappeja esimerkkiprojektiin)
' Tukee: + - * / ^, sulut, negatiiviset luvut,
' desimaalit, funktiot (SIN, COS, ABS...)
Function EvalExpr(expr As String) As Double
Dim tokens As Variant
tokens = Tokenize(expr)
EvalExpr = ParseExpression(tokens, 0)
End Function
Function Tokenize(expr As String) As Variant
expr = UCase(Replace(expr, " ", ""))
expr = Replace(expr, ",", ".") ' pilkku → piste
Dim out() As String
ReDim out(0)
Dim num As String
num = ""
Dim i As Long
For i = 1 To Len(expr)
Dim ch As String
ch = Mid(expr, i, 1)
If ch >= "A" And ch <= "Z" Then
num = num & ch
GoTo NextChar
End If
If InStr("0123456789.", ch) > 0 Then
num = num & ch
GoTo NextChar
End If
If num <> "" Then
out(UBound(out)) = num
ReDim Preserve out(UBound(out) + 1)
num = ""
End If
out(UBound(out)) = ch
ReDim Preserve out(UBound(out) + 1)
NextChar:
Next
If num <> "" Then out(UBound(out)) = num
Tokenize = out
End Function
Function ParseExpression(tokens As Variant, ByRef pos As Long) As Double
Dim value As Double
value = ParseTerm(tokens, pos)
Do While pos <= UBound(tokens)
Dim op As String
op = tokens(pos)
If op = "+" Then
pos = pos + 1
value = value + ParseTerm(tokens, pos)
ElseIf op = "-" Then
pos = pos + 1
value = value - ParseTerm(tokens, pos)
Else
Exit Do
End If
Loop
ParseExpression = value
End Function
Function ParseTerm(tokens As Variant, ByRef pos As Long) As Double
Dim value As Double
value = ParsePower(tokens, pos)
Do While pos <= UBound(tokens)
Dim op As String
op = tokens(pos)
If op = "*" Then
pos = pos + 1
value = value * ParsePower(tokens, pos)
ElseIf op = "/" Then
pos = pos + 1
value = value / ParsePower(tokens, pos)
Else
Exit Do
End If
Loop
ParseTerm = value
End Function
Function ParsePower(tokens As Variant, ByRef pos As Long) As Double
Dim value As Double
value = ParseFactor(tokens, pos)
Do While pos <= UBound(tokens)
If tokens(pos) = "^" Then
pos = pos + 1
value = value ^ ParseFactor(tokens, pos)
Else
Exit Do
End If
Loop
ParsePower = value
End Function
Function ParseFactor(tokens As Variant, ByRef pos As Long) As Double
Dim token As String
token = tokens(pos)
If token = "-" Then
pos = pos + 1
ParseFactor = -ParseFactor(tokens, pos)
Exit Function
End If
If token >= "A" And token <= "Z" Then
Dim func As String
func = token
pos = pos + 1
pos = pos + 1 ' ohita "("
Dim val As Double
val = ParseExpression(tokens, pos)
pos = pos + 1 ' ohita ")"
Select Case func
Case "SIN": ParseFactor = Sin(val)
Case "COS": ParseFactor = Cos(val)
Case "TAN": ParseFactor = Tan(val)
Case "ABS": ParseFactor = Abs(val)
Case "SQRT": ParseFactor = Sqr(val)
Case "LOG": ParseFactor = Log(val)
Case "EXP": ParseFactor = Exp(val)
Case "ROUND": ParseFactor = Round(val)
Case Else: ParseFactor = 0
End Select
Exit Function
End If
If token = "(" Then
pos = pos + 1
Dim v As Double
v = ParseExpression(tokens, pos)
pos = pos + 1 ' ohita ")"
ParseFactor = v
Exit Function
End If
ParseFactor = CDbl(Replace(token, ".", ","))
pos = pos + 1
End FunctionKuvaus ja toiminto selviää katsomalla tämän
Halutessaan valmiin testiprojektin voi imaista täältä
HV (hyvää vappua jo etukäteen)
Toisaalta on niin, että LibreOffice sisältää myös Calc taulukkolaskentaohjelman, jolloin sitä kannattaa käyttää siihen mihin se on tarkoitettu eli laskemaan. LibreOffice mahdollistaa instanssin luomisen mistä tahansa siihen kuuluvasta ohjelmasta joka voidaan avata näkymättömänä ja käyttää välityspalvelimena esim. Writer projektin ja Calc projektin välillä. Voit käyttää edellisen testiprojektin käyttöliittymää pohjana, sisällyttää siihen lisää painikkeita joiden avulla saat lisättyä kaavaan operandeja mielesi mukaan. Calc kykenee suurin piirtein mihin tahansa matemaattiseen operaatioon ja vältyt mahdollisilta virheiltä oman parsijan rakentelussa. Tallenna kopio edellisestä testiprojektista, avaa Module1 ja vaihda koko koodi tähän (ei tarvitse etsiä/korvata):
REM ***** STARBASIC CALCULATOR *****
REM ***** WITH CALC PROXY *****
Private oDlg As Object
Private oDisplay As Object
Private LastActive As Object
Sub ShowDialog
DialogLibraries.LoadLibrary("Standard")
oDlg = CreateUnoDialog(DialogLibraries.Standard.Dialog1)
oDisplay = oDlg.getControl("Label1")
CenterDialog
oDlg.execute()
oDlg.dispose()
End Sub
Sub CenterDialog
Dim oSize As New com.sun.star.awt.Size, factor As Double
Dim oCC, oComponentWindow, oTopWindowPosSize
oCC = ThisComponent.getCurrentController()
oComponentWindow = oCC.ComponentWindow
oTopWindowPosSize = oComponentWindow.Toolkit.ActiveTopWindow.getPosSize()
oSize.Width = oDlg.Model.Width
oSize.Height = oDlg.Model.Height
factor = oSize.Width / oDlg.convertSizeToPixel(oSize, com.sun.star.util.MeasureUnit.APPFONT).Width
With oDlg.Model
.PositionX = (factor * oTopWindowPosSize.Width - .Width) / 2
.PositionY = (factor * oTopWindowPosSize.Height - .Height) / 2
End With
End Sub
Sub ButtonMouseDown(oEvent)
If oEvent.Buttons = 2 Then Exit Sub
oEvent.Source.setFocus()
End Sub
Sub ButtonMouseUp(oEvent)
If oEvent.Buttons = 2 Then Exit Sub
HandleKeyChars oEvent.Source.Model.Tag
Validation
End Sub
Sub Validation
If InStr(oDisplay.Model.Label, "=") > 0 Then
oDisplay.Model.Label = Replace(oDisplay.Model.Label, "=", "")
End If
If Left(oDisplay.Model.Label,1) = "=" Then
oDisplay.Model.Label = ""
ElseIf Left(oDisplay.Model.Label,1) = "+" Then
oDisplay.Model.Label = ""
ElseIf Left(oDisplay.Model.Label,1) = "/" Then
oDisplay.Model.Label = ""
ElseIf Left(oDisplay.Model.Label,1) = "*" Then
oDisplay.Model.Label = ""
ElseIf Left(oDisplay.Model.Label,1) = ")" Then
oDisplay.Model.Label = ""
End If
If Len(oDisplay.Model.Label) = 2 Then
If oDisplay.Model.Label = "--" Then
oDisplay.Model.Label = "-"
ElseIf oDisplay.Model.Label = "-(" Then
oDisplay.Model.Label = "-"
ElseIf oDisplay.Model.Label = "-)" Then
oDisplay.Model.Label = "-"
ElseIf oDisplay.Model.Label = "-/" Then
oDisplay.Model.Label = "-"
ElseIf oDisplay.Model.Label = "-*" Then
oDisplay.Model.Label = "-"
ElseIf oDisplay.Model.Label = "-+" Then
oDisplay.Model.Label = "-"
End If
End If
If Len(oDisplay.Model.Label) > 2 Then
If Right(oDisplay.Model.Label, 2) = "-)" Then
oDisplay.Model.Label = Left(oDisplay.Model.Label, Len(oDisplay.Model.Label) - 1)
ElseIf Right(oDisplay.Model.Label, 2) = "-/" Then
oDisplay.Model.Label = Left(oDisplay.Model.Label, Len(oDisplay.Model.Label) - 1)
ElseIf Right(oDisplay.Model.Label, 2) = "-*" Then
oDisplay.Model.Label = Left(oDisplay.Model.Label, Len(oDisplay.Model.Label) - 1)
ElseIf Right(oDisplay.Model.Label, 2) = "-+" Then
oDisplay.Model.Label = Left(oDisplay.Model.Label, Len(oDisplay.Model.Label) - 1)
ElseIf Right(oDisplay.Model.Label, 2) = "-)" Then
oDisplay.Model.Label = Left(oDisplay.Model.Label, Len(oDisplay.Model.Label) - 1)
ElseIf Right(oDisplay.Model.Label, 3) = "---" Then
oDisplay.Model.Label = Left(oDisplay.Model.Label, Len(oDisplay.Model.Label) - 2)
End If
End If
If Len(oDisplay.Model.Label) > 2 Then
Dim slock As Integer, elock As Integer
For i% = 1 To Len(oDisplay.Model.Label)
If Mid(oDisplay.Model.Label, i, 1) = "(" Then
slock = slock + 1
ElseIf Mid(oDisplay.Model.Label, i, 1) = ")" Then
elock = elock + 1
End If
If elock > slock Then
oDisplay.Model.Label = Left(oDisplay.Model.Label, Len(oDisplay.Model.Label) - 1)
End If
Next i
If Right(oDisplay.Model.Label, 3) = "---" Then
oDisplay.Model.Label = Left(oDisplay.Model.Label, Len(oDisplay.Model.Label) - 1)
End If
End If
End Sub
Sub ButtonKeyDown(oEvent)
Dim keyChar As String
oEvent.Source.setFocus()
Select Case oEvent.KeyCode - 256
Case 1
keyChar = "1"
oDlg.getControl("CommandButton" & keyChar).setFocus()
Case 2
keyChar = "2"
oDlg.getControl("CommandButton" & keyChar).setFocus()
Case 3
keyChar = "3"
oDlg.getControl("CommandButton" & keyChar).setFocus()
Case 4
keyChar = "4"
oDlg.getControl("CommandButton" & keyChar).setFocus()
Case 5
keyChar = "5"
oDlg.getControl("CommandButton" & keyChar).setFocus()
Case 6
keyChar = "6"
oDlg.getControl("CommandButton" & keyChar).setFocus()
Case 7
keyChar = "7"
oDlg.getControl("CommandButton" & keyChar).setFocus()
Case 8
keyChar = "8"
oDlg.getControl("CommandButton" & keyChar).setFocus()
Case 9
keyChar = "9"
oDlg.getControl("CommandButton" & keyChar).setFocus()
Case 0
keyChar = "0"
oDlg.getControl("CommandButton10").setFocus()
Case Else
keyChar = ""
End Select
If oEvent.Modifiers AND 1 And oEvent.KeyCode - 256 = 7 Then
keyChar = "/"
oDlg.getControl("CommandButton16").setFocus()
ElseIf oEvent.Modifiers AND 1 And oEvent.KeyCode - 256 = 8 Then
keyChar = "("
oDlg.getControl("CommandButton18").setFocus()
ElseIf oEvent.Modifiers AND 1 And oEvent.KeyCode - 256 = 9 Then
keyChar = ")"
oDlg.getControl("CommandButton19").setFocus()
ElseIf oEvent.Modifiers AND 1 And oEvent.KeyCode - 256 = 0 Then
keyChar = "="
oDlg.getControl("CommandButton15").setFocus()
End If
If oEvent.KeyCode = 1280 Then
keyChar = "="
oDlg.getControl("CommandButton15").setFocus()
ElseIf oEvent.KeyCode = 1283 Then
keyChar = "CE"
oDlg.getControl("CommandButton17").setFocus()
ElseIf oEvent.KeyCode = 1287 Then
keyChar = "+"
oDlg.getControl("CommandButton11").setFocus()
ElseIf oEvent.KeyCode = 1288 Then
keyChar = "-"
oDlg.getControl("CommandButton12").setFocus()
ElseIf oEvent.KeyCode = 1292 Or oEvent.KeyCode = 1309 Then
keyChar = ","
oDlg.getControl("CommandButton14").setFocus()
ElseIf oEvent.KeyCode = 1318 Then
keyChar = "*"
oDlg.getControl("CommandButton13").setFocus()
End If
If keyChar <> "" Then
HandleKeyChars keyChar
End If
End Sub
Sub ButtonKeyUp(oEvent)
Validation
End Sub
Sub HandleKeyChars(key As String)
Dim calcStr As String, i As Integer
calcStr = oDisplay.Model.Label
oDisplay.Model.Label = calcStr
If Len(oDisplay.Model.Label) = 1 Then
Select Case oDisplay.Model.Label
Case "/", "*", "+", ","
oDisplay.Model.Label = "" : Exit Sub
Case Else
End Select
End If
Dim npairs() As String
npairs = Split("/,+,*",",")
If Len(calcStr) > 1 Then
Dim hlp As String : hlp = Mid(calcStr, Len(calcStr) - 1, 1)
If hlp = "+" Or hlp = "-" Or hlp = "/" Or hlp = "*" Or hlp = "," Then
For i = 0 To Ubound(npairs)
If Right(calcStr, 1) = npairs(i) Then
calcStr = Left(calcStr, Len(calcStr) - 1)
oDisplay.Model.Label = calcStr : Exit Sub
End If
Next I
End If
End If
calcStr = Replace(calcStr, "++", "+")
calcStr = Replace(calcStr, "+-", "+")
calcStr = Replace(calcStr, "+/", "+")
calcStr = Replace(calcStr, "+*", "+")
If Len(calcStr) > 1 And Right(calcStr, 2) = "++" Then
calcStr = Left(calcStr, Len(calcStr) -1)
oDisplay.Model.Label = calcStr
End If
Dim lpCnt As Integer, rpCnt As Integer
If Len(calcStr) > 0 Then
For i = 1 to Len(calcStr)
If Mid(calcStr, i, 1) = "(" Then lpCnt = lpCnt + 1
If Mid(calcStr, i, 1) = ")" Then rpCnt = rpCnt + 1
Next i
If rpCnt > lpCnt Then
oDisplay.Model.Label = Left(calcStr, Len(calcStr) -1)
End If
End If
If key = "=" And Len(calcStr) > 2 Then
If Right(oDisplay.Model.Label, 1) = "/" Or Right(oDisplay.Model.Label, 1) = "*" _
Or Right(oDisplay.Model.Label, 1) = "-" Or Right(oDisplay.Model.Label, 1) = "+" _
Or Right(oDisplay.Model.Label, 1) = "(" Then
oDisplay.Model.Align = 1
oDisplay.Model.Label = "ERROR: lopussa " & Right(oDisplay.Model.Label, 1)
Wait 1500
oDisplay.Model.Align = 2
oDisplay.Model.Label = ""
Exit Sub
End If
If InStr(oDisplay.Model.Label, "ERROR") > 0 Then
oDisplay.Model.Label = "" : Exit Sub
End If
oDisplay.Model.Label = CalcEval(Replace(calcStr,",",".")) : Exit Sub '*****
End If
If key = "CE" Then
oDisplay.Model.Label = "" : Exit Sub
End If
If key = "(" Then
If Right(oDisplay.Model.Label, 1) <> "+" And Right(oDisplay.Model.Label, 1) <> "-" And _
Right(oDisplay.Model.Label, 1) <> "/" And Right(oDisplay.Model.Label, 1) <> "*" Then
If Len(oDisplay.Model.Label) > 0 Then Exit Sub
End If
End If
If key = ")" Then
If Right(oDisplay.Model.Label, 1) = "+" Or Right(oDisplay.Model.Label, 1) = "-" Or _
Right(oDisplay.Model.Label, 1) = "/" Or Right(oDisplay.Model.Label, 1) = "*" Or _
oDisplay.Model.Label = "" And InStr(oDisplay.Model.Label, ")") = 0 And _
Instr(oDisplay.Model.Label,"/") = 0 And Instr(oDisplay.Model.Label,"*") = 0 And _
Instr(oDisplay.Model.Label,"-") = 0 And Instr(oDisplay.Model.Label,"+") = 0 Then
Exit Sub
End If
End If
If Right(oDisplay.Model.Label, 1) = "(" Then
If key = "/" Or key = "*" Or key = "+" Then
Exit Sub
End If
End If
If Right(oDisplay.Model.Label, 1) = "(" And key = ")" Then Exit Sub
oDisplay.Model.Label = oDisplay.Model.Label & key
End Sub
Function CalcEval(expr As String) As Variant
Dim oCalc As Object
Dim args(0) As New com.sun.star.beans.PropertyValue
args(0).Name = "Hidden"
args(0).Value = True
oCalc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, args())
On Error GoTo CalcError
Dim oSheet As Object
oSheet = oCalc.Sheets(0)
oSheet.getCellByPosition(0,0).Formula = "=" & expr
CalcEval = oSheet.getCellByPosition(0,0).Value
oCalc.setModified(False)
oCalc.dispose()
Exit Function
CalcError:
CalcEval = "- ERROR - "
If Not IsNull(oCalc) Then
oCalc.setModified(False)
oCalc.dispose()
End If
End FunctionTallenna projekti vaikkapa nimellä CalculatorWithCalcProxy, and that's it