statistics.frm

数学计算器

      Height          =   255
      Index           =   1
      Left            =   90
      TabIndex        =   3
      Top             =   1095
      Width           =   1935
   End
   Begin VB.Label Label1 
      Caption         =   "The sum of the numbers is:"
      Height          =   255
      Index           =   0
      Left            =   90
      TabIndex        =   1
      Top             =   750
      Width           =   1965
   End
End
Attribute VB_Name = "Statistics"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim TheArray() As Double
Dim SortedArray() As Double
Dim DigitArray() As Integer
Dim Counter As Double
Dim Digits As Integer
Dim Sample As Boolean
Dim Calculator As Boolean
Dim DecimalPlaced As Boolean
Dim Sorted As Boolean
Private Sub AddToArray()
Dim i As Integer
Dim Temp As String
If Digits = 0 Then Exit Sub
For i = 1 To Digits
Select Case DigitArray(i)
Case 0 To 9
Temp = Temp & CStr(DigitArray(i))
Case 10
Temp = Temp & "."
Case 11
Temp = "-"
Case Else
Exit Sub
End Select
Next
Counter = Counter + 1
ReDim Preserve TheArray(Counter)
TheArray(Counter) = Val(Temp)
ShowResults
 If Sorted Then
 SortListbox
 Else
 ListUnsorted
 End If
End Sub

Private Function AveDev()
Dim i As Long
Dim Temp As Double
For i = 1 To Counter
Temp = Temp + Abs((TheArray(i) - Mean))
Next
AveDev = Temp / Counter
End Function

Private Function CoefDev() As Variant
On Error GoTo Err1
'coefficient of deviation in percent form
CoefDev = (StdDev / Mean * 100) & " %"
Exit Function
Err1:
CoefDev = "#Div/0!"
End Function

Private Function Mode() As Variant
'the most repeated value
On Error GoTo Err1:
Dim i As Long
Dim j As Long
Dim Temp As Variant
Dim Element As Long
ReDim n(Counter) As Long
'load number of repetitions into an array n()
For i = 1 To Counter
For j = 1 To Counter
If TheArray(i) = TheArray(j) Then
n(i) = n(i) + 1
End If
Next
Next
'compare elements of the repetition counting array
j = n(1)
Element = 1
For i = 2 To Counter
If n(i) > j Then
Element = i 'this element has higher value
j = n(i) 'update for next rep
End If
Next
'get results
If Element = 1 And n(1) = 1 Then 'no repetitions
Mode = "None"
Exit Function
End If
'look for the highest tying values
For i = 1 To Counter
If Element <> i Then 'skip same one
If n(Element) = n(i) Then 'if it is a match
If TheArray(Element) <> TheArray(i) Then 'but not same value
If InStr(1, Temp, TheArray(i)) = 0 Then 'if not already listed
If Temp = "" Then 'put in the first one
Temp = TheArray(Element)
End If
Temp = Temp & " or " & TheArray(i) 'add the matching reps
End If
End If
End If
End If
Next

'if no ties found show the highest repeated value
If Temp = "" Then
Temp = TheArray(Element)
End If

Mode = Temp
Exit Function
Err1:
Mode = "Error"
End Function

Private Sub ShowResults()
SortArray
txtOutput(0) = Str(Total)
txtOutput(1) = Str(Total * Total)
txtOutput(2) = Str(SqrTotal)
txtOutput(3) = Str(Median)
txtOutput(4) = Str(Mean)
txtOutput(5) = CStr(Variance)
txtOutput(6) = CStr(StdDev)
txtOutput(7) = CStr(CoefDev)
txtOutput(8) = CStr(Skew)
txtOutput(9) = Str(Counter)
txtOutput(10) = CStr(Mode)
txtOutput(11) = Str(AveDev)
End Sub
Private Function Mean() As Double
'average of all values
Mean = Total / Counter
End Function


Private Function Median() As Double
'the middle value of array or average of two if even number
Select Case Counter Mod 2
Case 0
Median = Str((SortedArray(Counter / 2) + SortedArray((Counter / 2) + 1)) / 2)
Case 1
Median = Str(SortedArray((Counter + 1) / 2))
End Select
End Function


Private Function Skew() As Variant
On Error GoTo Err1:
Dim i As Long
Dim Temp As Double
For i = 1 To Counter
Temp = Temp + ((TheArray(i) - Mean) / StdDev) ^ 3
Next
Skew = (Counter / ((Counter - 1) * (Counter - 2))) * Temp
Exit Function
Err1:
Skew = "#Div/0!"
End Function

Private Sub SortArray() 'only to get median value
Dim Temp As Double
Dim j As Long
Dim i As Long
'first copy the array so we can still remove the
'last element of original array in the undo feature
ReDim SortedArray(Counter)
For i = 1 To Counter
SortedArray(i) = TheArray(i)
Next
'then loop through swapping values through temp
For i = 1 To Counter
For j = 1 To Counter
Temp = SortedArray(i)
If Temp < SortedArray(j) Then
SortedArray(i) = SortedArray(j)
SortedArray(j) = Temp
End If
Next
Next
End Sub



Private Sub ListUnsorted()
Dim i As Integer
ArrayList.Clear
For i = 1 To Counter
ArrayList.AddItem Str(TheArray(i))
Next
Button(18).Caption = "&SORT"
Sorted = False
End Sub
Private Sub SortListbox()
Dim i As Integer
ArrayList.Clear
For i = 1 To Counter
ArrayList.AddItem Str(SortedArray(i))
Next
Button(18).Caption = "UN&SORT"
Sorted = True
End Sub

Private Function SqrTotal() As Double
Dim i As Long
For i = 1 To Counter
SqrTotal = (TheArray(i) * TheArray(i)) + SqrTotal
Next
End Function
Private Function StdDev() As Variant
On Error GoTo Err1: 'standard deviation
StdDev = Sqr(Abs(Variance))
Exit Function
Err1:
StdDev = "#Div/0!"
End Function

Private Function Total() As Double
Dim i As Long 'total of values
For i = 1 To Counter
Total = TheArray(i) + Total
Next
End Function


Private Function Variance() As Variant
On Error GoTo Err1
Dim Sum As Double
Dim i As Long
For i = 1 To Counter 'summation of squares for think formula
Sum = Sum + ((TheArray(i) - Mean) * (TheArray(i) - Mean))
Next
If Sample Then 'sample method
   If Calculator Then 'for using hand calculator
   Variance = ((SqrTotal - ((Total * Total) / Counter))) / (Counter - 1)
   Else 'using "think" formula...better
   Variance = Sum / (Counter - 1)
   End If
Else 'population method
   If Calculator Then
   Variance = ((SqrTotal - ((Total * Total) / Counter))) / Counter
   Else
   Variance = Sum / Counter
   End If
End If
Exit Function
Err1:
Variance = "#Div/0!"
End Function

Private Sub ArrayList_Click()
SortListbox
End Sub

Private Sub Button_Click(Index As Integer)
Dim i As Integer
Select Case Index
Case 0 To 9 'numbers 0 through 9
Form_KeyPress (Index + 48)

Case 10 'decimal point
Form_KeyPress 46

Case 11 'clear all data
Digits = 0
Counter = 0
Erase DigitArray
Erase TheArray
Display.Cls
DecimalPlaced = False
For i = 0 To 11
txtOutput(i) = ""
Next
ArrayList.Clear

Case 12 'clear entry
Digits = 0
Erase DigitArray
Display.Cls
DecimalPlaced = False

Case 13 'backspace key
Form_KeyPress 8

Case 14 'enter button
Form_KeyPress 13

Case 15 'minus sign
Form_KeyPress 45

Case 16 'clear previous value (and current entry)
If Counter > 0 Then
Digits = 0
Erase DigitArray
Display.Cls
Counter = Counter - 1
DecimalPlaced = False
 If Counter > 0 Then
 ShowResults
 Else
 Button_Click 11 'clear all data
 End If
 
 If Sorted Then 'refresh listbox
 SortListbox
 Else
 ListUnsorted
 End If
End If

Case 17
End

Case 18 'show list box (un)sorted
If Sorted Then 'refresh listbox
ListUnsorted
Else
SortListbox
End If

End Select
SetFocus
End Sub
Private Sub Digit_Click(Index As Integer)
'image controls containing number bitmaps
End Sub

Private Sub Display_Click()
' calculator picture box
End Sub


Private Sub Form_KeyPress(KeyAscii As Integer)
Dim TheDigit As Integer
Dim i As Integer
Select Case KeyAscii
Case 8 'backspace
If Digits > 0 Then
If DigitArray(Digits) = 10 Then
DecimalPlaced = False
End If
Digits = Digits - 1
End If

Case 13 'enter key
AddToArray
Digits = 0
Erase DigitArray
DecimalPlaced = False

Case 45 'minus sign
If Digits > 0 Then Exit Sub
Digits = Digits + 1
ReDim Preserve DigitArray(Digits) As Integer
DigitArray(Digits) = 11

Case 46 'decimal point
If DecimalPlaced Then Exit Sub
Digits = Digits + 1
ReDim Preserve DigitArray(Digits) As Integer
DigitArray(Digits) = 10
DecimalPlaced = True

Case 48 To 57 'numbers 0 through 9
Digits = Digits + 1
ReDim Preserve DigitArray(Digits) As Integer
DigitArray(Digits) = CInt(Chr(KeyAscii))

Case 27
Button_Click 12

Case 101
Button_Click 12

Case 99
Button_Click 11

Case 100
Button_Click 13

Case 112
Button_Click 16

Case 115
Button_Click 18

Case 120
End

Case Else

Exit Sub
End Select

Display.Cls

For i = 1 To Digits
TheDigit = DigitArray(Digits - i + 1)
Display.PaintPicture Digit(TheDigit).Picture, (Display.Width - 100) - Digit(TheDigit).Width * i, 0
Next

Display.Refresh
End Sub

Private Sub Frame1_DragDrop(Index As Integer, Source As Control, X As Single, Y As Single)
' the two frames to separate option button pairs
End Sub

Private Sub Option1_Click(Index As Integer)
Select Case Index
Case 0
Sample = False
Case 1
Sample = True
End Select
If Counter > 0 Then ShowResults
End Sub