frmmain.frm

本系统可用于医院和专业体检中心的健康体检管理

    Set FrmSJZDDC = Nothing
End Sub

Private Sub mnuQF_TJBZ_Click()
    FormTJBZWH.Show vbModal
    Set FormTJBZWH = Nothing
End Sub

Private Sub mnuQF_TJDJ_Click()
'    FrmAffirm.Show
    FrmAffirmLvw.Show

End Sub

Private Sub mnuQF_TJDWWH_Click()
    frmTJDW.Show vbModal
    Set frmTJDW = Nothing
End Sub

Private Sub mnuQF_TJHCDC_Click()
    dlgTJHCDC.Show vbModal
    Set dlgTJHCDC = Nothing
End Sub

Private Sub mnuQF_TJHCGL_Click()
    FrmHCGL.Show vbModal
    Set FrmHCGL = Nothing
End Sub

Private Sub mnuQF_TJHCSZ_Click()
    FrmHCSZ.Show vbModal
    Set FrmHCSZ = Nothing
End Sub

Private Sub mnuQF_TJJGCX_Click()
    frmQuery.Show vbModal
    Set frmQuery = Nothing
End Sub

Private Sub mnuQF_TJJGLR_Click()
    If genuVersion = BZB Or genuVersion = PJB Or genuVersion = ZYB Then
        FrmBZB_Input.Show
        FrmBZB_Input.ZOrder 0
    ElseIf genuVersion = WLB Then
        frmBrowser.Show
        frmBrowser.ZOrder 0
    End If
End Sub

Private Sub mnuQF_TJJYWH_Click()
    FrmJYWH.Show vbModal
    Set FrmJYWH = Nothing
End Sub

Private Sub mnuQF_TJPLLR_Click()
    frmBatchInput.Show vbModal
    Set frmBatchInput = Nothing
End Sub

Private Sub mnuQF_TJPQ_Click()
    FrmTJPQ.Show vbModal
    Set FrmTJPQ = Nothing
End Sub

Private Sub mnuQF_TJRSTJ_Click()
    FrmTJRSTJ.Show
End Sub

Private Sub mnuQF_TJYY_Click()
    frmRegister.Show
    frmRegister.ZOrder 0
End Sub

Private Sub mnuQF_TotalPay_Click()
    FrmFYHZ.Show
End Sub

Private Sub mnuQF_TTFYHZ_Click()
    FrmDWTJFY.Show vbModal
    Set FrmDWTJFY = Nothing
End Sub

Private Sub mnuQF_TTYY_Click()
    frmClassify.Show
End Sub

Private Sub mnuQF_UnReg_Click()
    g_blnReLogin = True
    Unload Me
    FrmLogin.Show
End Sub

Private Sub mnuQF_XMDC_Click()
    mnuXMDC_Click
End Sub

Private Sub mnuQF_XMZH_Click()
  frmXMZH.Show vbModal
  Set frmXMZH = Nothing
End Sub

Private Sub mnuQF_XTZC_Click()
    If FrmXTZC.ShowRegister = True Then
        Unload FrmXTZC
        Set FrmXTZC = Nothing
        
        Unload Me
    Else
        Unload FrmXTZC
        Set FrmXTZC = Nothing
        
        If gblnRegister = True Then
            mnuXTZC.Visible = False
            mnuSplit1.Visible = False
        End If
    End If

End Sub

Private Sub mnuQF_YSGZLTJ_Click()
    dlgKSGZL.ShowStatistic False '这里不是要求模态显示，而是调用了自定义函数
    Set dlgKSGZL = Nothing
End Sub

Private Sub mnuQF_YYHDJRS_Click()
    FrmYYHDJRS.Show vbModal
    Set FrmYYHDJRS = Nothing
End Sub

Private Sub mnuQF_YYTX_Click()
    FormYYTX.Show vbModal
    Set FormYYTX = Nothing
End Sub

Private Sub mnuQF_ZDGJ_Click()
    dlgCompose.Show vbModal
    Set dlgCompose = Nothing
End Sub

Private Sub mnuQF_ZhuXiao_Click()
    FrmICKGL.Show vbModal
    Set FrmICKGL = Nothing
End Sub

Private Sub mnuQF_ZSJYLR_Click()
    frmFinish.Show
    frmFinish.ZOrder 0
End Sub

Private Sub mnuQF_ZYBSJZDWH_Click()
    FrmZYBSSZ.Show vbModal
    Set FrmZYBSSZ = Nothing
End Sub

Private Sub mnuRYGL_Click()
    FormEmployeeChange.Show vbModal
    Set FormEmployeeChange = Nothing
End Sub

Private Sub mnuSJKQK_Click()
    Call InitializeSystem
End Sub

Private Sub mnuSJZDDC_Click()
    FrmSJZDDC.Show vbModal
    Set FrmSJZDDC = Nothing
End Sub

Private Sub mnuTJBZ_Click()
    FormTJBZWH.Show vbModal
    Set FormTJBZWH = Nothing
End Sub

Private Sub mnuTJJGCX_Click()
    frmQuery.Show vbModal
    Set frmQuery = Nothing
End Sub

Private Sub mnuTJJGLR_Click()
'    frmBrowser.Show
'    frmBrowser.ZOrder 0
    If genuVersion = BZB Or genuVersion = PJB Or genuVersion = ZYB Then
        FrmBZB_Input.Show
        FrmBZB_Input.ZOrder 0
    ElseIf genuVersion = WLB Then
        frmBrowser.Show
        frmBrowser.ZOrder 0
    End If
End Sub

Private Sub mnuTJJYWH_Click()
    FrmJYWH.Show vbModal
    Set FrmJYWH = Nothing
End Sub

Private Sub mnuTJPLLR_Click()
    frmBatchInput.Show vbModal
    Set frmBatchInput = Nothing
End Sub

Private Sub mnuTJRSTJ_Click()
    FrmTJRSTJ.Show
End Sub

Private Sub mnuTTDJ_Click()
    frmClassify.Show
End Sub

Private Sub mnuTTMDDC_Click()
    FrmNewTTMDDC.Show vbModal
    Set FrmNewTTMDDC = Nothing
End Sub

Private Sub mnuWJYC_Click()
    FrmWJYC.Show vbModal
    Set FrmWJYC = Nothing
End Sub

Private Sub mnuXMDC_Click()
    Call ExportXiangMu(Me.dlgCommonDialog)
End Sub

Private Sub mnuXMZH_Click()
  frmXMZH.Show vbModal
  Set frmXMZH = Nothing
End Sub

Private Sub mnuQF_XTCS_Click()
    dlgXTCS.Show vbModal
    Set dlgXTCS = Nothing
End Sub

Private Sub mnuXTCS_Click()
    dlgXTCS.Show vbModal
    Set dlgXTCS = Nothing
End Sub

Private Sub mnuXTZC_Click()
    If FrmXTZC.ShowRegister = True Then
        Unload FrmXTZC
        Set FrmXTZC = Nothing
        
        Unload Me
    Else
        Unload FrmXTZC
        Set FrmXTZC = Nothing
        
        If gblnRegister = True Then
            mnuXTZC.Visible = False
            mnuSplit1.Visible = False
        End If
    End If
End Sub

Private Sub mnuYSGZLTJ_Click()
    dlgKSGZL.ShowStatistic False '这里不是要求模态显示，而是调用了自定义函数
    Set dlgKSGZL = Nothing
End Sub

Private Sub mnuZYBSJZDWH_Click()
    FrmZYBSSZ.Show vbModal
    Set FrmZYBSSZ = Nothing
End Sub

'Private Sub tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
'    On Error Resume Next
'    Select Case Button.Key
'        Case "TTDJ"
'            If genuVersion = BZB Or genuVersion = PJB Or genuVersion = ZYB Then
'                Button.ToolTipText = "团体登记"
'                FrmBZB_TTDJ.Show vbModal
'            Else
'                Button.ToolTipText = "体检预约"
'                frmRegister.Show
'                frmRegister.ZOrder 0
'            End If
'        Case "TTFZ"
'            If genuVersion = BZB Or genuVersion = PJB Or genuVersion = ZYB Then
'                Button.ToolTipText = "团体分组"
'                frmClassify.Show
'            Else
'                frmRegister.Show
'                frmRegister.ZOrder 0
'            End If
'        Case "TJLR"
'            If genuVersion = BZB Or genuVersion = PJB Or genuVersion = ZYB Then
'                FrmBZB_Input.Show
'                FrmBZB_Input.ZOrder 0
'            Else
'                frmBrowser.Show
'                frmBrowser.ZOrder 0
'            End If
'        Case "JKDAWH"
'            frmQuery_C.Show
'            frmQuery_C.ZOrder 0
'        Case "BBDY"
'            frmQuery_A.Show
'        Case "YXHZ"
'            If genuVersion = BZB Or genuVersion = PJB Or genuVersion = ZYB Then
'                FormYXHZ.Show
'            ElseIf genuVersion = WLB Then
'                FormYXHZ.Show
'            End If
'
'    End Select
'End Sub

'Purpose:   Set Background
Public Sub SetBackground()
On Error Resume Next
    Dim Status
    
    Screen.MousePointer = vbArrowHourglass
    With frmBack
        If mblnShowBack = False Then
            .Show
            mblnShowBack = True
        End If
        .Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
        frmBack.ZOrder 1
        
        If gstrManagerBackground = "(无)" Then
            Set .picBackground.PICTURE = Nothing
            Exit Sub
        ElseIf InStr(1, gstrManagerBackground, "\") > 1 Then
            Set .picBackground.PICTURE = LoadPicture(gstrManagerBackground)
        Else
            Set .picBackground.PICTURE = LoadPicture(gstrCurrPath & BackgroundDir & gstrManagerBackground)
        End If
        
        '拉伸背景
        Err.Clear
        .PaintPicture .picBackground.PICTURE, 0, 0, .ScaleWidth, .ScaleHeight
        If Err.Number <> 0 Then
            Err.Clear
            .PaintPicture .picBackground.PICTURE, 0, 0, .ScaleWidth, .ScaleHeight, , , , , vbSrcCopy
        End If
        
'        Set .PICTURE = .Image'该语句将花费较长时间，似乎可以没有
        
    End With
    GoTo ExitLab
ErrMsg:
    Status = SetError(Err.Number, Err.Description, "MDIForm1.SetBackground")
    ErrMsg Status
ExitLab:
    Screen.MousePointer = vbDefault
End Sub

'根据用户角色ID号决定显示菜单
Private Sub SetMnuFromJS(inClassifyID)
    Dim rstemp As ADODB.Recordset
    Dim strSQL As String
    
    Set rstemp = New ADODB.Recordset
    
    '首先屏蔽所有菜单

    SetAllMenu False
        
        
    '版本判别
    If genuVersion = WLB Then
        strSQL = "select * from SET_JS_MNUData where JSID=" & CInt(inClassifyID) _
                & " and SET_JS_MNUData.mnuID in (select mnuID from SET_MNU_Data where (mnuType='ZQY' or mnuType='QF'))"
    Else
        strSQL = "select * from SET_JS_MNUData where JSID=" & CInt(inClassifyID) _
                & " and SET_JS_MNUData.mnuID in (select mnuID from SET_MNU_Data where mnuType='ZYBBZBPJB')"
    End If
    rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
    If rstemp.RecordCount > 0 Then
        rstemp.MoveFirst
        Do While Not rstemp.EOF
            Select Case rstemp("mnuID")
                Case 1
                    mnuQF_TJDJXT.Visible = True
                Case 2
                    mnuQF_TTYY.Visible = True
                Case 3
                    mnuQF_TJYY.Visible = True
                Case 4
                    mnuQF_TJDJ.Visible = True
'                Case 5
'                    mnuQF_DRRY.Visible = True
                Case 6
                    mnuQF_UnReg.Visible = True
                Case 7
                    mnuQF_FileExit.Visible = True
                Case 8
                    mnuQF_TJJLXT.Visible = True
                Case 9
                    mnuQF_TJJGLR.Visible = True
                Case 10
                    mnuQF_ZSJYLR.Visible = True
                Case 11
                    mnuQF_TJPLLR.Visible = True
                Case 12
                    mnuQF_JKDAWH.Visible = True
                Case 13
                    mnuQF_KHGL.Visible = True
                Case 14
                    mnuQF_TJDWWH.Visible = True
                Case 15
                    mnuQF_TJBGXT.Visible = True
                Case 18
                    mnuQF_DWYXHZDC.Visible = True
                Case 20
                    mnuQF_DWTJXJCX.Visible = True
                Case 21
                    mnuQF_TJCXXT.Visible = True
                Case 22
                    mnuQF_DWYXHZ.Visible = True
                Case 23
                    mnuQF_BHHZ.Visible = True
                Case 24
                    mnuQF_TJJGCX.Visible = True
                Case 25
                    mnuQF_HCSYQK.Visible = True
                Case 26
                    mnuQF_TJGLXT.Visible = True
                Case 27
                    mnuQF_YYTX.Visible = True