mdiform1.frm

这是我大学毕业时作的毕业设计

 Else
     frmJZ_Qry.Show
 End If
 Me.MousePointer = 0
 Exit Sub
errHnd:
 Me.MousePointer = 0
End Sub

Private Sub MDIForm_Activate()

If showT = True Then Exit Sub

Dim Ltp As Long
Ltp = GetSetting(App.EXEName, "Options", "Show Tips at Startup", 1)
If Ltp = 1 Then
   frmTip.Show
End If

  showT = True

End Sub

Private Sub MDIForm_Load()

frmMain.MousePointer = 11
Dim Ltp As Long
'frmMain.WindowState = GetSetting(App.EXEName, "Windows", "Windows Status", 1)
'配置图片
StatusBar.Panels.Item(3).Text = "日期:" & Format(Date, "Long Date")
'frmMain.Caption = TempArray(0) + "-档案管理系统"
'frmMain.StatusBar.Panels.Item(6).Text = "制作单位：" + TempArray(0)
'frmMain.StatusBar.Panels.Item(6).ToolTipText = "欢迎使用本软件"
frmMain.MousePointer = 0
On Error Resume Next
'frmMain.Picture = LoadPicture(TempArray(5))
frmMain.StatusBar.Panels.Item(2).Text = "准备就绪..."
showT = False

'权限控制
Select Case PurView
   Case "只能添加"
     MnuEmploy.Enabled = False
   Case "不能修改"
     MnuEmploy.Enabled = False
   Case "可以修改"
     MnuEmploy.Enabled = False
   Case "超级权限"
     '没有权限限制,拥有对用户管理的权限
End Select

End Sub

Private Sub MDIForm_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

'  If Button = 2 Then '右键按下时
'     PopupMenu MnuSystem
'  End If
  
End Sub

Private Sub MDIForm_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

If frmMain.StatusBar.Panels.Item(2).Text = "待命状态..." Then
   Exit Sub
   Else
   frmMain.StatusBar.Panels.Item(2).Text = "待命状态..."
End If

End Sub

Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim SureQ As Integer
SureQ = MsgBox("真的退出该系统吗(Y/N)？    ", vbYesNo + 32, "请确认...")
  If SureQ = 6 Then
     Cancel = 0
     Else
     Cancel = -1
  End If
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
    For i = Forms.Count - 1 To 1 Step -1
        Unload Forms(i)
    Next
End Sub


Private Sub MnuCompany_Click()
 Me.MousePointer = 11
 GetStatus "公司信息配置"
 If ConfigForm.Visible = True Then
    ConfigForm.SetFocus
 Else
    ConfigForm.Show
 End If
 Me.MousePointer = 0
 
End Sub

Private Sub MnuEmploy_Click()
 Me.MousePointer = 11
 GetStatus "操作员配置"
 If frmOperator.Visible = True Then
    frmOperator.SetFocus
 Else
    frmOperator.Show
 End If
 Me.MousePointer = 0
End Sub

Private Sub MnuExi_Click()
 GetStatus "关闭系统"
 Unload Me
End Sub

Private Sub MnuGuestManager_Click()
 GetStatus "档案添加、删除、修改、查询"
End Sub

Private Sub MnuGuestType_Click()
 
 frmMain.MousePointer = 11
 GetStatus "档案类型有：公文、原始材料"
 frmCatalog.Show
 frmMain.MousePointer = 0

 
End Sub

Private Sub Mnuhelp_Click()

GetStatus "配置桌片图片、操作员、关于信息"

End Sub





Private Sub MnuInsertData_Click()
On Error GoTo errHnd:

 Me.MousePointer = 11
 GetStatus "医院挂号--录入档案"
 If frmadddoc.Visible = True Then
    frmadddoc.SetFocus
 Else
    frmadddoc.Show
 End If
 Me.MousePointer = 0
 Exit Sub
errHnd:
 Me.MousePointer = 0

End Sub

Private Sub MnuInsertHY_Click()
On Error GoTo errHnd:
 Me.MousePointer = 11
 GetStatus "化验信息"
 If frmHYInfo.Visible = True Then
    frmHYInfo.SetFocus
 Else
    frmHYInfo.Show
 End If
 Me.MousePointer = 0
 Exit Sub
errHnd:
 Me.MousePointer = 0

End Sub

Private Sub MnuInsertJF_Click()
On Error GoTo errHnd:
 Me.MousePointer = 11
 GetStatus "交费系统"
 If frmJF.Visible = True Then
    frmJF.SetFocus
 Else
    frmJF.Show
 End If
 Me.MousePointer = 0
 Exit Sub
errHnd:
 Me.MousePointer = 0

End Sub

Private Sub MnuInsertJZ_Click()
On Error GoTo errHnd:
 Me.MousePointer = 11
 GetStatus "就诊系统"
 If frmJZ.Visible = True Then
    frmJZ.SetFocus
 Else
    frmJZ.Show
 End If
 Me.MousePointer = 0
 Exit Sub
errHnd:
 Me.MousePointer = 0

End Sub

Private Sub MnuInsertQY_Click()
On Error GoTo errHnd:
 Me.MousePointer = 11
 GetStatus "取药信息"
 If frmQY.Visible = True Then
    frmQY.SetFocus
 Else
    frmQY.Show
 End If
 Me.MousePointer = 0
 Exit Sub
errHnd:
 Me.MousePointer = 0

End Sub

Private Sub MnuSearchGuest_Click()

 frmMain.MousePointer = 11
  If frmManager.Visible = True Then
     frmManager.SetFocus
   Else
     frmManager.Show
  End If
 frmMain.MousePointer = 0
 
End Sub

Private Sub MnuSelectData_Click()
On Error GoTo errHnd:
 Me.MousePointer = 11
 GetStatus "医院挂号--选择档案"
 If frmchosedoc.Visible = True Then
   frmchosedoc.SetFocus
 Else
    frmchosedoc.Show
 End If
 Me.MousePointer = 0
 Exit Sub
errHnd:
 Me.MousePointer = 0

End Sub

Private Sub MnuTip_Click()

frmMain.MousePointer = 11
GetStatus "系统的使用技巧与帮助"
If frmTip.Visible = True Then
  frmTip.SetFocus
  frmMain.MousePointer = 0
  Exit Sub
End If
SaveSetting App.EXEName, "Options", "Show Tips at Startup", -1

If frmTip.Visible = True Then
   frmTip.SetFocus
End If
frmTip.Show
frmMain.MousePointer = 0

End Sub




Private Sub MnuWxy_Click()

 frmMain.MousePointer = 11
 GetStatus "关于系统描述"
 frmAbout.Show 1
 frmMain.MousePointer = 0
 
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)

  Select Case Button.Key

    Case "GH"
      GetStatus "挂号管理--录入档案"
      Call MnuInsertData_Click
    Case "Select"
      GetStatus "挂号管理--选择档案"
      Call MnuSelectData_Click
    Case "HY"
      GetStatus "化验管理--化验信息"
      Call MnuInsertHY_Click
    Case "JF"
      GetStatus "交费系统--交费管理"
      Call MnuInsertJF_Click
    Case "JZ"
      GetStatus "就诊系统--就诊信息"
      Call MnuInsertJZ_Click
    Case "QY"
      GetStatus "取药管理--取药信息"
      Call MnuInsertQY_Click
    Case "Help"
      GetStatus "系统操作手册"
      Call MnuTip_Click
    Case "Exit"
      GetStatus "退出医院管理系统"
      Call MnuExi_Click
'    Case "ZYXX"
'      GetStatus "住院信息"
'
'    Case "ZYCX"
'      GetStatus "住院查询"
  End Select
  
   
End Sub

Private Sub ZYCX_Click()
On Error GoTo errHnd:
 Me.MousePointer = 11
 GetStatus "住院信息查询"
 If frmZY_Qry.Visible = True Then
     frmZY_Qry.SetFocus
 Else
     frmZY_Qry.Show
 End If
 Me.MousePointer = 0
 Exit Sub
errHnd:
 Me.MousePointer = 0
End Sub

Private Sub ZYxx_Click()

On Error GoTo errHnd:
 Me.MousePointer = 11
 GetStatus "住院信息"
 If frmZY.Visible = True Then
     frmZY.SetFocus
 Else
     frmZY.Show
 End If
 Me.MousePointer = 0
 Exit Sub
errHnd:
 Me.MousePointer = 0
End Sub