📄 main.frm
字号:
End
Begin VB.Label Label1
Caption = "Situation1 undefined"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2280
TabIndex = 5
Top = 180
Width = 4215
End
End
Begin VB.PictureBox Table
Appearance = 0 'Flat
BackColor = &H80000005&
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 3495
Left = 120
ScaleHeight = 231
ScaleMode = 3 'Pixel
ScaleWidth = 447
TabIndex = 0
Top = 120
Width = 6735
Begin VB.Shape Highlighter
BackColor = &H00C0C0FF&
BackStyle = 1 'Opaque
BorderStyle = 0 'Transparent
DrawMode = 9 'Not Mask Pen
Height = 255
Index = 0
Left = 960
Top = 1560
Visible = 0 'False
Width = 495
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Call GetResult(Situation1, D, 3)
End Sub
Private Sub Command2_Click()
Call GetResult(Situation2, D, 3)
End Sub
Private Sub Command3_Click()
Dim CustomSituation As DayType
Call SetDay(CustomSituation, Combo(0).ListIndex, Combo(1).ListIndex, Combo(2).ListIndex, Combo(3).ListIndex)
Call GetResult(CustomSituation, D, 3)
End Sub
Private Sub Command4_Click()
Randomize Timer
R = Rnd
If R < 1 / 6 Then
MsgBox "Sorry, I didn't get around to making this work. Please continue to have fun with the other options." & vbCrLf & vbCrLf & "Hey, but look on the bright side. Clicking this button a lot of times will give you some really great random apology messages!", vbInformation
ElseIf R < 2 / 6 Then
MsgBox "Sorry, but this doesn't work. I ran out of time calculating it by hand. (D'oh!)" & vbCrLf & vbCrLf & "Hey, but look on the bright side. Clicking this button a lot of times will give you some really great random apology messages!", vbInformation
ElseIf R < 3 / 6 Then
MsgBox "It doesn't look like you clicked hard enough. Try clicking this button again and see if it does anything THEN." & vbCrLf & vbCrLf & "Hey, but look on the bright side. Clicking this button a lot of times will give you some really great random apology messages!", vbInformation
ElseIf R < 4 / 6 Then
MsgBox "I regret to inform you that this option (still) doesn't work. I never got around to programming it." & vbCrLf & vbCrLf & "Hey, but look on the bright side. Clicking this button a lot of times will give you some really great random apology messages!", vbInformation
ElseIf R < 5 / 6 Then
MsgBox "Forgive me, for this option isn't done! I hardly even started!" & vbCrLf & vbCrLf & "Hey, but look on the bright side. Clicking this button a lot of times will give you some really great random apology messages!", vbInformation
Else
MsgBox "You'll have to live with the other options, because this one doesn't work. Enjoy!" & vbCrLf & vbCrLf & "Hey, but look on the bright side. Clicking this button a lot of times will give you some really great random apology messages!", vbInformation
End If
Exit Sub
Dim Best As Integer, Deviation As Double, ThisDeviation As Double, n As Integer, i As Integer, Expected As Double
Deviation = -1
Msg = ""
For n = 1 To nFeatures
ThisDeviation = 0
For i = LBound(D) To UBound(D)
Cur = 1
ReDim D2(LBound(D) To UBound(D) - 1)
For j = LBound(D) To UBound(D)
If i <> j Then
D2(Cur) = D(j)
Cur = Cur + 1
End If
Next j
For j = LBound(D2) To UBound(D2)
Call CreateScale(n, D2)
Next j
Expected = GetResult(D(i), D2, 3, False)
ThisDeviation = ThisDeviation + Abs(Abs(Output(i)) - Expected)
Next i
Msg = Msg & "Feature " & n & " has a deviation of " & ThisDeviation & vbCrLf
Next n
MsgBox Msg
End Sub
Private Sub Form_Load()
Dim n As Integer
Call SetD(1, Sunny, Hot, High, Weak, False)
Call SetD(2, Sunny, Hot, High, Strong, False)
Call SetD(3, Overcast, Hot, High, Weak, True)
Call SetD(4, Rain, Mild, High, Weak, True)
Call SetD(5, Rain, Cool, Normal, Weak, True)
Call SetD(6, Rain, Cool, Normal, Strong, False)
Call SetD(7, Overcast, Cool, Normal, Strong, True)
Call SetD(8, Sunny, Mild, High, Weak, False)
Call SetD(9, Sunny, Cool, Normal, Weak, True)
Call SetD(10, Rain, Mild, Normal, Weak, True)
Call SetD(11, Sunny, Mild, Normal, Strong, True)
Call SetD(12, Overcast, Mild, High, Strong, True)
Call SetD(13, Overcast, Hot, Normal, Weak, True)
Call SetD(14, Rain, Mild, High, Strong, False)
Call SetDay(Situation1, Sunny, Cool, High, Strong)
Call SetDay(Situation2, Rain, Hot, Normal, Weak)
Label1.Caption = "Situation1 = (" & DispDay(Situation1) & ")"
Label2.Caption = "Situation2 = (" & DispDay(Situation2) & ")"
Dim i As Integer, AllFeatures As Double
Check2.Value = 1
For n = LBound(D) To UBound(D)
Call CreateScale(n, D)
Next n
Combo(0).AddItem "Rain"
Combo(0).AddItem "Overcast"
Combo(0).AddItem "Sunny"
Combo(0).ListIndex = 0
Combo(1).AddItem "Cool"
Combo(1).AddItem "Mild"
Combo(1).AddItem "Hot"
Combo(1).ListIndex = 0
Combo(2).AddItem "Normal"
Combo(2).AddItem "High"
Combo(2).ListIndex = 0
Combo(3).AddItem "Weak"
Combo(3).AddItem "Strong"
Combo(3).ListIndex = 0
Me.Show
Table.Height = (UBound(D) - LBound(D) + 2) * 18 + 10
Table.Width = 420
Info.Left = Table.Left + Table.Width + 8
ButtonBox.Move 8, Table.Top + Table.Height + 8, Table.Width
Me.Width = (((Me.Width / Screen.TwipsPerPixelX) - Me.ScaleWidth) + Info.Left + Info.Width + 8) * Screen.TwipsPerPixelX
Me.Height = (((Me.Height / Screen.TwipsPerPixelY) - Me.ScaleHeight) + ButtonBox.Top + ButtonBox.Height + 8) * Screen.TwipsPerPixelY
Info.Height = Me.ScaleHeight - Info.Top - 8
Table.AutoRedraw = True
y = 0
For n = LBound(D) - 1 To UBound(D)
y = y + 1
If n < LBound(D) Then
Table.Line (0, (y * 18) + 3)-(Table.Width, (y * 18) + 3)
Table.Line (53, 0)-(53, Table.Height)
Table.Line (343, 0)-(343, Table.Height)
End If
Table.CurrentX = 7
If n < LBound(D) Then
Table.CurrentY = (y * 18) - 14
Table.Print "Days"
Else
Table.CurrentY = (y * 18) - 10
Table.Print "Day " & n;
End If
Table.CurrentX = 65
If n < LBound(D) Then
Table.CurrentY = (y * 18) - 14
Table.Print "Outlook"
Else
Table.CurrentY = (y * 18) - 10
Table.Print ShowOutlook(D(n).Outlook)
End If
Table.CurrentX = 135
If n < LBound(D) Then
Table.CurrentY = (y * 18) - 14
Table.Print "Temperature"
Else
Table.CurrentY = (y * 18) - 10
Table.Print ShowTemperature(D(n).Temperature)
End If
Table.CurrentX = 205
If n < LBound(D) Then
Table.CurrentY = (y * 18) - 14
Table.Print "Humidity"
Else
Table.CurrentY = (y * 18) - 10
Table.Print ShowHumidity(D(n).Humidity)
End If
Table.CurrentX = 275
If n < LBound(D) Then
Table.CurrentY = (y * 18) - 14
Table.Print "Wind"
Else
Table.CurrentY = (y * 18) - 10
Table.Print ShowWind(D(n).Wind)
End If
Table.CurrentX = 355
If n < LBound(D) Then
Table.CurrentY = (y * 18) - 14
Table.Print "PlayTennis"
Else
Table.CurrentY = (y * 18) - 10
Table.Print ShowOutput(Output(n))
End If
Next n
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -