Keskustelu: Koodit: LibreOffice - StarBasic Laskin

' 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 Function