form_rcyw_ck.frm

仓库扫描管理系统

      EndProperty
      Height          =   285
      Left            =   5010
      TabIndex        =   15
      Top             =   90
      Width           =   1395
   End
   Begin VB.Line Line1 
      X1              =   5355
      X2              =   6555
      Y1              =   2730
      Y2              =   3210
   End
End
Attribute VB_Name = "form_rcyw_ck"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim s, y, i     '定义变量
Dim mydb As Database     '定义数据库
Dim rs1 As Recordset     '定义字段
Dim rs2 As Recordset
Dim rsMaster As Recordset
Dim lsph As Integer     '定义一个整型变量
Private Sub Form_Load()
'自动识别数据库路径
 Data1.DatabaseName = g_dbPath
 Data2.DatabaseName = g_dbPath
 Data3.DatabaseName = g_dbPath
 mf1.Rows = 102: mf1.Cols = 9     '定义mf1表的总行数、总列数
'定义mf1表的列宽和表头信息
 s = Array("300", "1000", "2000", "1200", "900", "1200", "1200", "1200", "1600")
 y = Array("序号", "商品编号", "商品名称", "规格", "单位", "数量", "单价", "金额", "备注")
 For i = 0 To 8
  mf1.ColWidth(i) = s(i): mf1.TextMatrix(0, i) = y(i)
 Next i
 mf1.FixedRows = 1: mf1.FixedCols = 1     '定义mf1表的固定行数、固定列数
 '定义mf1表的列序号
 For i = 1 To 101
     mf1.TextMatrix(i, 0) = i
 Next i
 rkrq.Text = Date     '设置出库日期
' gys.SetFocus
 Data1.RecordSource = "select * from hpos_products"
 Data2.RecordSource = "select fullName,orgId,orgCode,shortenedform from hpos_organization where orgType=0 order by fullName"
End Sub
Private Sub Form_Unload(Cancel As Integer)
  frm_main.Enabled = True
End Sub
Private Sub gys_Change()
 DBList1.Visible = True
 DBList1.ReFill
 '查询客户信息
 Data2.RecordSource = "select fullName,orgId,orgCode,shortenedform from hpos_organization where orgType=0 and ((hpos_organization.fullName  like " + Chr(34) + gys.Text + "*" + Chr(34) + ")or (hpos_organization.shortenedform like " + Chr(34) + gys.Text + "*" + Chr(34) + "))order by fullName"
 Data2.Refresh
End Sub
Private Sub dblist1_KeyPress(KeyAscii As Integer)
 DBList1.Visible = True
 gys.Text = DBList1.BoundText     '赋值给gys.text
 txttakeunit.Text = DBList1.Text
 DBList1.Visible = False
 jsr.Enabled = True
 jsr.SetFocus
End Sub
Private Sub grid1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then     '当按回车键时
 With Data1.Recordset
 If Data1.Recordset.RecordCount > 0 Then
  If Data1.Recordset.Fields("productCode") <> "" Then
   '赋值给mf1表格
   If .Fields("productCode") <> "" Then mf1.TextMatrix(mf1.Row, 1) = .Fields("productCode")
   If .Fields("productName") <> "" Then mf1.TextMatrix(mf1.Row, 2) = .Fields("productName")
   If .Fields("productSpecs") <> "" Then mf1.TextMatrix(mf1.Row, 3) = .Fields("productSpecs")
   If .Fields("productUnit") <> "" Then mf1.TextMatrix(mf1.Row, 4) = .Fields("productUnit")
   If .Fields("price") <> "" Then mf1.TextMatrix(mf1.Row, 6) = .Fields("price")
   text1.Text = mf1.Text        '赋值给text1
   text1.SetFocus
   mf1.Col = 5     '到达第5列
   grid1.Visible = False
 Else
   MsgBox ("无数据选择!!!")
   grid1.Visible = False     'grid1不可见
   text1.SetFocus
  End If
 End If
 End With
 text1.SetFocus     'text1获得焦点
End If
If KeyCode = vbKeyEscape Then     '按ESC键
  grid1.Visible = False     'grid1不可见
  text1.SetFocus     'text1获得焦点
End If
End Sub
Private Sub gys_KeyDown(KeyCode As Integer, Shift As Integer)
 If KeyCode = vbKeyReturn Then     '按回车键
    jsr.SetFocus     'jsr获得焦点
    DBList1.Visible = False     'DBList1不可见
 End If
 If KeyCode = vbKeyPageDown Then     '按PageDown键
    DBList1.Visible = True     'DBList1可见
    DBList1.ReFill
    DBList1.SetFocus     'DBList1获得焦点
 End If
End Sub
Private Sub jsr_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then     '按回车键
 PH.SetFocus
End If
If KeyCode = vbKeyUp Then gys.SetFocus     '按向上键gys获得焦点
End Sub
Private Sub mf1_Click()
If mf1.Row >= 1 And mf1.TextMatrix(mf1.Row - 1, 5) <> "" Then     '在mf1表格第1行或大于第1行时
 text1.Visible = True     'text1可见
 text1.SetFocus
End If
End Sub
Private Sub mf1_entercell()
 frm_main.text1.Text = "5"
 Call frm_main.entercell     '调用函数
End Sub
Private Sub mf1_RowColChange()     '格式化数量、单价和金额
  For i = 1 To 100
   If mf1.TextMatrix(i, 1) <> "" Then
    mf1.TextMatrix(i, 6) = Format(mf1.TextMatrix(i, 6), "#0.000")
    mf1.TextMatrix(mf1.Row, 7) = Val(mf1.TextMatrix(mf1.Row, 6)) * Val(mf1.TextMatrix(mf1.Row, 5))
    mf1.TextMatrix(i, 7) = Format(mf1.TextMatrix(i, 7), "#0.00")
   End If
  Next i
End Sub

Private Sub PH_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then     '按回车键
 text1.Visible = True
 mf1.Row = 1: mf1.Col = 1     '到达第1行，第1列
 text1.SetFocus
End If
If KeyCode = vbKeyUp Then jsr.SetFocus     '按向上键gys获得焦点
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
  frm_main.text1.Text = "5"
  If KeyCode = vbKeyReturn Then
     grid1.Visible = False
     If mf1.Col = 1 Then
        With Data1.Recordset
        If .RecordCount > 0 Then     '当记录大于零时
           '赋值给mf1表格
            If .Fields("productCode") <> "" Then mf1.TextMatrix(mf1.Row, 1) = .Fields("productCode")
            If .Fields("productName") <> "" Then mf1.TextMatrix(mf1.Row, 2) = .Fields("productName")
            If .Fields("productSpecs") <> "" Then mf1.TextMatrix(mf1.Row, 3) = .Fields("productSpecs")
            If .Fields("productUnit") <> "" Then mf1.TextMatrix(mf1.Row, 4) = .Fields("productUnit")
            If .Fields("price") <> "" Then mf1.TextMatrix(mf1.Row, 6) = .Fields("price")
           mf1.Col = 5
        End If
        End With
     End If
  Call frm_main.movereturn     '调用函数
  End If
  If KeyCode = vbKeyUp Then
     If mf1.Row > 1 Then mf1.Row = mf1.Row - 1
  End If
  If KeyCode = vbKeyDown And (mf1.TextMatrix(mf1.Row, 2)) <> "" Then
     If mf1.Row < 99 Then mf1.Row = mf1.Row + 1
  End If
  If KeyCode = vbKeyLeft Then Call frm_main.moveleft     '调用函数
  If KeyCode = vbKeyRight Then Call frm_main.moveright     '调用函数
  If KeyCode = vbKeyPageDown And mf1.Col = 1 Then
    Data1.RecordSource = "select * from hpos_products"
    Data1.Refresh
    grid1.Visible = True: grid1.SetFocus
  End If
End Sub
Private Sub text1_Change()
 DBList1.Visible = False
 mf1.Text = text1.Text     '赋值给mf1.text
 If mf1.Col = 1 Then
  '按产品编号或商品名称查询商品信息
  Data1.RecordSource = "select * from hpos_products where ((hpos_products.productCode like " + Chr(34) + text1.Text + "*" + Chr(34) + ")or(hpos_products.productName like " + Chr(34) + text1.Text + "*" + Chr(34) + "))"
  Data1.Refresh
  If text1.Text = "" Then     '当text1.text为空时
     grid1.Visible = False     'grid1不可见
   Else
     If Data1.Recordset.RecordCount > 0 Then     '当记录大于零时
        grid1.Visible = True     'grid1可见
        text1.SetFocus
     End If
  End If
 End If
 If mf1.Col = 5 Then mf1.TextMatrix(mf1.Row, 7) = Val(mf1.TextMatrix(mf1.Row, 5)) * Val(mf1.TextMatrix(mf1.Row, 6))
 If mf1.Col = 6 Then
  mf1.TextMatrix(mf1.Row, 7) = Val(mf1.TextMatrix(mf1.Row, 5)) * Val(mf1.TextMatrix(mf1.Row, 6))
  If mf1.TextMatrix(mf1.Row, 5) = "" Then
     MsgBox ("数量无,请重新输入!!!")
     mf1.Col = 5
     grid1.Visible = False
  End If
 End If
 If mf1.Col = 6 Then
  If mf1.TextMatrix(mf1.Row, 6) = "" Then
     MsgBox ("单价无,请重新输入!!!")
     mf1.Col = 6
     grid1.Visible = False
  End If
 End If
 Dim A, B As Single
 For i = 1 To 31
   A = Val(mf1.TextMatrix(i, 7)) + A: B = Val(mf1.TextMatrix(i, 5)) + B
 If mf1.TextMatrix(i, 1) <> "" And mf1.TextMatrix(i, 5) <> "" Then js.Text = i
 Next i
 hj.Text = A: hjsl.Text = B     '计算合计金额，合计数量
End Sub
Private Sub Comdj_Click()
''查询所有出库数据,并按票号排序
'Data3.RecordSource = "select * from  rkd  order by 票号"
'Data3.Refresh
''创建出库票号
'If Data3.Recordset.RecordCount > 0 Then
' If Not Data3.Recordset.EOF Then Data3.Recordset.MoveLast
' If Data3.Recordset.Fields("票号") <> "" Then
'    lsph = Right(Trim(Data3.Recordset.Fields("票号")), 4) + 1
'    PH.Text = Date & "rkd" & Format(lsph, "0000")
' End If
' Else
'   PH.Text = Date & "rkd" & "0001"
'End If
'设置控件有效或无效
gys.Enabled = True: jsr.Enabled = True: js.Enabled = True: hjsl.Enabled = True: hj.Enabled = True
text1.Enabled = True: mf1.Enabled = True: Combc.Enabled = True: Comqx.Enabled = True: Comdj.Enabled = False
PH.Enabled = True
'清空数据
For i = 1 To 100
For j = 1 To 8
    mf1.TextMatrix(i, j) = ""
Next j
Next i
gys.Enabled = True
gys.SetFocus
mf1.Row = 1: mf1.Col = 1    '到达mf1表格的第1行，第1列
End Sub
Private Sub Combc_Click()
' Set mydb = Workspaces(0).OpenDatabase(g_dbPath)     '自动识别数据库路径
 Set rs1 = g_db.OpenRecordset("hpos_StockOutBill_Dtl", dbOpenTable)
' Set rs2 = g_db.OpenRecordset("kc", dbOpenTable)
 Set rsMaster = g_db.OpenRecordset("hpos_StockOutBill_Master", dbOpenTable)
 Dim hasDtl As Boolean
 Dim billId As String
 hasDtl = False
 billId = PH.Text
 '查询库存商品信息
' Data1.RecordSource = "SELECT * FROM KC"
' Data1.Refresh
If PH.Text = "" Then
   MsgBox "单据编号不能为空!", vbInformation + vbApplicationModal
   Exit Sub
End If

Dim rsTmp As Recordset
Set rsTmp = g_db.OpenRecordset("select * from hpos_StockOutBill_Master where billNo='" & PH.Text & "'")
If rsTmp.RecordCount > 0 Then
   MsgBox "单据编号已经存在，请输入其它!", vbInformation + vbApplicationModal
   PH.SetFocus
   Exit Sub
End If
rsTmp.Close

 For i = 1 To 100
  If mf1.TextMatrix(i, 1) <> "" And mf1.TextMatrix(i, 5) <> "" Then
   hasDtl = True
   rs1.AddNew

   If PH.Text <> "" Then rs1.Fields("billId") = billId
   rs1.Fields("dtlId") = PH.Text & i
   
   If mf1.TextMatrix(i, 1) <> "" Then rs1.Fields("productId") = mf1.TextMatrix(i, 1)
   If mf1.TextMatrix(i, 5) <> "" Then rs1.Fields("qty") = mf1.TextMatrix(i, 5)
   If mf1.TextMatrix(i, 6) <> "" Then rs1.Fields("price") = mf1.TextMatrix(i, 6)
   If mf1.TextMatrix(i, 8) <> "" Then rs1.Fields("comment") = mf1.TextMatrix(i, 8)
   rs1.Update        '更新表
  End If
 Next i
 If hasDtl Then
    rsMaster.AddNew
'   店铺(仓库)标识
    rsMaster.Fields("store") = g_store
'   单据ID--主关键字
    If PH.Text <> "" Then rsMaster.Fields("billId") = billId
    If gys.Text <> "" Then rsMaster.Fields("takeunit") = gys.Text
    If jsr.Text <> "" Then rsMaster.Fields("handler") = jsr.Text
    If rkrq.Text <> "" Then rsMaster.Fields("billDate") = rkrq.Text
    If PH.Text <> "" Then rsMaster.Fields("billNo") = PH.Text
    rsMaster.Update
End If
rsMaster.Close

 rs1.Close
 ': g_db.Close
 '清空数据
 For i = 1 To 100
 For j = 1 To 8
     mf1.TextMatrix(i, j) = ""
 Next j
 Next i
 gys.Text = "": jsr.Text = "": js.Text = "": hjsl.Text = "": hj.Text = ""
 text1.Visible = False: DBList1.Visible = False     '设置控件不可见
 mf1.Enabled = False: Combc.Enabled = False: Comdj.Enabled = True: Comqx.Enabled = False
 PH.Enabled = True: PH.Text = ""
End Sub
Private Sub Comqx_Click()      '取消操作
 gys.Text = "": jsr.Text = "": js.Text = "": hjsl.Text = "": hj.Text = ""
 For i = 1 To 100
 For j = 1 To 8
 mf1.TextMatrix(i, j) = ""
 Next j
 Next i
 gys.Enabled = False: jsr.Enabled = False: js.Enabled = False: hjsl.Enabled = False: hj.Enabled = False
 DBList1.Visible = False: text1.Enabled = False: mf1.Enabled = False: Combc.Enabled = False:
 Comqx.Enabled = False: Comdj.Enabled = True: Comdj.SetFocus
End Sub
Private Sub Comend_Click()
  frm_main.Enabled = True
  Unload Me
End Sub