frmmain.frm

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

        End If
        '******************20040530加入完 闻**************************
        
        '专业版显示团检报告导出菜单
        If genuVersion = BZB Or genuVersion = ZYB Then
            mnuDWTJBGDC.Visible = True
        Else
            mnuDWTJBGDC.Visible = False
        End If
        
        '是否显示网站数据导出菜单
        If gWWW = False Then
            mnuDataExport.Visible = False
        End If
                                 
        '显示注销和退出菜单
        mnuTJGL.Visible = True
        mnuBZB_ZX.Visible = True
        mnuBZB_EXIT.Visible = True

    End If
    
    mnuSplit22.Visible = False
    mnuQF_JFHBCX.Visible = False
    mnuQF_JFXF.Visible = False
    
    '设置主窗口大小为上一次退出时的大小
'    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)
    '加载背景
    mblnShowBack = False
    SetBackground
    
'    '限制千福功能
'    mnuQF_ZDGJ.Visible = False
'    mnuQF_Split2.Visible = False
'    mnuQF_DWTJBGDC.Visible = False
    
    If mnuQF_Tools.Visible = True Then
        Call DisposePlugin(mnuAppendMenu)
    End If
    
    Call ClearMultiSeperator(Me.hwnd)
    
    '状态栏
    With Me.sbStatusBar
        .Panels(1).Text = "授权用户：" & gstrHospital
        .Panels(1).AutoSize = sbrSpring
        .Panels(2).Text = COMPANY_INFO
        .Panels(2).AutoSize = sbrContents
    End With
    '菜单处理完毕再显示
    Me.Show
End Sub

Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    '关闭所有插件
    Call SendCloseMessageToAllPlugin(Me.hwnd)
End Sub

Private Sub MDIForm_Resize()
    If Me.WindowState <> vbMinimized Then
        frmBack.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
    End If
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
    If MsgBox("确定要退出吗？", vbQuestion + vbYesNo, "提示") = vbYes Then
       
        Unload frmBack
        Set frmBack = Nothing
        
        mblnLoaded = False '便于用户重新登陆
        '退出时删除当前用户的临时表
        Call CreateTable(TempTable, True)
        
        If Not g_blnReLogin Then
            Call DisConnectDatabase(GCon)
        End If
        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
    Else
        Cancel = 1
        mblnShowBack = False
        SetBackground
    End If
End Sub

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

Private Sub mnuAbout_Click()
    frmAbout.Show vbModal
    Set frmAbout = Nothing
End Sub

Private Sub mnuAppendMenu_Click(Index As Integer)
    Call ClickPluginMenu(Index, Me.hwnd)
End Sub

Private Sub mnuBBMBWH_Click()
    FrmMBWH.Show vbModal
    Set FrmMBWH = Nothing
End Sub

Private Sub mnuBHHZ_Click()
'    FrmBHHZ.Show
    FrmBHTJ.Show
End Sub

Private Sub mnuBZB_EXIT_Click()
    g_blnReLogin = False
    Unload Me
End Sub

Private Sub mnuBZB_SJKBF_Click()
    frmRestoreAndBackup.Show vbModal
    Set frmRestoreAndBackup = Nothing
End Sub

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

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

Private Sub mnuCSSZSJMB_Click()
'    frmTemplate.Show vbModal
    FrmSJMB.Show vbModal
    Set FrmSJMB = Nothing
End Sub

Private Sub mnuCSSZTJKS_Click()
    frmKS_ZHSZ.Show vbModal
    Set frmKS_ZHSZ = Nothing
End Sub

Private Sub mnuCSSZTJTC_Click()
    frmFormula.Show vbModal
    Set frmFormula = Nothing
End Sub

Private Sub mnuCSSZTJXM_Click()
    frmXMSZ.Show vbModal
    Set frmXMSZ = Nothing
End Sub

Private Sub mnuDataExport_Click()
    FrmDataExport.Show vbModal

End Sub

Private Sub mnuDWTJBGDC_Click()
    FrmDWTJBGDC.Show vbModal
    Set FrmDWTJBGDC = Nothing
End Sub

Private Sub mnuDWTJXJCX_Click()
    FrmDWTJXJ.Show
End Sub

Private Sub mnuDWYXHZ_Click()
    
    '******************20040420加入 闻**************************
    '***********************************************************
    '***********************************************************
    '版本控制
    If genuVersion = BZB Or genuVersion = PJB Or genuVersion = ZYB Then
        FormYXHZ.Show
    ElseIf genuVersion = WLB Then
        FormYXHZ.Show
    End If
    '***********************************************************
    '***********************************************************
    '******************20040420加入完 闻************************
    
End Sub

Private Sub mnuDWYXHZDC_Click()
    FrmDWYXHZDC.Show vbModal
    Set FrmDWYXHZDC = Nothing
End Sub

Private Sub mnuFQCX_Click()
  FrmFQCX.Show
  
End Sub

Private Sub mnuGPKL_Click()
    mnuQF_GPKL_Click
End Sub

Private Sub mnuJKDAWH_Click()
    frmQuery_C.Show
    frmQuery_C.ZOrder 0
End Sub

Private Sub mnuJSDY_Click()
    FrmJSDY.Show vbModal
    Set FrmJSDY = Nothing
End Sub

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

Private Sub mnuMBBB_Click()
    mnuQF_MBBB_Click
End Sub

Private Sub mnuMMGG_Click()
    frmModifyPassword.Show vbModal
    Set frmModifyPassword = Nothing
End Sub

Public Sub mnuPrint_Click(Index As Integer)
    Select Case Index
        Case 0
            FrmFYHZ.PrintReport
    End Select
End Sub

Private Sub mnuQF_BBMBWH_Click()
    FrmMBWH.Show vbModal
    Set FrmMBWH = Nothing

End Sub

Private Sub mnuQF_BHHZ_Click()
'    FrmBHHZ.Show
    FrmBHTJ.Show
End Sub

Private Sub mnuQF_BuFa_Click()
    FrmICKBF.Show vbModal
    Set FrmICKBF = Nothing
End Sub

Private Sub mnuQF_Calculator_Click()
    Shell "calc.exe", vbNormalFocus

End Sub

Private Sub mnuQF_CSSZTJXM_Click()
    frmXMSZ.Show vbModal
    Set frmXMSZ = Nothing

End Sub

Private Sub mnuQF_CSSZSJMB_Click()
    FrmSJMB.Show vbModal
    Set FrmSJMB = Nothing

End Sub

Private Sub mnuQF_CSSZTJKS_Click()
    frmKS_ZHSZ.Show vbModal
    Set frmKS_ZHSZ = Nothing

End Sub

Private Sub mnuQF_CSSZTJTC_Click()
    frmFormula.Show vbModal
    Set frmFormula = Nothing

End Sub

Private Sub mnuQF_CWHZ_Click()
    FrmCwhz.Show vbModeless
End Sub

Private Sub mnuQF_DataExport_Click()
    FrmDataExport.Show vbModal

End Sub

Private Sub mnuQF_DJKFF_Click()
    frmMoneyCard.Show vbModeless
End Sub

Private Sub mnuQF_DWTJBGDC_Click()
    FrmDWTJBGDC.Show vbModal
    Set FrmDWTJBGDC = Nothing
End Sub

Private Sub mnuQF_DWTJXJCX_Click()
    FrmDWTJXJ.Show

End Sub

Private Sub mnuQF_DWYXHZ_Click()
    '版本控制
    If genuVersion = BZB Or genuVersion = PJB Or genuVersion = ZYB Then
        FormYXHZ.Show
    ElseIf genuVersion = WLB Then
        FormYXHZ.Show
    End If

End Sub

Private Sub mnuQF_DWYXHZDC_Click()
    FrmDWYXHZDC.Show vbModal
    Set FrmDWYXHZDC = Nothing

End Sub

Private Sub mnuQF_FileExit_Click()
    g_blnReLogin = False
    Unload Me
End Sub

Private Sub mnuQF_FQCX_Click()
  FrmFQCX.Show
End Sub

Private Sub mnuQF_GPKL_Click()
    Dim strExeName As String
    Dim strConfigFile As String
    Dim f As Integer
    
    '文件名
    strExeName = gstrCurrPath & DTSDir & DTSExeName
    strConfigFile = gstrCurrPath & DTSDir & DTSConfigFileName
    
    '是否存在
    If Dir(strExeName) = "" Then
        MsgBox "找不到导出文件，请联系北京" & g_strDevelopCompany & "软件科技有限公司获取该文件！", vbExclamation, "提示"
        GoTo ExitLab
    End If
    
    '写配置文件
    If Dir(strConfigFile) <> "" Then Kill strConfigFile
    f = FreeFile
    Open strConfigFile For Output As #f
    Print #f, "[DATABASE]"
    Print #f, "DBMS=MSS"
    Print #f, "ServerName=" & g_strServerName
    Print #f, "Database=" & g_strDatabase
    Print #f, "UseWinnt=" & g_strUseWinnt
    Print #f, "UserID=" & g_strUserID
    Print #f, "DatabasePassword=" & g_strPassword
    Print #f, "PATH=" & gstrCurrPath & DTSDir
    Close #f
    
    '调用导出程序
    Call Shell(strExeName & " " & COMMUNICATION_STRING & g_strPassword, vbNormalFocus)
    
    GoTo ExitLab
ExitLab:
    '
End Sub

Private Sub mnuQF_HCSYQK_Click()
    FrmHCSYQK.Show vbModal
    Set FrmHCSYQK = Nothing
End Sub

Private Sub mnuQF_JBQCTJ_Click()
    FrmJBQCTJ.Show
End Sub

Private Sub mnuQF_JKDAWH_Click()
    frmQuery_C.Show
    frmQuery_C.ZOrder 0
End Sub

Private Sub mnuQF_JSDY_Click()
    mnuJSDY_Click
End Sub

Private Sub mnuQF_KHGL_Click()
    FrmKHGL.Show
End Sub

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

Private Sub mnuQF_GGMM_Click()
    frmModifyPassword.Show vbModal
    Set frmModifyPassword = Nothing
End Sub

Private Sub mnuQF_MBBB_Click()
    FrmQuery_MBBB.Show
End Sub

Private Sub mnuQF_NotePad_Click()
    Shell "notepad.exe", vbNormalFocus
End Sub

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

Private Sub mnuQF_SJKBF_Click()
    frmRestoreAndBackup.Show vbModal
    Set frmRestoreAndBackup = Nothing
End Sub

Private Sub mnuQF_SJKQK_Click()
    mnuSJKQK_Click
End Sub

Private Sub mnuQF_SJZDDC_Click()
    FrmSJZDDC.Show vbModal