bobwindow.frm

非常著名的人工智能程序bob,想学人工智能的可以参考下.

VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form BobWindow 
   BackColor       =   &H80000004&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Meet Bob"
   ClientHeight    =   3450
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6615
   Icon            =   "BobWindow.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3450
   ScaleWidth      =   6615
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin VB.PictureBox PicBob 
      BackColor       =   &H00FFFFFF&
      Height          =   3435
      Left            =   0
      Picture         =   "BobWindow.frx":000C
      ScaleHeight     =   3375
      ScaleWidth      =   6555
      TabIndex        =   1
      Top             =   0
      Width           =   6615
      Begin VB.PictureBox TextWindow 
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         ForeColor       =   &H80000008&
         Height          =   2895
         Left            =   1740
         ScaleHeight     =   2865
         ScaleWidth      =   4485
         TabIndex        =   4
         Top             =   210
         Width           =   4515
         Begin VB.TextBox InputArea 
            Appearance      =   0  'Flat
            BorderStyle     =   0  'None
            Height          =   285
            Left            =   30
            TabIndex        =   2
            Text            =   "(InputArea)"
            Top             =   2430
            Width           =   4305
         End
         Begin RichTextLib.RichTextBox ResponseArea 
            Height          =   2295
            Left            =   0
            TabIndex        =   0
            Top             =   30
            Width           =   4395
            _ExtentX        =   7752
            _ExtentY        =   4048
            _Version        =   393217
            BorderStyle     =   0
            Enabled         =   -1  'True
            ReadOnly        =   -1  'True
            Appearance      =   0
            TextRTF         =   $"BobWindow.frx":135AE
         End
      End
      Begin VB.PictureBox DisplayWindow 
         BackColor       =   &H00FFFFFF&
         Height          =   2925
         Left            =   1740
         ScaleHeight     =   2865
         ScaleWidth      =   4485
         TabIndex        =   3
         Top             =   210
         Visible         =   0   'False
         Width           =   4545
      End
   End
End
Attribute VB_Name = "BobWindow"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim ReturnFunction As String
Dim TriggerKey As Boolean 'Clears text when mouse moves over
Dim BreakKey As Boolean
Dim BreakType As String
Dim StringBuffer As String

Private Sub DisplayWindow_GotFocus()
    InputArea.SetFocus
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    InputArea.SetFocus
    MsgBox KeyCode
End Sub

Private Sub Form_Load()
    TextWindow.BorderStyle = rtfNoBorder
    DisplayWindow.BorderStyle = 0
    ModFunctions.Username = "User"
    ReturnFunction = "GetUsername"
    InputArea = ""
    'ResponseArea = "[Bob] " & GetResponseForPreset("Preset3.txt", "0002")
    ResponseArea = ""
    AddColoredText "[Bob] " & GetResponseForPreset("Preset3.txt", "0002"), vbBlack, ResponseArea
    TriggerKey = True
    BreakKey = True
    BreakType = "but"
End Sub

Private Sub Form_Unload(Cancel As Integer)
    FrmMain.WindowState = vbMaximized
End Sub

Public Sub ShowDisplayBox()
    TextWindow.Visible = False
    DisplayWindow.Visible = True
End Sub

Public Sub ShowTextBox()
    TextWindow.Visible = True
    DisplayWindow.Visible = False
End Sub





Private Sub InputArea_Change()
    If BreakKey = True Then
        If LCase(InputArea.Text) = BreakType Then
            Dim sRes As Keyword
            sRes.KeywordFile = "Preset2.txt"
            sRes.KeywordNo = "0010"
            sRes.KeywordText = "[Bob] But"
            AddtoResponseArea GetRandomReply(sRes).ResponseText
            InputArea.Text = ""
        End If
    End If
End Sub

Private Sub InputArea_KeyPress(KeyAscii As Integer)
If TriggerKey = True Then
        InputArea = ""
        TriggerKey = False
End If

If KeyAscii = 13 Then
    'User hit enter
    Select Case ReturnFunction
        Case "GetUsername"
            Dim sGiven As String
            Dim sKey As Keyword
            Dim sResponse As Response
            
            sGiven = InputArea.Text
            InputArea.Text = ""
            If sGiven = "" Then sGiven = "{SILENCE}"
            sKey = KeywordSearchFile(UCase(sGiven), App.Path & "\data\preset1.txt")
            
            If sKey.KeywordText = "" Then
                If InStr(1, Trim(sGiven), " ") <> 0 Then
                    sKey.KeywordFile = "Preset2.txt"
                    sKey.KeywordNo = "0013"
                    sKey.KeywordText = sGiven
                    sKey.KeywordOrigin = sGiven
                Else
                    ModFunctions.Username = Trim(sGiven)
                    sKey.KeywordFile = "Preset3.txt"
                    sKey.KeywordNo = "0001"
                    sKey.KeywordText = sGiven
                    sKey.KeywordOrigin = sGiven
                    ReturnFunction = ""
                    BreakKey = False
                End If
            End If
            
            sResponse = GetRandomReply(sKey)
            AddColoredText "[" & ModFunctions.Username & "] " & sGiven, vbBlue, ResponseArea
            AddColoredText "[Bob] " & sResponse.ResponseText, vbBlack, ResponseArea
    
    Case Else
        Dim sReply As SimpleResponse
        sReply = GetKeywordReply(InputArea.Text)
        
        AddColoredText "[" & ModFunctions.Username & "] " & InputArea.Text, vbBlue, ResponseArea
        AddColoredText "[Bob] " & sReply.sReply, vbBlack, ResponseArea
        
        InputArea.Text = ""
        StringBuffer = ""
    End Select
ElseIf KeyAscii = 32 Then
    StringBuffer = ""
ElseIf KeyAscii = 8 Then
    
Else
    StringBuffer = StringBuffer + Chr(KeyAscii)
End If

Debug.Print StringBuffer

End Sub

Private Sub PicBob_GotFocus()
    InputArea.SetFocus
End Sub

Private Sub ResponseArea_GotFocus()
    InputArea.SetFocus
End Sub

Public Sub AddTiptoResponse(sText As String)
    AddColoredText sText, vbMagenta, ResponseArea
End Sub

Public Sub AddtoResponseArea(sText As String)
    ResponseArea.Text = ResponseArea.Text & Chr(13) & Chr(10) & sText
    ResponseArea.SelStart = Len(ResponseArea.Text)
    'ResponseArea.Text = ResponseArea.Text & sText
End Sub

Sub AddColoredText(sText As String, sColor As ColorConstants, sTarget As RichTextBox)
    Dim sLength As Long
    
    sLength = Len(sTarget.Text)
    sTarget.SelStart = sLength
    sTarget.SelText = Chr(13) & Chr(10) & sText
    sTarget.SelStart = sLength
    sTarget.SelLength = Len(sTarget.Text) - sLength
    sTarget.SelColor = sColor
    
    sTarget.SelStart = Len(ResponseArea.Text)
End Sub