agentfrm.frm

一个闹钟程序

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form AgentFrm 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "MS-Agent setup"
   ClientHeight    =   4785
   ClientLeft      =   6600
   ClientTop       =   3600
   ClientWidth     =   4890
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4785
   ScaleWidth      =   4890
   Begin RichTextLib.RichTextBox txtSpeak 
      Height          =   3255
      Left            =   720
      TabIndex        =   8
      Top             =   720
      Width           =   3855
      _ExtentX        =   6800
      _ExtentY        =   5741
      _Version        =   393217
      Enabled         =   -1  'True
      TextRTF         =   $"AgentFrm.frx":0000
   End
   Begin VB.CommandButton cmdSave 
      Caption         =   "Sa&ve"
      Height          =   375
      Left            =   2520
      TabIndex        =   7
      Top             =   4320
      Width           =   975
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   120
      Top             =   1080
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton cmdAgentOpen 
      Caption         =   "O&pen"
      Height          =   375
      Left            =   1320
      TabIndex        =   6
      Top             =   4320
      Width           =   975
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "&OK"
      Default         =   -1  'True
      Height          =   375
      Left            =   3720
      TabIndex        =   5
      Top             =   4320
      Width           =   975
   End
   Begin VB.Frame Frame1 
      Caption         =   "Select your agent "
      Height          =   4095
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Width           =   4695
      Begin VB.ComboBox cboAgent 
         Enabled         =   0   'False
         Height          =   315
         Left            =   720
         Style           =   2  'Dropdown List
         TabIndex        =   2
         Top             =   360
         Width           =   1935
      End
      Begin VB.Label Label1 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "Agent:"
         Height          =   255
         Left            =   0
         TabIndex        =   4
         Top             =   360
         Width           =   615
      End
      Begin VB.Label Label2 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "Speak:"
         Height          =   255
         Left            =   0
         TabIndex        =   3
         Top             =   720
         Width           =   615
      End
   End
   Begin VB.CommandButton cmdTest 
      Caption         =   "&Test"
      Height          =   375
      Left            =   120
      TabIndex        =   0
      Top             =   4320
      Width           =   975
   End
End
Attribute VB_Name = "AgentFrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim WinDir As String
Public AgentAction As String

Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long


Private Sub cmdOK_Click()
    AgentFrm.Hide
End Sub
Public Function ActionPick()
Dim i As Integer
i = Int((21 - 0 + 1) * Rnd + 0)
Select Case i
    Case 1
        AgentAction = "Alert"
    Case 2
        AgentAction = "Announce"
    Case 3
        AgentAction = "Confused"
    Case 4
        AgentAction = "Congratulate"
    Case 5
        AgentAction = "Decline"
    Case 6
        AgentAction = "DontRecognize"
    Case 7
        AgentAction = "Explain"
    Case 8
        AgentAction = "GestureDown"
    Case 9
        AgentAction = "GestureLeft"
    Case 10
        AgentAction = "GestureRight"
    Case 11
        AgentAction = "GestureUp"
    Case 12
        AgentAction = "GetAttention"
    Case 13
        AgentAction = "GetAttentionContinued"
    Case 14
        AgentAction = "Greet"
    Case 15
        AgentAction = "LookLeft"
    Case 16
        AgentAction = "LookLeftBlink"
    Case 17
        AgentAction = "LookRight"
    Case 18
        AgentAction = "LookRightBlink"
    Case 19
        AgentAction = "Pleased"
    Case 20
        AgentAction = "RestPose"
    Case 21
        AgentAction = "Sad"
    Case Else
        AgentAction = "Wave"
    End Select
End Function
Private Sub OpenSpeakFiles()
    CommonDialog1.CancelError = True
    'User hits Cancel
    On Error GoTo ErrHandler
    CommonDialog1.Flags = cdlOFNHideReadOnly
    'Specifies what kind of files to open
CommonDialog1.Filter = "Text Files (*.txt)|*.txt"
    'Default file to open
    CommonDialog1.FilterIndex = 1
    CommonDialog1.ShowOpen
    txtSpeak.FileName = CommonDialog1.FileName
    txtSpeak.LoadFile CommonDialog1.FileName, rtfText
    'txtSpeak.TextRTF = mpMP3WAV.filename
    Exit Sub
    'User has hit Cancel
ErrHandler:
    If txtSpeak.FileName = "" Then
       AlarmForm.cboAlarmSound = "Pick one of the following"
    End If

    Exit Sub
End Sub

Private Sub SaveSpeakFiles()
    CommonDialog1.CancelError = True
    'User hits Cancel
    On Error GoTo ErrHandler
    CommonDialog1.Flags = cdlOFNHideReadOnly
    'Specifies what kind of files to save
CommonDialog1.Filter = "Text Files (*.txt)|*.txt"
    'Default file to open
    CommonDialog1.FilterIndex = 1
    CommonDialog1.ShowSave
    txtSpeak.SaveFile CommonDialog1.FileName, rtfText
    Exit Sub
    'User has hit Cancel
ErrHandler:
    If txtSpeak.FileName = "" Then
       AlarmForm.cboAlarmSound = "Pick one of the following"
    End If

    Exit Sub
End Sub

Private Sub cmdTest_Click()
    Dim frmTest As New frmAlert
    ActionPick
    Load frmTest
    frmTest.ThisIsATest = True
    frmTest.Repeat = False
 
        frmTest.AgentName = cboAgent.Text
        frmTest.SpeakText = txtSpeak.Text
        frmTest.Repeat = False
        frmTest.AgentShow
        frmTest.AgentPlay AgentAction
        frmTest.AgentSpeak
End Sub

Private Sub Form_Load()
    Dim i As Integer
    Dim d As Date
    Dim sLine As String
    Dim sa() As String
  
    
    On Error Resume Next
    WinDir = Space$(512)
    GetWindowsDirectory WinDir, Len(WinDir)
    WinDir = Trim$(WinDir)
    Mid(WinDir, Len(WinDir), 1) = "\"
    
     cboAgent.Enabled = True
        txtSpeak.Enabled = True
    
    ' get Agent names
    sLine = Dir(WinDir & "MSAgent\Chars\*.acs")
    While (Err = 0) And (Len(sLine) > 0)
        cboAgent.AddItem Left$(sLine, Len(sLine) - 4)
        sLine = Dir
    Wend
    If cboAgent.ListCount > 0 Then
        cboAgent.ListIndex = 0
    End If
End Sub


Private Sub cmdAgentOpen_Click()
OpenSpeakFiles
End Sub

Private Sub cmdSave_Click()
SaveSpeakFiles
End Sub
Private Sub Form_Unload(Cancel As Integer)
    AgentFrm.Hide
End Sub

Private Sub txtSpeak_Change()

End Sub