frmpdby.frm

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

         Width           =   585
      End
      Begin VB.Label Label5 
         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
         Left            =   8250
         TabIndex        =   25
         Top             =   5535
         Width           =   630
      End
   End
   Begin VB.Label Label10 
      Caption         =   "盘点报溢"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF8080&
      Height          =   315
      Left            =   4590
      TabIndex        =   42
      Top             =   105
      Width           =   1230
   End
End
Attribute VB_Name = "frmpdby"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'Private cmSaHA As ADODB.Command
Private rs As ADODB.Recordset
Private Sub CmdAct_Click(Index As Integer)
    Dim strsql As String
    Dim ru, i As Integer
    Dim mrc As ADODB.Recordset
    Dim TxtSQL As String
    Dim msgtext As String
    Dim rpt As New report
    Dim txt As New clsText
    Dim BTarray(8) As Integer
    Dim recBT(8) As String
    On Error GoTo Err:
    Select Case Index
        Case 0
            If Combtype = "" Then
                MsgBox "单据类型不能为空!", vbCritical, "错误"
                Combtype.SetFocus
                Exit Sub
            End If
            If msglist.rows <= 2 Then
                MsgBox "单据明细项不能为空!", vbCritical, "错误"
                Exit Sub
            End If
            ru = MsgBox("确认保存?", 33, "保存")
            If ru = 2 Then
                Exit Sub
            End If
            With msglist
                For i = 1 To .rows - 1
                    If Trim$(.TextMatrix(i, 1)) <> "" Then
                        updatesales i
                    End If
                Next i
            End With
            Call IsEdit(False)
            cnn.Execute "update counterid set CountNum=CountNum+1 where TableName='ck_pdby'"

            CmdAct(5).SetFocus
        Case 1
            With msglist
                .TextMatrix(.row, 1) = txt_id.text
                .TextMatrix(.row, 2) = txt_name.text
                .TextMatrix(.row, 3) = combdw
                .TextMatrix(.row, 4) = combdj
                .TextMatrix(.row, 5) = txt_qty
                .TextMatrix(.row, 6) = txt_total.text
            End With
            totalprice
            txt_id.Enabled = True
            CmdAct(7).SetFocus
            CmdAct(1).Enabled = False
            CmdAct(0).Enabled = True
            CmdAct(2).Enabled = True
            CmdAct(3).Enabled = True
        Case 2
            If txt_id.text = "" Then
                Exit Sub
            End If
            txt_total = Val(txt_qty) * Val(combdj) * (100 / 100)
            With msglist
                .TextMatrix(.rows - 1, 0) = .rows - 1
                .TextMatrix(.rows - 1, 1) = txt_id.text
                .TextMatrix(.rows - 1, 2) = txt_name.text
                .TextMatrix(.rows - 1, 3) = combdw
                .TextMatrix(.rows - 1, 4) = combdj
                .TextMatrix(.rows - 1, 5) = txt_qty
                .TextMatrix(.rows - 1, 6) = txt_total.text
                .rows = .rows + 1
                If .rows >= 10 Then
                    .TopRow = .TopRow + 1
                End If
            End With
            totalprice
            txt_id = ""
            txt_qty = 0
            txt_total = ""
            txt_name = ""
            combdj = ""
            combdw = ""
            CmdAct(7).SetFocus
        Case 3
            If msglist.rows > 2 And msglist.TextMatrix(msglist.row, 1) <> "" Then
                ru = MsgBox("确认删除?", 33, "询问")
                If ru = 2 Then
                    Exit Sub
                End If
                msglist.RemoveItem (msglist.row)
                For ru = 1 To msglist.rows - 1
                    msglist.TextMatrix(msglist.rows - ru, 0) = msglist.rows - ru
                Next ru
            Else
                MsgBox "本行不能删除！", vbInformation, "信息"
            End If
            CmdAct(7).SetFocus
        Case 4
            If msglist.rows > 2 And CmdAct(0).Enabled = True Then
                ru = MsgBox("放弃当前销售的数据?", 33, "询问")
                If ru = 2 Then
                    Exit Sub
                End If
            End If
            Unload Me
        Case 5
            txt_id = ""
            txt_qty = 0
            txtsa_maker.text = strCurUser
            dtptime.Value = Now
            txt_memo = ""
            msglist.Clear
            showtitle
            strsql = "select CountNum from counterid where TableName='ck_pdby'"
            rs.Open strsql, cnn, adOpenDynamic, adLockOptimistic
            txtsa_id.text = "KBY" & Format(rs!CountNum + 1, "00000")
            Call IsEdit(True)
            combdw.Enabled = False
            rs.Close
            Combtype.SetFocus
        Case 6
            Call IsEdit(True)
        Case 7
            txt_qty = 0
            txt_name = ""
            txt_id = ""
            txt_total = ""
            txt_lb = ""
            combdj.Clear
            txt_id.Enabled = True
            txt_id.SetFocus
            SendKeys "{Home}+{End}"
        Case 8
'            '定义页首
'            Set txt = New clsText
'            With txt
'                .stringX = struserinfoname & Space(20) & "地址:" & struserinfoaddress & Space(20) & "电话:" & struserinfotell
'                .fontsize = 10
'                .FontUnderLine = True
'                '.ForeColor = &HFF8080
'                .FontUnderLine = True
'                .Align = tyLeft
'            End With
'            rpt.Title.AddText "title1", txt
'            Set txt = Nothing
            
            rpt.SetPrinter 10000.488, 13000.064, Portrait
            Set txt = New clsText
            With txt
                .stringX = " "
                .fontsize = 10
                '.ForeColor = &HFF8080
                '.FontUnderLine = True
                .Align = tymiddle
            End With
            rpt.Title.AddText "title2", txt
            Set txt = Nothing
            
'            Set txt = New clsText
'            With txt
'                .stringX = "|共&s页/第&p页"
'                .fontsize = 10
'                '.ForeColor = &HFF8080
'                '.FontUnderLine = True
'                .Align = tymiddle
'            End With
'            rpt.Title.AddText "title3", txt
'            Set txt = Nothing
            
            
            '定义表首
            Set txt = New clsText
            With txt
                .stringX = Combtype
                .fontsize = 12
                '.FontUnderLine = True
                '.ForeColor = &HFF8080
                .FontBold = True
                .Align = tymiddle
            End With
            rpt.Header.AddText "head1", txt
            Set txt = Nothing
            
            Set txt = New clsText
            With txt
                .stringX = "单号:" & txtsa_id & Space(10) & "日期:" & dtptime.Value & Space(5) & "|备注:" & txt_memo
                .fontsize = 10
                '.ForeColor = &H8000&
                '.FontBold = True
                .Align = tyLeft
                .orient = Portrait
            End With
            rpt.Header.AddText "head3", txt
            Set txt = Nothing
            Set txt = New clsText
            With txt
                .stringX = "合计:<大写：> " & lab_total & Space(9) & "<小写：>" & Label2 & "|制单人:" & txtsa_maker
                .fontsize = 10
                '.ForeColor = vbRed
                '.FontBold = True
                .Align = tyLeft
            End With
            rpt.Footer.AddText "footer1", txt
            Set txt = Nothing
            rpt.LeftSection.AlignMode = tyContent
            rpt.RightSection.AlignMode = tyContent
            rpt.Align = tymiddle
            BTarray(1) = 1000
            BTarray(2) = 3500
            BTarray(3) = 800
            BTarray(4) = 1100
            BTarray(5) = 800
            BTarray(6) = 1400
            recBT(1) = "产品编号"
            recBT(2) = "产品名称"
            recBT(3) = "单位"
            recBT(4) = "单价"
            recBT(5) = "数量"
            recBT(6) = "金额"
            TxtSQL = "select a.p_id,a.p_name,b.unit,format(a.unit_price,'0.000'),a.qty,format(price,'0.000')"
            TxtSQL = TxtSQL & " from order_detail_b as a,Product as b where a.order_id='" & txtsa_id & "'"
            TxtSQL = TxtSQL & " and a.p_id=b.p_id"
            Set mrc = ExecuteSQL(TxtSQL, msgtext)
            If mrc.EOF Then
                Exit Sub
            End If
            report = False
            rpt.Attachmrc mrc, recBT, BTarray
            rpt.Preview
            mrc.Close
            Set mrc = Nothing
        Case 9
            txt_qty = 0
            txt_name = ""
            txt_id = ""
            txt_total = ""
            txt_lb = ""
            combdw = ""
            combdj.Clear
            txt_id.Enabled = True
            txt_id.SetFocus
            SendKeys "{Home}+{End}"
    End Select
    Exit Sub
Err:
    MsgBox "错误号为：" & Err.Number & Chr(13) & "错误说明：" & Err.Description
    'Resume Next
End Sub
Private Sub Combdj_GotFocus()
Dim strsql As String
Dim rs As ADODB.Recordset
Dim Addstring As String
Dim custID As Double
    Set rs = New ADODB.Recordset
    strsql = "select unit_price from order_detail_b where p_id='" & Trim$(txt_id) & "'"
    strsql = strsql & " group by unit_price"
    strsql = strsql & " order by unit_price"
    rs.Open strsql, cnn, adOpenDynamic, adLockOptimistic
    'Combdj.Clear
    Do Until rs.EOF
           Addstring = "" & rs!unit_price
           combdj.AddItem Addstring
           custID = "" & Val(rs!unit_price)
           combdj.ItemData(combdj.NewIndex) = custID
           rs.MoveNext
    Loop
    rs.Close
End Sub
Private Sub Combdj_KeyPress(KeyAscii As Integer)

    If KeyAscii = 13 And CmdAct(2).Enabled = True Then
        CmdAct(2).SetFocus
    Else
        If KeyAscii = 13 Then
            CmdAct(1).SetFocus
        End If
    End If
End Sub

Private Sub Combdj_LostFocus()
    If combdj.text = "" Then combdj.text = 0
    txt_total = Val(txt_qty) * Val(combdj) * (100 / 100)
End Sub

Private Sub combdw_KeyDown(KeyCode As Integer, Shift As Integer)
    EnterToTab KeyCode
End Sub
Private Sub Combtype_KeyDown(KeyCode As Integer, Shift As Integer)
    EnterToTab KeyCode
End Sub
Private Sub flex_pro_Click()
    If flex_pro.row > 0 Then
        With flex_pro
            txt_id = "" & .TextMatrix(.row, 0)
            txt_name = "" & .TextMatrix(.row, 1)
'            Text1 = "" & .TextMatrix(.row, 5)

            combdj.Clear
            combdj.AddItem "" & .TextMatrix(.row, 3)
            combdj.ListIndex = 0
            combdw = "" & .TextMatrix(.row, 2)
            txt_qty.Enabled = True
            txt_qty.text = 1
            txt_qty.SetFocus
            SendKeys "{Home}+{End}"
        End With
    End If
End Sub

Private Sub Form_Load()

    Dim mrc As New ADODB.Recordset
    Dim TxtSQL As String
    Dim msgtext As String
    Set rs = New ADODB.Recordset

    showtitle
    Call IsEdit(False)


    Combtype.text = "仓库盘点报溢"
    TxtSQL = "select p_id,product_name,unit,format(product_cos,'0.000'),product_code,type_id,product_eno"
    TxtSQL = TxtSQL & " from Product "
    TxtSQL = TxtSQL & " where p_id<>'' and p_id<>'1'"
    TxtSQL = TxtSQL & " order by type_id,product_name, p_id"
    mrc.Open TxtSQL, cnn, adOpenDynamic, adLockOptimistic
    If Not mrc.EOF Then
        Set flex_pro.DataSource = mrc
    End If
    showtitle_pro
    flex_pro.Visible = False
    If mrc.State = adStateOpen Then mrc.Close
    Set mrc = Nothing
    
End Sub

Private Sub IsEdit(blnIsEdit As Boolean)
    Dim intNum As Integer
    
    txt_id.Enabled = blnIsEdit