main.frm

医院管理系统已经在运行中

      End
      Begin VB.Menu y 
         Caption         =   "-"
      End
      Begin VB.Menu bjsz 
         Caption         =   "背景设置"
      End
      Begin VB.Menu v 
         Caption         =   "-"
      End
      Begin VB.Menu jsq 
         Caption         =   "计算器"
         Shortcut        =   ^Z
      End
      Begin VB.Menu u 
         Caption         =   "-"
      End
      Begin VB.Menu gy 
         Caption         =   "关于系统"
      End
   End
   Begin VB.Menu ext 
      Caption         =   "退出系统(&X)"
   End
   Begin VB.Menu r 
      Caption         =   "rmenu"
      Visible         =   0   'False
      Begin VB.Menu q10 
         Caption         =   "  刷    新   "
      End
      Begin VB.Menu q9 
         Caption         =   "-"
      End
      Begin VB.Menu aq 
         Caption         =   "  分类初始   "
      End
      Begin VB.Menu bq 
         Caption         =   "  项目初始   "
      End
      Begin VB.Menu cq 
         Caption         =   "  药品入库   "
      End
      Begin VB.Menu q1 
         Caption         =   "-"
      End
      Begin VB.Menu a6 
         Caption         =   "  划价管理   "
         Begin VB.Menu dq 
            Caption         =   "门诊处方划价"
         End
         Begin VB.Menu eq 
            Caption         =   "病房处方划价"
         End
      End
      Begin VB.Menu q2 
         Caption         =   "-"
      End
      Begin VB.Menu q7 
         Caption         =   "  收费管理   "
         Begin VB.Menu fq 
            Caption         =   "门诊处方收费"
         End
         Begin VB.Menu gq 
            Caption         =   "病房处方收费"
         End
      End
      Begin VB.Menu q3 
         Caption         =   "-"
      End
      Begin VB.Menu ty 
         Caption         =   "  退药处理"
      End
      Begin VB.Menu vbv 
         Caption         =   "-"
      End
      Begin VB.Menu hq 
         Caption         =   "  划价查询  "
      End
      Begin VB.Menu iq 
         Caption         =   "  收费查询  "
      End
      Begin VB.Menu q4 
         Caption         =   "-"
      End
      Begin VB.Menu q8 
         Caption         =   "  系统维护   "
         Begin VB.Menu jq 
            Caption         =   "系统初始"
         End
         Begin VB.Menu kq 
            Caption         =   "权限管理"
         End
         Begin VB.Menu lq 
            Caption         =   "背景设置"
         End
         Begin VB.Menu mq 
            Caption         =   "计算器"
         End
         Begin VB.Menu nq 
            Caption         =   "关于..."
         End
      End
   End
End
Attribute VB_Name = "main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub aq_Click()
 flcsh.Show 1
End Sub

Private Sub bjsz_Click()
  Cd2.FileName = ""
  Cd2.ShowOpen
  Me.Picture = LoadPicture(Cd2.FileName)
  Open App.Path + "bj.zzk" For Output As #3
  Print #3, Cd2.FileName
  Close #3
End Sub


Private Sub bq_Click()
gnxmchshh.Show 1
End Sub

Private Sub chfhj_Click()
  chffrm.Show 1
End Sub

Private Sub chfshf_Click()
  shffrm.Show 1
End Sub

Private Sub cq_Click()
   yprkfrm.Show 1
End Sub

Private Sub csfl_Click()
flcsh.Show 1
End Sub

Private Sub dq_Click()
 chffrm.Show 1
End Sub

Private Sub eq_Click()
   gnhjfrm.Show 1
End Sub

Private Sub ext_Click()
   h = MsgBox("您确认要退出系统吗？", vbYesNo)
   If h = 6 Then
      End
   End If
End Sub

Private Sub Form_Activate()
  On Error GoTo er
   Sb1.Panels(4).Text = " 日期： " & Date
   Sb1.Panels(3).Text = czylx + "：" + czyxm
   If Dir(App.Path + "bj.zzk") <> "" Then
      Open App.Path + "bj.zzk" For Input As #4
      Input #4, bjt
      Close #4
      Me.Picture = LoadPicture(bjt)
   End If
   If czylx <> "管理员" And czylx <> "划价员" And czylx <> "收费员" Then
      MsgBox "操作员类型不正确，您无权对系统进行操作", vbOKOnly + 16
      End
   End If
   If czylx = "划价员" Then
      csfl.Enabled = False
      gnxmcsh.Enabled = False
      yprk.Enabled = False
      chfshf.Enabled = False
      gnshf.Enabled = False
      sfywcx.Enabled = False
      xtcsh.Enabled = False
      qxgl.Enabled = False
      aq.Enabled = False
      bq.Enabled = False
      cq.Enabled = False
      fq.Enabled = False
      gq.Enabled = False
      iq.Enabled = False
      jq.Enabled = False
      kq.Enabled = False
      tychl.Enabled = False
      ty.Enabled = False
   End If
   If czylx = "收费员" Then
      csfl.Enabled = False
      gnxmcsh.Enabled = False
      yprk.Enabled = False
      chfhj.Enabled = False
      gnhj.Enabled = False
      hjywcx.Enabled = False
      xtcsh.Enabled = False
      qxgl.Enabled = False
      aq.Enabled = False
      bq.Enabled = False
      cq.Enabled = False
      dq.Enabled = False
      eq.Enabled = False
      hq.Enabled = False
      jq.Enabled = False
      kq.Enabled = False
   End If
   Exit Sub
er:
   MsgBox "出现运行错误！背景文件丢失或其他错误！"
   
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, y As Single)
   If Button = 2 Then
      PopupMenu r
   End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
   h = MsgBox("您确认要退出系统吗？", vbYesNo)
   If h = 6 Then
      End
   Else
      Cancel = 1
   End If
  
End Sub

Private Sub fq_Click()
shffrm.Show 1
End Sub

Private Sub gnhj_Click()
  gnhjfrm.Show 1
End Sub

Private Sub gnshf_Click()
   gnshffrm.Show 1
End Sub

Private Sub gnxmcsh_Click()
    gnxmchshh.Show 1
End Sub

Private Sub gq_Click()
gnshffrm.Show 1
End Sub

Private Sub gy_Click()
   frmAbout.Show 1
End Sub

Private Sub hjywcx_Click()
   hjcxfrm.Show 1
End Sub

Private Sub hq_Click()
hjcxfrm.Show 1
End Sub

Private Sub iq_Click()
sfcxfrm.Show 1
End Sub

Private Sub jq_Click()
xtchshh.Show 1
End Sub

Private Sub jsq_Click()
On Error GoTo la:
   X = Shell("c:\windows\calc.exe", 1)
   Exit Sub
la:
   MsgBox "计算器工具没有找到！。", vbOKOnly + 16
End Sub

Private Sub kq_Click()
klxgfrm.Show 1
End Sub

Private Sub lq_Click()
  Cd2.FileName = ""
  Cd2.ShowOpen
  Me.Picture = LoadPicture(Cd2.FileName)
  Open App.Path + "bj.zzk" For Output As #3
  Print #3, Cd2.FileName
  Close #3
End Sub

Private Sub mq_Click()
On Error GoTo la:
   X = Shell("c:\windows\calc.exe", 1)
   Exit Sub
la:
   MsgBox "计算器工具没有找到！。", vbOKOnly + 16
End Sub

Private Sub nq_Click()
frmAbout.Show 1
End Sub

Private Sub q10_Click()
  Label1.Top = -Label1.Height
  Label1.Visible = True
  Randomize
  Label1.Left = Int(Rnd * 12700)
  While Label1.Top <= Me.Height
     Label1.Top = Label1.Top + 1
     For k = 1 To 2000
     Next k
  Wend
  Me.Cls
End Sub

Private Sub qxgl_Click()
   klxgfrm.Show 1
End Sub

Private Sub sfywcx_Click()
   sfcxfrm.Show 1
End Sub

Private Sub Timer1_Timer()
   Sb1.Panels(5).Text = " 时间： " & Time
End Sub

Private Sub Timer2_Timer()
  On Error GoTo kk
     Dt1.DatabaseName = dbstr
     Dt1.RecordSource = "门诊处方"
     Dt1.Refresh
     Ad1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" + dbstr
     Ad1.RecordSource = "czy"
     Ad1.Refresh
     Exit Sub
kk:
     MsgBox "网络连接出现故障，系统被迫终止！！" + Chr(13) + Chr(10) + "请检查网络连接是否正常，然后重新启动系统。！"
     End
End Sub

Private Sub ty_Click()
   tychlfrm.Show 1
End Sub

Private Sub tychl_Click()
   tychlfrm.Show 1
End Sub

Private Sub xtcsh_Click()
   xtchshh.Show 1
End Sub

Private Sub yprk_Click()
   yprkfrm.Show 1
End Sub