frmmain.frm

自动售药系统

VERSION 5.00
Object = "{F5BE8BC2-7DE6-11D0-91FE-00C04FD701A5}#2.0#0"; "agentctl.dll"
Object = "{D27CDB6B-AE6D-11CF-96B8-444553540000}#1.0#0"; "Flash.ocx"
Object = "{6BF52A50-394A-11D3-B153-00C04F79FAA6}#1.0#0"; "wmp.dll"
Begin VB.Form frmMain 
   BorderStyle     =   0  'None
   Caption         =   "自动售药"
   ClientHeight    =   9960
   ClientLeft      =   120
   ClientTop       =   690
   ClientWidth     =   14775
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   Picture         =   "frmMain.frx":08CA
   ScaleHeight     =   9960
   ScaleWidth      =   14775
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   WindowState     =   2  'Maximized
   Begin VB.Timer Timer2 
      Enabled         =   0   'False
      Interval        =   20000
      Left            =   9360
      Top             =   720
   End
   Begin VB.Timer Timer1 
      Interval        =   10000
      Left            =   8640
      Top             =   720
   End
   Begin VB.CommandButton Command1 
      Caption         =   "播放广告"
      Height          =   375
      Left            =   8760
      TabIndex        =   0
      Top             =   120
      Visible         =   0   'False
      Width           =   1575
   End
   Begin WMPLibCtl.WindowsMediaPlayer WindowsMediaPlayer1 
      Height          =   7665
      Left            =   3720
      TabIndex        =   11
      Top             =   1440
      Visible         =   0   'False
      Width           =   9780
      URL             =   "E:\vbDelevop\AD\01.mpg"
      rate            =   1
      balance         =   0
      currentPosition =   0
      defaultFrame    =   ""
      playCount       =   1
      autoStart       =   0   'False
      currentMarker   =   0
      invokeURLs      =   -1  'True
      baseURL         =   ""
      volume          =   50
      mute            =   0   'False
      uiMode          =   "none"
      stretchToFit    =   -1  'True
      windowlessVideo =   0   'False
      enabled         =   -1  'True
      enableContextMenu=   0   'False
      fullScreen      =   0   'False
      SAMIStyle       =   ""
      SAMILang        =   ""
      SAMIFilename    =   ""
      captioningID    =   ""
      enableErrorDialogs=   0   'False
      _cx             =   17251
      _cy             =   13520
   End
   Begin ShockwaveFlashObjectsCtl.ShockwaveFlash ShockwaveFlash1 
      Height          =   4815
      Left            =   3960
      TabIndex        =   6
      Top             =   1800
      Width           =   4935
      _cx             =   8705
      _cy             =   8493
      FlashVars       =   ""
      Movie           =   ""
      Src             =   ""
      WMode           =   "Transparent"
      Play            =   -1  'True
      Loop            =   -1  'True
      Quality         =   "High"
      SAlign          =   ""
      Menu            =   0   'False
      Base            =   ""
      AllowScriptAccess=   "always"
      Scale           =   "ShowAll"
      DeviceFont      =   0   'False
      EmbedMovie      =   -1  'True
      BGColor         =   ""
      SWRemote        =   ""
      MovieData       =   ""
      SeamlessTabbing =   -1  'True
   End
   Begin VB.Label Label9 
      BackStyle       =   0  'Transparent
      Height          =   375
      Left            =   9360
      TabIndex        =   10
      Top             =   360
      Width           =   2055
   End
   Begin VB.Label Label8 
      BackStyle       =   0  'Transparent
      Height          =   615
      Left            =   13680
      TabIndex        =   9
      Top             =   9720
      Width           =   615
   End
   Begin VB.Label Label7 
      BackStyle       =   0  'Transparent
      Height          =   495
      Left            =   1080
      TabIndex        =   8
      Top             =   480
      Width           =   735
   End
   Begin VB.Label Label6 
      BackStyle       =   0  'Transparent
      Height          =   735
      Left            =   720
      TabIndex        =   7
      Top             =   4320
      Width           =   975
   End
   Begin VB.Label Label5 
      BackStyle       =   0  'Transparent
      Height          =   615
      Left            =   480
      TabIndex        =   5
      Top             =   7680
      Width           =   735
   End
   Begin VB.Label Label4 
      BackStyle       =   0  'Transparent
      Height          =   735
      Left            =   840
      TabIndex        =   4
      Top             =   6360
      Width           =   855
   End
   Begin VB.Label Label3 
      BackStyle       =   0  'Transparent
      Height          =   735
      Left            =   120
      TabIndex        =   3
      Top             =   5400
      Width           =   1095
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Height          =   855
      Left            =   360
      TabIndex        =   2
      Top             =   3120
      Width           =   855
   End
   Begin AgentObjectsCtl.Agent Agent1 
      Left            =   2640
      Top             =   9960
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Height          =   975
      Left            =   600
      TabIndex        =   1
      Top             =   1920
      Width           =   975
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private ht As Integer
Dim dx, dy

Private Sub Agent1_Move(ByVal CharacterID As String, ByVal x As Integer, ByVal y As Integer, ByVal Cause As Integer)
  'Call Sleep(8000)
   
   
End Sub

'Const DATAPATH = "SAEKO.acs"
Private Sub Command1_Click()
frmMovie.Show
  
End Sub



Private Sub Form_Load()
    Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
    'Me.Width = 800
    'Me.Height = 600
    Dim DATAPATH As String
    DATAPATH = App.Path & "\SAEKO.acs"
   '  'FrmVideo.Show (1)
    Agent1.Characters.Load "SAEKO", DATAPATH
    Set Genie = Agent1.Characters("SAEKO")
    Genie.LanguageID = &H804
    Genie.Show
    Genie.MoveTo 20, 580
    Genie.Speak "您好，欢迎使用平安自动诊疗咨询售药机", ""
    'Genie.Hide
    'Genie.Left = 480
    'Genie.Top = 7440
    
    ShockwaveFlash1.Movie = App.Path & "\f.swf"
    ShockwaveFlash1.BGColor = "transparent"
    ShockwaveFlash1.WMode = "transparent"
    ShockwaveFlash1.Play
    
    ht = 0
    'Call Sleep(8000)
    ' Genie.Speak "购买本机药品请按（本机购药）按钮", ""
     'Call Sleep(1000)
     'Genie.Speak "咨询药品医疗信息请按（自我药疗）按钮", ""
     'Call Sleep(1000)
     'Genie.Speak "专家视频问诊服务请按（求医问药）按钮", ""
     'Call Sleep(1000)
     'Genie.Speak "专家视频问诊服务请按（求医问药）按钮", ""
     'Call Sleep(1000)
     'Genie.Speak "查询国家医药政策、法规请按（政策法规）按钮", ""
     'Call Sleep(1000)
     'Genie.Speak "查询OTC药品目录请按（OTC药品目录）按钮", ""
End Sub


Private Sub Form_Unload(Cancel As Integer)
    Dim i As Integer


    'close all sub forms
    For i = Forms.Count - 1 To 1 Step -1
        Unload Forms(i)
    Next
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
End Sub

Private Sub Label1_Click()
WindowsMediaPlayer1.Close
WindowsMediaPlayer1.Visible = False
     Genie.Speak "购买本机药品请按（本机购药）按钮", ""
     Call Sleep(2000)
    frmSale.Show (1)
    
End Sub

Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
   
    'Genie.Think ("什么问题")
    'Genie.Play "Suggest"

End Sub

Private Sub Label2_Click()
WindowsMediaPlayer1.Close
WindowsMediaPlayer1.Visible = False

frmMedicine.Show (1)
End Sub

Private Sub Label3_Click()
WindowsMediaPlayer1.Close
WindowsMediaPlayer1.Visible = False

frmSelf.Show (1)
'Genie.Think ("正在建设中........")
End Sub

Private Sub Label4_Click()
WindowsMediaPlayer1.Close
WindowsMediaPlayer1.Visible = False

'Genie.Speak "欢迎您使用政策法规查询在这里您可以查询到您所要了解的国家药品管理政策和管理办法", ""
frmInfo.Show (1)
End Sub

Private Sub Label5_Click()
WindowsMediaPlayer1.Close
WindowsMediaPlayer1.Visible = False
'Genie.Speak "欢迎您使用OTC药品目录查询，在这里您可以查询了解到国家公布的OTC药品种类和相关的药品说明 ", ""
frmOtc.Show (1)
End Sub

Private Sub Label6_Click()
WindowsMediaPlayer1.Close
WindowsMediaPlayer1.Visible = False
frmDoctor.Show (1)
End Sub

Private Sub Label7_Click()
ht = 1
End Sub

Private Sub Label8_Click()
If ht = 1 Then
ht = ht + 1
If ht = 2 Then
Genie.Hide
frmLogin.txtPwd.Text = ""
frmLogin.Show (1)
End If
End If
End Sub

Private Sub Timer1_Timer()
Dim CursorPos As POINTAPI
tmp = GetCursorPos(CursorPos)

  dx = CursorPos.x
  dy = CursorPos.y

  Timer2.Enabled = True
End Sub

Private Sub Timer2_Timer()
Dim CursorPos As POINTAPI
Dim DistX As Long, DistY As Long
Dim tmp As Long

tmp = GetCursorPos(CursorPos)
DistX = CursorPos.x
DistY = CursorPos.y
If dx = DistX Then
If dy = DistY Then
WindowsMediaPlayer1.Visible = True
WindowsMediaPlayer1.Controls.Play
Timer1.Enabled = False
End If
End If
End Sub

Private Sub WindowsMediaPlayer1_Click(ByVal nButton As Integer, ByVal nShiftState As Integer, ByVal fX As Long, ByVal fY As Long)
WindowsMediaPlayer1.Close
WindowsMediaPlayer1.Visible = False

End Sub