frmcalcsolver.frm

表达式计算器,计算灵活,可计算函数,三角函数等,很好用哦.

Private Sub Form_Resize()

    'Form cannot be resized when minimized so exit routine
    If Me.WindowState = vbMinimized Then
        Exit Sub
    End If

    'Set dimension limits (6015 x 4200 twips)
    If Me.Width < 6855 Then
        Me.Width = 6855
    ElseIf Me.Height < 4065 Then
        Me.Height = 4065
    End If

    'Set width values on form resize
    txtEntry.Width = Me.Width - 600
    fraEntry.Width = txtEntry.Width + 240

    txtAnswer.Width = Me.Width - 600
    fraAnswer.Width = txtAnswer.Width + 240

    fraLogBase.Left = ((Me.Width - fraAngMode.Width - fraLogBase.Width - fraButtons.Width - fraAnsType.Width - 360) / 3) + (fraAngMode.Width + fraAngMode.Left)
    fraButtons.Left = ((Me.Width - fraAngMode.Width - fraLogBase.Width - fraButtons.Width - fraAnsType.Width - 360) / 3) + (fraLogBase.Width + fraLogBase.Left)
    fraAnsType.Left = ((Me.Width - fraAngMode.Width - fraLogBase.Width - fraButtons.Width - fraAnsType.Width - 360) / 3) + (fraButtons.Width + fraButtons.Left)

    'Set height values on form resize
    fraAnswer.Height = Me.Height - 2610
    txtAnswer.Height = fraAnswer.Height - 330

    fraAngMode.Top = fraAnswer.Height + fraAnswer.Top + 120
    fraLogBase.Top = fraAnswer.Height + fraAnswer.Top + 120
    fraButtons.Top = fraAnswer.Height + fraAnswer.Top + 180
    fraAnsType.Top = fraAnswer.Height + fraAnswer.Top + 120

End Sub

Private Sub Form_Terminate()
Dim i As Integer

    'Save settings
    SaveFormSettings

    'End program
    End

End Sub

Private Sub Form_Unload(Cancel As Integer)

    'Save settings
    SaveFormSettings

    'End program
    End

End Sub

Private Sub mnuEditAngleMode_Click(Index As Integer)

    'Correspond menu clicking with radio button
    'clicking
    optAngMode_Click Index
    optAngMode(Index).Value = True

End Sub

Private Sub mnuEditBaseMode_Click(Index As Integer)

    'Correspond menu clicking with radio button
    'clicking
    optBaseMode_Click Index
    optBaseMode(Index).Value = True

End Sub

Private Sub mnuEditCopy_Click()

    Select Case CurrentFocus
        'Copy the selected text
        Case "Entry"
            Clipboard.SetText (txtEntry.SelText)
        Case "Answer"
            Clipboard.SetText (txtAnswer.SelText)
    End Select

End Sub

Private Sub mnuEditCut_Click()

    'Copy the text
    mnuEditCopy_Click

    Select Case CurrentFocus
        'Get the current cursor location in the text
        'box; delete the selected text; set the cursor
        'location back to its original place
        Case "Entry"
            StringLocation = txtEntry.SelStart
            txtEntry.Text = Left(txtEntry.Text, txtEntry.SelStart) + Right(txtEntry.Text, Len(txtEntry.Text) - (txtEntry.SelStart + txtEntry.SelLength))
            txtEntry.SelStart = StringLocation
    End Select

End Sub

Private Sub mnuEditInsertLastAns_Click()

    'Insert the last answer into the entry box
    txtEntry.SetFocus
    txtEntry.Text = txtEntry.Text + CStr(PrevAnswer)
    txtEntry.SelStart = Len(txtEntry.Text)

End Sub

Private Sub mnuEditInsertLastEntry_Click()

    'Insert the last entry into the entry box
    txtEntry.SetFocus
    txtEntry.Text = txtEntry.Text + PrevEntry
    txtEntry.SelStart = Len(txtEntry.Text)

End Sub

Private Sub mnuEditPaste_Click()
On Error Resume Next

    Select Case CurrentFocus
        'Get the current cursor location in the text
        'box; paste in the text; set the cursor
        'location back to its original place
        Case "Entry"
            StringLocation = txtEntry.SelStart
            txtEntry.Text = Left(txtEntry.Text, txtEntry.SelStart) + Clipboard.GetText + Right(txtEntry.Text, Len(txtEntry.Text) - txtEntry.SelStart)
            txtEntry.SelStart = StringLocation
    End Select

End Sub

Private Sub mnuEditSettingsDefault_Click()
Dim Message As String

    'Display "Are you sure" box
    Message = MsgBox("Are you sure you wish to restore the default settings?", vbQuestion + vbYesNo, "Default Settings")

    'If the user does not wish to load the
    'default settings, exit the routine
    If Message = vbNo Then
        Exit Sub
    End If

    'Save the default settings to the Registry
    SaveSetting App.Title, "Previous", "PrevAnswer", "0"
    SaveSetting App.Title, "Previous", "PrevEntry", ""
    SaveSetting App.Title, "Settings", "LogBase", "10"
    SaveSetting App.Title, "Settings", "AngMode", "0"
    SaveSetting App.Title, "Settings", "BaseMode", "0"

    'Apply the default settings to the form
    PrevAnswer = 0
    PrevEntry = ""
    txtLogBase.Text = "10"
    optAngMode(0).Value = True
    optBaseMode(0).Value = True

    'Save settings in the Registry on exit
    RegEdit = True

End Sub

Private Sub mnuEditSettingsRemove_Click()
Dim Message As String

    'Display "Are you sure" box
    Message = MsgBox("Are you sure you wish to remove the" + vbNewLine + "current settings from the Registry?", vbQuestion + vbYesNo, "Remove Settings")

    'If the user does not wish to remove the
    'current settings, exit the routine
    If Message = vbNo Then
        Exit Sub
    End If

    'Remove the settings from Registry
    DeleteSetting App.Title, "Previous"
    DeleteSetting App.Title, "Settings"

    'Set the default settings on the form
    'alone, without editing the Registry
    PrevAnswer = 0
    PrevEntry = ""
    txtLogBase.Text = "10"
    optAngMode(0).Value = True
    optBaseMode(0).Value = True

    'Don't save settings in the Registry
    'on exit
    RegEdit = False

End Sub

Private Sub mnuFileCalculate_Click()

    'Correspond with Calculate button clicking
    If cmdCalculate.Enabled = True Then
        cmdCalculate_Click
    End If

End Sub

Private Sub mnuFileClear_Click()

    'Correspond with Clear button clicking
    cmdClear_Click

End Sub

Private Sub mnuFileExit_Click()

    'End program
    Unload Me
    End

End Sub

Private Sub mnuHelpAbout_Click()

    'Display about screen
    frmAbout.Show vbModal, Me

End Sub

Public Sub mnuHelpHelp_Click()

    'Display help screen
    frmHelp.Show

End Sub

Private Sub optAngMode_Click(Index As Integer)
Dim i As Integer

    'Correspond radio buttons with check marks in menu
    'system
    For i = 0 To 1
        mnuEditAngleMode(i).Checked = False
    Next i

    mnuEditAngleMode(Index).Checked = True

End Sub

Private Sub optBaseMode_Click(Index As Integer)
Dim i As Integer

    'Correspond radio buttons with check marks in menu
    'system
    For i = 0 To 3
        mnuEditBaseMode(i).Checked = False
    Next i

    mnuEditBaseMode(Index).Checked = True

End Sub

Private Sub txtAnswer_GotFocus()

    'Set CurrentFocus value and disable Cut and Paste
    'menu items
    CurrentFocus = "Answer"
    mnuEditCut.Enabled = False
    mnuEditPaste.Enabled = False

End Sub

Private Sub txtEntry_Change()

    'Disable Calculate button if the entry box is
    'empty and enable it if the box is not empty
    If txtEntry = "" Then
        cmdCalculate.Enabled = False
    Else
        cmdCalculate.Enabled = True
    End If

End Sub

Private Sub txtEntry_GotFocus()

    'Set CurrentFocus value and enable Cut and Paste
    'menu items
    CurrentFocus = "Entry"
    mnuEditCut.Enabled = True
    mnuEditPaste.Enabled = True

End Sub

Private Sub SaveFormSettings()
Dim i As Integer

    If RegEdit = True Then
        'Save the settings to the Registry
        SaveSetting App.Title, "Previous", "PrevAnswer", CStr(PrevAnswer)
        SaveSetting App.Title, "Previous", "PrevEntry", CStr(PrevEntry)
        SaveSetting App.Title, "Settings", "LogBase", txtLogBase.Text
        For i = 0 To 1
            If optAngMode(i).Value = True Then
                SaveSetting App.Title, "Settings", "AngMode", CStr(i)
            End If
        Next i
        For i = 0 To 3
            If optBaseMode(i).Value = True Then
                SaveSetting App.Title, "Settings", "BaseMode", CStr(i)
            End If
        Next i
    End If

End Sub

Private Sub LoadFormSettings()
Dim i As Integer

    'Load the settings from Registry
    PrevAnswer = CDbl(GetSetting(App.Title, "Previous", "PrevAnswer", "0"))
    PrevEntry = GetSetting(App.Title, "Previous", "PrevEntry")
    txtLogBase.Text = GetSetting(App.Title, "Settings", "LogBase", "10")
    i = CInt(GetSetting(App.Title, "Settings", "AngMode", "0"))
    optAngMode(i).Value = True
    i = CInt(GetSetting(App.Title, "Settings", "BaseMode", "0"))
    optBaseMode(i).Value = True

End Sub