frm_kc.frm

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

   End
   Begin VB.Label Label3 
      BorderStyle     =   1  'Fixed Single
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   300
      Left            =   9360
      TabIndex        =   18
      Top             =   5955
      Width           =   1500
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "合计数量："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Index           =   1
      Left            =   8205
      TabIndex        =   17
      Top             =   5580
      Width           =   1050
   End
   Begin VB.Label Label4 
      BorderStyle     =   1  'Fixed Single
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   300
      Left            =   9360
      TabIndex        =   16
      Top             =   5520
      Width           =   1500
   End
End
Attribute VB_Name = "frm_kc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public ind As Integer
Public TxtSQL, msgtext As String
Public mrc As ADODB.Recordset
Private cmPSChk As ADODB.Command
Private Sub showtitle_kc()
    Dim i As Integer
    On Error Resume Next
    With grid_kc
        .Cols = 10
        '.Rows = 2
        .TextMatrix(0, 0) = "编号"
        .TextMatrix(0, 1) = "产品名称"
        .TextMatrix(0, 2) = "U"
        .TextMatrix(0, 3) = "T"
        .TextMatrix(0, 4) = "进价"
        .TextMatrix(0, 5) = "售价"
        .TextMatrix(0, 6) = "数量"
        .TextMatrix(0, 7) = "成本价"
        .TextMatrix(0, 8) = "销售价"
        .TextMatrix(0, 9) = "条形码"

        For i = 0 To 9
            .ColAlignment(i) = 1
        Next

        '.RowSel = 1

        .colWidth(0) = 900
        .colWidth(1) = 3700
        .colWidth(2) = 400
        .colWidth(3) = 0
        .colWidth(4) = 900
        .colWidth(5) = 900
        .colWidth(6) = 600
        .colWidth(7) = 1100
        .colWidth(8) = 1200
        .colWidth(9) = 1600

    End With
End Sub

Private Sub Check1_Click()
If Check1.Value = 1 Then
    Check2.Value = 0
End If
End Sub

Private Sub Check2_Click()
If Check2.Value = 1 Then
    Check1.Value = 0
End If
End Sub

Private Sub Command1_Click(Index As Integer)
    Dim rpt As New report
    Dim txt As New clsText
    Dim BTarray(1 To 10) As Long
    Dim recBT(1 To 10) As String
    Dim t_xlsname As String
    Dim appxl As Object
    Dim xl As Object
    Dim ws As Object

       Select Case Index
        Case 0
            Unload Me
        Case 1
            rpt.SetPrinter 12239.98, 15839.97, Portrait
            Set txt = New clsText
            With txt
                .stringX = struserinfoname & "当前库存表"
                .fontsize = 12
                .FontBold = True
                .Align = tymiddle
            End With
            rpt.Title.AddText "title1", txt
            Set txt = Nothing
            
           Set txt = New clsText
            With txt
                .stringX = " "
                .fontsize = 10
                .Align = tymiddle
            End With
            rpt.Title.AddText "title2", txt
            Set txt = Nothing

            Set txt = New clsText
            With txt
                .stringX = "时间：" & Now & "|第&p页/共&s页"
                .fontsize = 10
            End With
            rpt.Title.AddText "title3", txt
            Set txt = Nothing

            report = False
            rpt.AttachFlexGrid grid_kc
            rpt.Preview
        Case 2
                
           Dim TxtSQL, msgtext As String
           Dim mrc As ADODB.Recordset
           TxtSQL = "SELECT a.p_id,a.p_name,a.unit,b.type_id,format(a.unit_price,'0.00'),b.product_pst,a.qty,"
           TxtSQL = TxtSQL & "Format(a.unit_price *a.qty,'0.00') as cost,Format(b.product_pst*a.qty,'0.00') as salePrice,b.product_eno "
        
           TxtSQL = TxtSQL & "  FROM mat_detail AS a,product AS b"
           TxtSQL = TxtSQL & "  WHERE a.p_id=b.p_id "
           Select Case ind
                Case 0
                 If Check1.Value = 1 Then
                   TxtSQL = TxtSQL & "  and a.qty=0"
                   
                 ElseIf Check2.Value = 1 Then
         
                 ElseIf Check1.Value = 0 And Check2.Value = 0 Then
                      TxtSQL = TxtSQL & "  and a.qty<>0"
                 Else
                 End If
                 
                Case 1
                  If datcmb_type.BoundText <> "" Then
                    TxtSQL = TxtSQL & " and b.type_id='" & Trim$(datcmb_type.BoundText) & "'"
                  End If
                Case 2
                   If txt_code <> "" Then
                      TxtSQL = TxtSQL & " and a.p_id like '%" & txt_code.text & "%'"
                   End If
                Case 3
                   If txt_name <> "" Then
                     TxtSQL = TxtSQL & " and a.p_name  like '%" & txt_name.text & "%'"
                  Else
                    If text_code.text <> "" Then
                      TxtSQL = TxtSQL & " and  b.product_code like '" & text_code.text & "%'"
                    End If
                  End If
            End Select
           TxtSQL = TxtSQL & " ORDER BY a.p_name"
           Set mrc = New ADODB.Recordset
           mrc.Open TxtSQL, cnn, adOpenDynamic, adLockOptimistic
           
           If Not mrc.EOF Then
           
                BTarray(1) = 650
                BTarray(2) = 2200
                BTarray(3) = 500
                BTarray(4) = 500
                BTarray(5) = 800
                BTarray(6) = 800
                BTarray(7) = 1800
                BTarray(8) = 1800
                BTarray(9) = 1800
                BTarray(10) = 1800
                
                recBT(1) = "编号"
                recBT(2) = "产品名称"
                recBT(3) = "单位"
                recBT(4) = "类别"
                recBT(5) = "进价"
                recBT(6) = "售价"
                recBT(7) = "数量"
                recBT(8) = "成本价"
                recBT(9) = "销售价"
                recBT(10) = "条形码"
                
                PrintRs recBT, BTarray, 10, mrc
                
           End If
    
    End Select
End Sub

Private Sub Command2_Click()

  If MsgBox("是否真的删除所有的零库存?", vbYesNo + vbQuestion) = vbYes Then
    cnn.Execute "delete from mat_detail where qty=0"
    MsgBox " 删除成功!", , "提示"
  End If
  
End Sub
Private Sub Comsql_Click()
   Dim TxtSQL, msgtext As String
   Dim mrc As ADODB.Recordset
   TxtSQL = "SELECT a.p_id,a.p_name,a.unit,b.type_id,format(a.unit_price,'0.000'),b.product_pst,a.qty,"
   TxtSQL = TxtSQL & "Format(a.unit_price *a.qty,'0.000') as cost,Format(b.product_pst*a.qty,'0.000') as salePrice,b.product_eno "

   TxtSQL = TxtSQL & "  FROM mat_detail AS a,product AS b"
   TxtSQL = TxtSQL & "  WHERE a.p_id=b.p_id "
   Select Case ind
        Case 0
         If Check1.Value = 1 Then
           TxtSQL = TxtSQL & "  and a.qty=0"
         ElseIf Check2.Value = 1 Then
         
         ElseIf Check1.Value = 0 And Check2.Value = 0 Then
           TxtSQL = TxtSQL & "  and a.qty<>0"
         Else
         End If
         
        Case 1
          If datcmb_type.BoundText <> "" Then
            TxtSQL = TxtSQL & " and b.type_id='" & Trim$(datcmb_type.BoundText) & "'"
          End If
        Case 2
           If txt_code <> "" Then
              TxtSQL = TxtSQL & " and a.p_id like '%" & txt_code.text & "%'"
           End If
        Case 3
           If txt_name <> "" Then
             TxtSQL = TxtSQL & " and a.p_name  like '%" & txt_name.text & "%'"
          Else
            If text_code.text <> "" Then
              TxtSQL = TxtSQL & " and  b.product_code like '" & text_code.text & "%'"
            End If
          End If
    End Select
   
   TxtSQL = TxtSQL & " ORDER BY a.p_name"
   Set mrc = New ADODB.Recordset
   mrc.Open TxtSQL, cnn, adOpenDynamic, adLockOptimistic
   Set grid_kc.DataSource = mrc
   showtitle_kc
   totalprice

End Sub
Public Sub totalprice()
Dim i As Integer
Dim totalnum As Currency
Dim toto As Currency
Dim temp As Currency
    totalnum = 0
    toto = 0
    temp = 0
    With grid_kc
        For i = 1 To .rows - 1
            temp = temp + Val(.TextMatrix(i, 8))
            totalnum = totalnum + Val(.TextMatrix(i, 7))
            toto = toto + Val(.TextMatrix(i, 6))
        Next i
    End With
    Label4.Caption = Format(toto, "0")
    Label3.Caption = Format(totalnum, "0.000")
    Label5.Caption = Format(temp, "0.000")
    
    grid_kc.rows = grid_kc.rows + 1
    With grid_kc
        .TextMatrix(.rows - 1, 1) = "合计"
        .TextMatrix(.rows - 1, 6) = "" & Format(toto, "0")
        .TextMatrix(.rows - 1, 7) = "" & Format(totalnum, "0.000")
        .TextMatrix(.rows - 1, 8) = "" & Format(temp, "0.000")
    End With
End Sub
Private Sub Form_Load()
   Dim TxtSQL, msgtext As String
   Dim mrc As ADODB.Recordset
   intNumWindows = OpenWindow(intNumWindows)
   Call SetFormStu(Me, frmMain)
    Set cmPSChk = New ADODB.Command
    cmPSChk.ActiveConnection = cnn
    cmPSChk.CommandType = adCmdText

    Option3(0).Value = True
    datcmb_type.Enabled = False
    txt_code.Enabled = False
    txt_name.Enabled = False
    Comsql_Click
End Sub
Private Sub Form_Unload(Cancel As Integer)
  intNumWindows = Closewindow(intNumWindows)
  Set cmPSChk = Nothing
End Sub

Private Sub Option3_Click(Index As Integer)
     ind = Index
      If Option3(0).Value = True Then
        txt_code.Enabled = False
        txt_name.Enabled = False
        text_code.Enabled = False
        datcmb_type.Enabled = False
    End If
    If Option3(1).Value = True Then
        txt_code.Enabled = False
        txt_name.Enabled = False
        text_code.Enabled = False
        datcmb_type.Enabled = True
        Check1.Value = 0
        'datcmb_dep.Enabled = True
        datcmb_type.SetFocus
    End If
    If Option3(2).Value = True Then
        'Option1.Value = True
        txt_code.Enabled = True
        txt_name.Enabled = False
        text_code.Enabled = False
        datcmb_type.Enabled = False
        Check1.Value = 0
        txt_code.SetFocus
    End If
    If Option3(3).Value = True Then
        'Option1.Value = True
        txt_code.Enabled = False
        txt_name.Enabled = True
        text_code.Enabled = True
        datcmb_type.Enabled = False
        Check1.Value = 0
        txt_name.SetFocus
    End If
End Sub
Private Sub text_code_Change()
    Comsql_Click
End Sub
Private Sub txt_code_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Comsql_Click
    End If
End Sub
Private Sub txt_name_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Comsql_Click
    End If
End Sub
Private Sub datcmb_type_Change()
    Comsql_Click
End Sub