frmfre_rom.frm

智能仓库管理系统

          'txtZY(I).Text = Money
       End If
      
    Next
    cmdEdit.Enabled = True
    'cmdDelete.Enabled = True
 End If
   Label1(1).Caption = txtZY(2)
   txtzy2 = txtZY(2)
   fra1.Enabled = True
   SetButton False
   'SetTextNull
End Sub

Private Sub DBConnection()
    'cnDB.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & gDBPath & ";Jet OLEDB:Database Password=czlxming;Persist Security Info=False"
    'Set cnDB = New ADODB.Connection
    cnDB.ConnectionString = "DSN=Warehouse"
    cnDB.CommandTimeout = 15
    cnDB.Open
    Set cn_DB = New ADODB.Connection
    cn_DB.ConnectionString = "DSN=Freight"
    cn_DB.CommandTimeout = 15
    cn_DB.Open
End Sub

Private Function SetSQL(mQuerySQL As String, mTaxisSQL As String) As String    'mQuerySQL为查询语句的条件，如为空则没有Where子句，不为空则带Where语句；mTaxisSQL为排序条件语句，如空则没有Order By语句，不为空则带Order By
  SetSQL = "SELECT StoreRoom.ID, StoreRoom.CONTACT_ID, StoreRoom.S_CODE, StoreRoom.AMOUNT,StoreRoom.PRICE,StoreRoom.IN_DATE,StoreRoom.OUT_DATE,StoreRoom.STATE_O,StoreRoom.STATE_O " & _
           "From StoreRoom " & gQuerySQL & " " & mTaxisSQL
  gSQL = SetSQL
End Function
Private Sub SetFormData(mStrSQL As String)
 Dim StrSQL As String
   StrSQL = mStrSQL
   rs.Open StrSQL, cnDB, adOpenStatic, adLockReadOnly
   MfgZY.Clear
    If Not rs.EOF Then
      Set MfgZY.DataSource = rs
    Else
      Do While MfgZY.Rows > 2
        MfgZY.RemoveItem MfgZY.Rows - 1
      Loop
    End If
   MfgZY.Refresh '强制全部重绘一个窗体或控件
     SetGridStyle
     For I = MfgZY.FixedRows To MfgZY.Rows - 1
      MfgZY.TextMatrix(I, 0) = I
      If MfgZY.TextMatrix(I, 6) <> "" Then
        MfgZY.TextMatrix(I, 6) = Format(SetMfgZyDateType(MfgZY.TextMatrix(I, 6)), "YYYY年MM月DD日")
      End If
      If MfgZY.TextMatrix(I, 7) <> "" Then
        MfgZY.TextMatrix(I, 7) = Format(SetMfgZyDateType(MfgZY.TextMatrix(I, 7)), "YYYY年MM月DD日")
      End If
      
     Next
 rs.Close
End Sub
Private Sub SetGridStyle()
    MfgZY.ColWidth(0) = 400
    MfgZY.ColAlignment(0) = flexAlignGeneral
    MfgZY.ColWidth(MfgZY.Cols - 1) = 0
    MfgZY.TextMatrix(0, 1) = "记录编号"
    MfgZY.TextMatrix(0, 2) = "合同编号"
    MfgZY.TextMatrix(0, 3) = "物品代码"
    MfgZY.TextMatrix(0, 4) = "数量"
    MfgZY.TextMatrix(0, 5) = "收费单价"
    MfgZY.TextMatrix(0, 6) = "入库日期"
    MfgZY.TextMatrix(0, 7) = "出库日期"
    MfgZY.TextMatrix(0, 8) = "准许出库"
    'MfgZY.TextMatrix(0, 9) = "存放天数"
    'MfgZY.TextMatrix(0, 10) = "收费单价"
    MfgZY.ColWidth(1) = 900
    MfgZY.ColWidth(2) = 900
    MfgZY.ColWidth(3) = 900
    MfgZY.ColWidth(4) = 500
    MfgZY.ColWidth(5) = 900
    MfgZY.ColWidth(6) = 1600
    MfgZY.ColWidth(7) = 1600
    MfgZY.ColWidth(8) = 900
End Sub
Private Sub SetButton(bVal As Boolean)
    cmdNew.Enabled = bVal
    cmdEdit.Enabled = bVal
    cmdSave.Enabled = Not bVal
    cmdDelete.Enabled = bVal
    cmdSearch.Enabled = Not bVal
    cmdView.Enabled = bVal
    cmdPrint.Enabled = bVal
    fra1.Enabled = Not bVal
End Sub



Private Sub cmdCancel_Click()
  
   For I = 1 To 8
  
    txtZY(I).Text = ""
   If I = 8 Then
      txtZY(8) = "￥0.00"
   End If
   
  Next
 Money = 0
 Chk1.Value = 0
 gQuerySQL = "where contact_id=" & txtzy2 & " and STate_I=2"
 Call SetFormData(SetSQL("", "")) '设置窗口显示数据
End Sub

Private Sub cmdExit_Click()
 Money = 0
 Unload Me
 frmFreight.Show 1
End Sub


Private Sub cmdEdit_Click()
 Dim mStrSQL As String
 mStrSQL = "Select QC_EDIT From 权限 Where UserID='" & gUser & "'"
 rs_DB.Open mStrSQL, cn_DB, adOpenStatic, adLockReadOnly
 
 If rs_DB("QC_EDIT") = 0 Then   '权限判断
   MsgBox "您没有此操作的权限！", vbInformation + vbOKOnly, "提示"
   rs_DB.Close
   Exit Sub
 Else
    rs_DB.Close
    If txtZY(1).Text <> "" Then
     ButtonStatus = "Edit"
     fra1.Enabled = True
     SetButton False
     txtZY(1).Enabled = False
     txtZY(2).Enabled = False
     txtZY(4).Enabled = False
     txtZY(5).Enabled = False
     txtZY(6).Enabled = False
     txtZY(7).SetFocus
     MfgZY.Enabled = False
    Else
     MsgBox "没有选中要修改的记录！请在表中选择一条要修改的记录！", vbInformation + vbOKOnly, "提示"
    End If
 End If
End Sub
Private Sub cmdSave_Click()
Dim StrSQL As String
Dim TemSQL As String
Dim I, j As Integer
On Error GoTo SaveErr
 

 If Trim(Me.txtZY(1)) = "" Then
      MsgBox "记录编号不能为空，请输入记录编号！", vbExclamation + vbOKOnly, "提示"
      txtZY(1).SetFocus
      Exit Sub
 End If
If Trim(Me.txtZY(3)) = "" Then
      MsgBox "物品代码不能为空，请输入物品代码编号！", vbExclamation + vbOKOnly, "提示"
      txtZY(3).SetFocus
      Exit Sub
 End If
 If Trim(Me.txtZY(4)) = "" Then
      MsgBox "数量不能为空，请输入数量！", vbExclamation + vbOKOnly, "提示"
      txtZY(4).SetFocus
      Exit Sub
 End If
 
 
    
    If MsgBox("确定要保存吗？", vbInformation + vbOKCancel, "保存") = vbCancel Then
      Exit Sub
    End If
  
temdate = CDate((txtZY(7).Text))
StrSQL = "update StoreRoom set OUT_DATE='" & temdate & "'," & _
                 "state_O='" & StrToSQL(Me.Chk1.Value) & "' " & _
                 "Where ID=" & StrToSQL(txtZY(1).Text) & " and CONTACT_ID=" & "'" & StrToSQL(txtZY(2).Text) & "'"
 
         
    
 cnDB.Execute StrSQL
 SetFormData (SetSQL("", ""))
   cmdEdit.Enabled = False
   'cmdDelete.Enabled = False
   DtpZZ.Visible = False
   MfgZY.Enabled = True
Exit Sub
 
SaveErr:
 
 MsgBox Err.Description
 Call cmdCancel_Click
End Sub
Private Sub cmdtaxis_Click()
FrmTaxis.TaxisSQL = "SELECT StoreRoom.ID, StoreRoom.CONTACT_ID, StoreRoom.S_CODE, StoreRoom.AMOUNT,StoreRoom.PRICE  From StoreRoom"
            
 FrmTaxis.Show 1
 If gTaxisSQL <> "" Then '如果排序条件不为空
    Call SetFormData(SetSQL(gQuerySQL, gTaxisSQL)) '设置窗口显示数据
 End If
End Sub


Private Sub DtpZZ_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
   Chk1.SetFocus
  End If
End Sub
Private Sub DtpZZ_LostFocus()
 txtZY(7).Text = Format(DtpZZ.Value, "YYYY年MM月DD日")
 txtZY(7).Visible = True
 DtpZZ.Visible = False
 End Sub
Private Sub Form_Unload(Cancel As Integer)
 
    cnDB.Close
    Set cnDB = Nothing
 
End Sub

Private Sub MfgZY_Click()
Dim gRow, gcount, I, K As Integer
Dim Space  As Long
Dim I_Date, O_Date As Date
Dim T_Mon As Currency
 gRow = MfgZY.row
 gcount = MfgZY.Cols
 Me.txtRow.Text = gRow
 If MfgZY.Rows > 1 Then
    For I = 1 To gcount - 2
      txtZY(I).Text = MfgZY.TextMatrix(gRow, I)
      If I = 6 Then
         txtZY(I).Text = Format(MfgZY.TextMatrix(gRow, I), "YYYY年MM月DD日")
      End If
      If I = 7 Then
         txtZY(I).Text = Format(MfgZY.TextMatrix(gRow, I), "YYYY年MM月DD日")
      End If
      If I = 8 And MfgZY.TextMatrix(gRow, I) <> "" Then
          Chk1.Value = MfgZY.TextMatrix(gRow, I)
          txtZY(I).Text = Money
        If Chk1.Value = 2 Then
           MsgBox "该编号货物已出库，请重新选择货物记录编号！", vbExclamation + vbOKOnly, "警告"
           Label1(4).Caption = ""
           Label1(3).Caption = ""
           Chk1.Enabled = False
           txtZY(7).Enabled = False
           Exit Sub
        Else
          Chk1.Enabled = True
          txtZY(7).Enabled = True
        End If
      End If
    
    Next
 End If

Label1(4).Caption = ""
Label1(3).Caption = ""
If MfgZY.TextMatrix(gRow, 8) <> "" Then
  If MfgZY.TextMatrix(gRow, 8) = 1 Then
   If MfgZY.TextMatrix(gRow, 7) <> "" And MfgZY.TextMatrix(gRow, 6) <> "" Then
      K = K + 1
      I_Date = MfgZY.TextMatrix(gRow, 6)
      O_Date = MfgZY.TextMatrix(gRow, 7)
      Space = DateDiff("d", I_Date, O_Date)
         If Space > 0 Then
            T_Mon = Val(MfgZY.TextMatrix(gRow, 4)) * Val(MfgZY.TextMatrix(gRow, 5)) * Space
            Label1(4).Caption = T_Mon
            Label1(3).Caption = Space
         Else
            MsgBox "第" & gRow & "行记录出入库日期错误", vbExclamation + vbOKOnly, "提示"
            Exit Sub
         End If
   End If
 End If
End If
'txtZY(7).SetFocus
Label1(1).Caption = txtZY(2)
txtzy2 = txtZY(2)
End Sub
Private Sub SetTextNull()
 Dim I As Integer
 
 'For I = 1 To 8
  
 '   txtZY(I).Text = ""
   
 ' Next
Chk1.Value = 0
txtZY(2) = txtzy2
Label1(1).Caption = txtZY(2)
End Sub

Private Sub txtZY_GotFocus(Index As Integer)
  Select Case Index
  Case 7
   If txtZY(7).Text = "" Then
     txtZY(7).Text = Format(Now, "YYYY年MM月DD日")
   End If
   DtpZZ.Value = txtZY(5).Text
   DtpZZ.Visible = True
   DtpZZ.SetFocus
   txtZY(7).Visible = False
 End Select
 
   
 
End Sub

Private Sub cmdSearch_Click()
 FrmQuery.QuerySQL = "SELECT StoreRoom.ID, StoreRoom.CONTACT_ID, StoreRoom.S_CODE, StoreRoom.AMOUNT,StoreRoom.PRICE  From StoreRoom"
            
 FrmQuery.Show 1
 If gQuerySQL <> "" Then '如果查询条件不为空
    Call SetFormData(SetSQL(gQuerySQL, gTaxisSQL)) '设置窗口显示数据
 End If
End Sub
Private Function SetMfgZyDateType(mDate As String) As String  '格式化MfgZy中所显示的日期字段的格式
  Dim TempDate As String
  Dim TempType As String
  Dim SetDate As String
  TempDate = Mid(mDate, 1, InStr(mDate, "-") - 1)
  TempDate = Format(TempDate, "00") & "年"
  SetDate = TempDate
  TempType = Mid(mDate, InStr(mDate, "-") + 1)
  TempDate = Mid(TempType, 1, InStr(TempType, "-") - 1)
  TempDate = Format(TempDate, "00") & "月"
  SetDate = SetDate & TempDate
  TempType = Mid(TempType, InStr(TempType, "-") + 1, 2)
  TempDate = Format(TempType, "00") & "日"
  SetDate = SetDate & TempDate
  SetMfgZyDateType = SetDate
End Function
Private Sub SetG_date()

End Sub

Private Sub txtZY_KeyPress(Index As Integer, KeyAscii As Integer)
Select Case Index
  Case 7
    If KeyAscii = 8 Then
      Exit Sub
    End If
    If KeyAscii = 13 Then
        Chk1.SetFocus
       
    End If
End Select
End Sub