mdiform1.frm

prescription management

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.MDIForm MDIForm1 
   BackColor       =   &H80000003&
   Caption         =   "痹证方剂数据库系统"
   ClientHeight    =   7440
   ClientLeft      =   165
   ClientTop       =   855
   ClientWidth     =   9930
   Icon            =   "MDIForm1.frx":0000
   LinkTopic       =   "MDIForm1"
   Picture         =   "MDIForm1.frx":0442
   StartUpPosition =   3  'Windows Default
   WindowState     =   2  'Maximized
   Begin MSComctlLib.StatusBar StatusBar1 
      Align           =   2  'Align Bottom
      Height          =   300
      Left            =   0
      TabIndex        =   0
      Top             =   7140
      Width           =   9930
      _ExtentX        =   17515
      _ExtentY        =   529
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   5
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Alignment       =   1
            Object.Width           =   5292
            MinWidth        =   5292
            Text            =   " 痹证方剂数据库系统"
            TextSave        =   " 痹证方剂数据库系统"
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Alignment       =   1
            Object.Width           =   8819
            MinWidth        =   8819
            Text            =   "作者：王友庆  邮箱：[e-mail]   导师：刘学华"
            TextSave        =   "作者：王友庆  邮箱：[e-mail]   导师：刘学华"
         EndProperty
         BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Alignment       =   1
            Object.Width           =   4304
            MinWidth        =   4304
         EndProperty
         BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Alignment       =   1
            Object.Width           =   5292
            MinWidth        =   5292
         EndProperty
         BeginProperty Panel5 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Object.Width           =   5293
            MinWidth        =   5293
         EndProperty
      EndProperty
      OLEDropMode     =   1
   End
   Begin VB.Menu xitong 
      Caption         =   "系统管理 &(O)"
      NegotiatePosition=   3  'Right
      Begin VB.Menu useradd 
         Caption         =   "添加用户"
         Shortcut        =   ^A
      End
      Begin VB.Menu usermodi 
         Caption         =   "修改密码"
         Shortcut        =   ^B
      End
      Begin VB.Menu denglu2 
         Caption         =   "重新登陆"
         Shortcut        =   ^{F1}
      End
      Begin VB.Menu tuichu2 
         Caption         =   "退出登陆"
      End
   End
   Begin VB.Menu class 
      Caption         =   "方剂管理&(P)"
      NegotiatePosition=   2  'Middle
      Begin VB.Menu classbrowse 
         Caption         =   "方剂浏览"
         Shortcut        =   ^C
      End
      Begin VB.Menu classapp 
         Caption         =   "添加方剂"
         Shortcut        =   ^D
      End
      Begin VB.Menu classfind 
         Caption         =   "方剂查询"
         Shortcut        =   ^E
      End
   End
   Begin VB.Menu tongji 
      Caption         =   "方剂统计分析&(T)"
      Begin VB.Menu pinshu 
         Caption         =   "频数统计"
      End
   End
   Begin VB.Menu guanyu 
      Caption         =   "关于&(R)"
   End
End
Attribute VB_Name = "MDIForm1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Dim songname$, appdisk$, bb$

Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Dim find1 As Integer
Dim liulan1 As Integer

Private Sub useradd_Click()
qxstr = Executeqx(1)
If qxstr = "false" Or qxstr = "readonly" Then
   ss = MsgBox("对不起，你没有管理本功能的权限，请与管理员联系！", vbInformation + vbOKOnly, " 警告")
 Exit Sub
End If
frmuser1.Show
frmuser1.ZOrder 0
End Sub

Private Sub usermodi_Click()
qxstr = Executeqx(1)
If qxstr = "false" Then
   ss = MsgBox("对不起，你没有管理本功能的权限，请与管理员联系！", vbInformation + vbOKOnly, " 警告")
 Exit Sub
End If
End Sub

Private Sub denglu2_Click()
Unload Me
Frmdenlu.Show
End Sub

Private Sub tuichu2_Click()
mciSendString "stop " & songname, vbNullString, 0, 0
Unload Me
End Sub

Private Sub classbrowse_Click()
qxstr = Executeqx(2)
If qxstr = "false" Then
   ss = MsgBox("对不起，你没有管理本功能的权限，请与管理员联系！", vbInformation + vbOKOnly, " 警告")
 Exit Sub
End If
Formclass2.Show
End Sub

Private Sub classapp_Click()
qxstr = Executeqx(2)
If qxstr = "false" Or qxstr = "readonly" Then
   ss = MsgBox("对不起，你没有管理本功能的权限，请与管理员联系！", vbInformation + vbOKOnly, " 警告")
 Exit Sub
End If
Formclass1.Show
  classmodi = False
  Formclass1.classload
  Formclass1.ZOrder (0)
End Sub

Private Sub classfind_Click()
qxstr = Executeqx(2)
If qxstr = "false" Then
   ss = MsgBox("对不起，你没有管理本功能的权限，请与管理员联系！", vbInformation + vbOKOnly, " 警告")
 Exit Sub
End If
 Formclass3.Show
 Formclass3.ZOrder (0)
 Formclass3.Text1(0).SetFocus
End Sub

Private Sub pinshu_Click()
Form1.Show
End Sub

Private Sub guanyu_Click()
Form2.Show
End Sub


Private Sub MDIForm_Load()
'username = "0001"
'DataEnv1.Connection1.ConnectionString = connstring
appdisk = Trim(App.Path)
 If Right(appdisk, 1) <> "\" Then appdisk = appdisk & "\"
 bb = "高山流水.mp3"
 If InStr(bb, " ") > 0 Then
 '判断歌曲名是否有空格,有的话就去掉,并拷备为没空格的新歌曲名(在同一路径下)
 songname = Replace(bb, " ", "")
 FileCopy appdisk & bb, appdisk & songname
 Else
 songname = bb
 End If
  
 If InStr(appdisk, " ") > 0 Then '判断路径是否有空格
 '将歌曲拷到你windows系统盘符下.
 FileCopy appdisk & songname, Left(appdisk, 3) & songname
 songname = Left(appdisk, 3) & songname
 Else
 songname = appdisk & songname
 End If
 mciSendString "play " & songname, vbNullString, 0, 0


StatusBar1.Panels(3).text = "南京中医药大学"
StatusBar1.Panels(4).text = "当前操作员：   " & username
Dim aa As String
Select Case Executeqx(1)
Case "admin"
  aa = "超级管理员"
Case "readonly"
  aa = "只读管理员"
Case Else
  aa = "普通管理员"
End Select
StatusBar1.Panels(5).text = "状态：  " & aa
End Sub


Private Sub MDIForm_Unload(Cancel As Integer)
 mciSendString "stop " & songname, vbNullString, 0, 0
End Sub