frmmain.frm

ktv场所的包房开房、迎宾、预定管理系统。

    mnu_cgreport.Visible = prover
    www.Visible = prover

    rsSys.Close

End Sub

Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)

    If MsgBox("确认退出!", vbInformation + vbYesNo, "退出系统") = vbYes Then
        Set rsSys = Nothing
        Cancel = False
    Else
        Cancel = True
    End If

End Sub

Private Sub menu_ckzf_Click()
  frmobsolete_ck.Show
End Sub
Private Sub menu_lkzf_Click()
  frmobsolete_rk.Show
End Sub

Private Sub menu_obsoleteseek_Click()
  frmobsolete_seek.Show
End Sub
Private Sub menu_outint_Click()
  frm_intout.Show
End Sub

Private Sub menu_pdbs_Click()
   frmpdbs.Show
End Sub

Private Sub menu_pdby_Click()
  frmpdby.Show
End Sub

Private Sub menu_pdseek_Click()
  frmpdseek.Show
End Sub

Private Sub menu_syn_Click()

If MsgBox("该步操作将会把仓库库存物品的价格同步为基础资料库的价格，确定要继续吗？", vbYesNo) = vbYes Then

    cnn.Execute "UPDATE mat_detail_bt AS a, product AS b SET a.unit_price = b.product_cos WHERE (((a.p_id)=b.p_id))"
    cnn.Execute "UPDATE mat_detail AS a, product AS b SET a.unit_price = b.product_cos WHERE (((a.p_id)=b.p_id))"
    cnn.Execute "UPDATE mat_detail_bt set price=unit_price*qty"
    cnn.Execute "UPDATE mat_detail set price=unit_price*qty"
    
    MsgBox "同步完成。"
    
End If

End Sub

Private Sub mnu_cgreport_Click()
    frm_cgreport.Show
End Sub
Private Sub mnuabout_Click()
    frmAbout.Show 1
End Sub
Private Sub mnubs_Click()
    frmsale_bs.Show
End Sub
Private Sub mnuEdit_ps_Click()
    FrmPsEdit.yesno1 = True
    FrmPsEdit.Show
End Sub

Private Sub mnuExit_Click()
    If intNumWindows = 0 Then
        Unload Me
    Else
        MsgBox "请关闭所有子程序后再关闭该主程序！", vbCritical, "提示"
    End If
End Sub

Private Sub mnuout_Click()
    FrmPsOut.yesno1 = True
    FrmPsOut.Show
End Sub
Private Sub mnuRec_ps_Click()
    FrmPsChk.Show
End Sub

Private Sub mnuSet_product_Click()
    FrmSetPro.Show
End Sub

Private Sub mnuSet_protype_Click()
    FrmSetPrTy.Show
End Sub

Private Sub mnuSet_supplier_Click()
    FrmSetSup.Show
End Sub

Private Sub mnuSet_sup_Click()
    FrmSetSup.Show
End Sub

Private Sub mnusetdw_Click()
    FrmSetPrdw.Show
End Sub

Private Sub mnuSql_djps_Click()
    FrmPsSql.Show
End Sub

Private Sub mnusql_kcbj_Click()
    frmsqlkcbj.Show
End Sub

Private Sub mnusql_kcmx_Click()
     frm_kc.Show
End Sub

Private Sub mnusql_ok_Click()
    frmsql_ok.Show
End Sub

Private Sub mnusql_out_Click()
    frmsqlout.Show
End Sub
Private Sub mnuSys_info_Click()
    Dim sqlstr As String
    Dim msgtext As String
    Dim mrc As ADODB.Recordset

    sqlstr = "select * from userinfo"
    Set mrc = ExecuteSQL(sqlstr, msgtext)
    If mrc.EOF Then
        frmuserinfo.Text1(0) = "联航科技有限公司"
        frmuserinfo.Text1(2) = "福州"
        frmuserinfo.Text1(1) = "0591-3370881"
    Else
        frmuserinfo.Text1(0) = mrc.Fields(1)
        frmuserinfo.Text1(1) = "" & mrc.Fields(2)
        frmuserinfo.Text1(2) = "" & mrc.Fields(3)
        frmuserinfo.Text1(3) = "" & mrc.Fields(4)
    End If
    sqlstr = "select * from r_parameter"
    Set mrc = ExecuteSQL(sqlstr, msgtext)
    frmuserinfo.DTPicker1.Value = mrc.Fields("pass_date")
    mrc.Close
    Set mrc = Nothing
    frmuserinfo.Text1(0).Enabled = False
    frmuserinfo.Text1(1).Enabled = False
    frmuserinfo.Text1(2).Enabled = False
    frmuserinfo.Command2.Caption = "保存(&S)"
    frmuserinfo.Show 1
End Sub

Private Sub mnuSys_pass_Click()
    frm_pass.Show 1
End Sub

Private Sub mnutk_Click()
    frm_partreturn.Show
End Sub

Private Sub mun_ghcx_Click()
    frm_ghcx.Show
End Sub

Private Sub ProSet_Click()
    frm_systemset.Show
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Dim ru As Integer
    Dim daima_on As String
    Dim TxtSQL As String
    Dim msgtext As String
    Dim mrc As ADODB.Recordset
    Dim daima_dh As Integer
    Dim daima_partid As String
    Dim batch As String
    Dim batchtno As Single

    Select Case Button.Index
        Case 1
            FrmSetPro.Show
            'menuenable (False)
            FrmSetPro.WindowState = 2
        Case 2
            FrmPsEdit.yesno1 = True
            FrmPsEdit.Show
            'menuenable (False)
            FrmPsEdit.WindowState = 2
        Case 3
            frm_kc.Show
            'menuenable (False)
        Case 4
            frm_partreturn.Show
            'menuenable (False)
            frm_partreturn.WindowState = 2
        Case 5
            FrmPsOut.yesno1 = True
            FrmPsOut.Show
            'menuenable (False)
            FrmPsOut.WindowState = 2
        Case 7
            'If MsgBox("确认退出!", vbInformation + vbYesNo, "退出系统") = vbYes Then
                Unload Me
            'End If
    End Select
End Sub
Public Sub systemset(user As String)
On Error Resume Next
    Dim strsql As String
    Dim msgtext As String
    Dim mrc As New ADODB.Recordset

    strsql = "select * from users where user_id='" & user & "'"
    mrc.Open strsql, cnn, adOpenDynamic, adLockOptimistic
    If Not mrc.EOF Then
        protype = "" & mrc!protype
    Else
        Set mrc = Nothing
        Exit Sub
    End If
    If mrc.State = adStateOpen Then mrc.Close
    
    strsql = "select * from usersystem where usertype='" & protype & "'"
    mrc.Open strsql, cnn, adOpenDynamic, adLockOptimistic
    If mrc.EOF Then
        Set mrc = Nothing
        Exit Sub
    End If
    
    With mrc
        Do While Not .EOF
            Select Case mrc!proname
                Case "mnuSet_jczl"
                   mnuSet_jczl.Visible = IIf(!useflag, True, False)
                Case "mnuSet_protype"
                   mnuSet_protype.Visible = IIf(!useflag, True, False)
                Case "mnusetdw"
                   mnusetdw.Visible = IIf(!useflag, True, False)
                Case "mnuSet_product"
                   mnuSet_product.Visible = IIf(!useflag, True, False)
                Case "mnuSet_product"
                   mnuSet_product.Visible = IIf(!useflag, True, False)
                Case "mnuSet_sup"
                   mnuSet_sup.Visible = IIf(!useflag, True, False)
                   
                Case "mnuAct_rk"
                   mnuAct_rk.Visible = IIf(!useflag, True, False)
                Case "mnuEdit_ps"
                   mnuEdit_ps.Visible = IIf(!useflag, True, False)
                Case "mnutk"
                   mnutk.Visible = IIf(!useflag, True, False)
                Case "mnubs"
                   mnubs.Visible = IIf(!useflag, True, False)
                Case "mnuout"
                   mnuout.Visible = IIf(!useflag, True, False)
                Case "mnuRec_ps"
                   mnuRec_ps.Visible = IIf(!useflag, True, False)
                Case "menu_work"
                   menu_work.Visible = IIf(!useflag, True, False)
                Case "menu_lkzf"
                   menu_lkzf.Visible = IIf(!useflag, True, False)
                Case "menu_ckzf"
                   menu_ckzf.Visible = IIf(!useflag, True, False)
                Case "menu_pdbs"
                   menu_pdbs.Visible = IIf(!useflag, True, False)
                Case "menu_pdby"
                   menu_pdby.Visible = IIf(!useflag, True, False)
                Case "mnusql"
                   mnusql.Visible = IIf(!useflag, True, False)
                Case "mnusql_kcmx"
                   mnusql_kcmx.Visible = IIf(!useflag, True, False)
                Case "mnusql_kcbj"
                   mnusql_kcbj.Visible = IIf(!useflag, True, False)
                Case "mnuSql_djps"
                   mnuSql_djps.Visible = IIf(!useflag, True, False)
                Case "mnu_cgreport"
                   mnu_cgreport.Visible = IIf(!useflag, True, False)
                Case "mun_ghcx"
                   mun_ghcx.Visible = IIf(!useflag, True, False)
                Case "menu_outint"
                   menu_outint.Visible = IIf(!useflag, True, False)
                Case "menu_obsoleteseek"
                   menu_obsoleteseek.Visible = IIf(!useflag, True, False)
                Case "menu_pdseek"
                   menu_pdseek.Visible = IIf(!useflag, True, False)
                Case "mnusql_out"
                   mnusql_out.Visible = IIf(!useflag, True, False)
                Case "mnusql_ok"
                   mnusql_ok.Visible = IIf(!useflag, True, False)
                Case "mnuSys_info"
                   mnuSys_info.Visible = IIf(!useflag, True, False)
                Case "ProSet"
                    ProSet.Visible = IIf(!useflag, True, False)
            End Select
            mrc.MoveNext
        Loop
    End With
    
    mrc.Close
    Set mrc = Nothing
    
    With sbStatusBar
         .Panels.Add 1, "users", "用户编号：" & strCurUser
         .Panels(1).width = Screen.width / 3
         .Panels.Add 2, "proty", "工作组：" & protype
         .Panels(2).width = Screen.width / 3
    End With
End Sub