⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.frm

📁 在visual basic环境下
💻 FRM
📖 第 1 页 / 共 2 页
字号:
      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 + -