frmfreight.frm

智能仓库管理系统

    con_id = txtZY(1).Text
   Else
     MsgBox "没有选中要登记货物的合同编号！请在表中选择！", vbInformation + vbOKOnly, "提示"
    SetTextNull
       If MfgZY.Rows >= 1 Then
          SetButton True
       Else
          cmdNew.Enabled = True
       End If
      cmdEdit.Enabled = False
      cmdDelete.Enabled = False
      DtpZZ.Visible = False
     txtZY(4).Enabled = True
     MfgZY.Enabled = True
     gTaxisSQL = ""
     gQuerySQL = ""
     Call SetFormData(SetSQL("", "")) '设置窗口显示数据
End If

Unload Me
frmWar_Ou.Show 1
End Sub

Private Sub Form_Load()
   DBConnection
   SetFormData (SetSQL("", ""))
   gDSN = "DSN=Freight"
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"
    cnDB.ConnectionString = "DSN=Freight"
    cnDB.CommandTimeout = 15
    cnDB.Open
End Sub

Private Function SetSQL(mQuerySQL As String, mTaxisSQL As String) As String    'mQuerySQL为查询语句的条件，如为空则没有Where子句，不为空则带Where语句；mTaxisSQL为排序条件语句，如空则没有Order By语句，不为空则带Order By
  SetSQL = "SELECT Freight.CONTACT_ID, Freight.CONSIG_NAME, Freight.IN_OUT, Freight.PERSON,Freight.START_DATE " & _
           "From Freight " & mQuerySQL & " " & 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, 5) <> "" Then
        MfgZY.TextMatrix(I, 5) = Format(SetMfgZyDateType(MfgZY.TextMatrix(I, 5)), "YYYY年MM月DD日")
      End If
     Next
   If MfgZY.Rows > 1 Then
     SetButton True
   Else
     cmdNew.Enabled = True
   End If
   cmdEdit.Enabled = False
   cmdDelete.Enabled = False
   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.ColWidth(1) = 1000
    MfgZY.ColWidth(2) = 1110
    MfgZY.ColWidth(3) = 1110
    MfgZY.ColWidth(4) = 1110
    MfgZY.ColWidth(5) = 1550
    'MfgZY.ColWidth(6) = 1120
End Sub
Private Sub SetButton(bVal As Boolean)
    cmdNew.Enabled = Not bVal
    cmdEdit.Enabled = Not bVal
    cmdSave.Enabled = Not bVal
    'cmd1.Enabled = Not bVal
    cmdDelete.Enabled = bVal
    cmd1.Enabled = False
    Cmd2.Enabled = False
    cmdSearch.Enabled = bVal
    cmdView.Enabled = bVal
    cmdPrint.Enabled = bVal
    fra1.Enabled = Not bVal
End Sub



Private Sub cmdCancel_Click()
 SetTextNull
 'If MfgZY.Rows >= 1 Then
 '    SetButton True
 '  Else
 '    cmdNew.Enabled = True
 '  End If
 '  cmdEdit.Enabled = False
 '  cmdDelete.Enabled = False
 '  DtpZZ.Visible = False
 '  txtZY(1).Enabled = True
 '  MfgZY.Enabled = True
   gTaxisSQL = ""
   gQuerySQL = ""
   Call SetFormData(SetSQL("", "")) '设置窗口显示数据
End Sub
Private Sub cmdDelete_Click()

 Dim mStrSQL As String
 On Error GoTo DelErr
 mStrSQL = "Select QC_DEL From 权限 Where UserID='" & gUser & "'"
 rs.Open mStrSQL, cnDB, adOpenStatic, adLockReadOnly
 
 If rs("QC_DEL") = 0 Then   '权限判断
   MsgBox "您没有此操作的权限！", vbInformation + vbOKOnly, "提示"
   rs.Close
   Exit Sub
 Else
    rs.Close
    If txtZY(1).Text <> "" Then
        If MsgBox("确定要删除编号为 [" & txtZY(1).Text & "]" & vbNewLine & "编号为[" & txtZY(1).Text & "] 这条记录吗？", vbQuestion + vbOKCancel, "提示:删除记录") = vbOK Then
           ButtonStatus = "Delete"
           MfgZY.Enabled = False
           Call cmdSave_Click
        End If
    Else
     MsgBox "没有选择要删除的记录或本表己没有记录！", vbExclamation + vbOKOnly, "提示"
    End If
 End If
 Exit Sub
DelErr:
 MsgBox Err.Description
End Sub
Private Sub cmdExit_Click()
 Unload Me
End Sub

Private Sub cmdNew_Click()
 Dim mStrSQL As String
 mStrSQL = "Select QC_NEW From 权限 Where UserID='" & gUser & "'"
 rs.Open mStrSQL, cnDB, adOpenStatic, adLockReadOnly
 
 If rs("QC_NEW") = 0 Then   '权限判断
   MsgBox "您没有此操作的权限！", vbInformation + vbOKOnly, "提示"
   rs.Close
   Exit Sub
 Else
    rs.Close
    ButtonStatus = "New"
    fra1.Enabled = True
    SetButton False
    SetTextNull
    txtZY(1).SetFocus
    MfgZY.Enabled = False
 End If
End Sub
Private Sub cmdEdit_Click()
 Dim mStrSQL As String
 mStrSQL = "Select QC_EDIT From 权限 Where UserID='" & gUser & "'"
 rs.Open mStrSQL, cnDB, adOpenStatic, adLockReadOnly
 
 If rs("QC_EDIT") = 0 Then   '权限判断
   MsgBox "您没有此操作的权限！", vbInformation + vbOKOnly, "提示"
   rs.Close
   Exit Sub
 Else
    rs.Close
    If txtZY(1).Text <> "" Then
     ButtonStatus = "Edit"
     fra1.Enabled = True
     SetButton False
     txtZY(1).Enabled = False
     'txtZY(2).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 ButtonStatus = "New" Then
         If MfgZY.Rows >= 1 Then
            For I = 1 To MfgZY.Rows - 1
             If Trim(UCase(txtZY(1).Text)) = MfgZY.TextMatrix(I, 1) Then
              MsgBox "合同编号出现重复，请重新输入合同编号！", vbExclamation + vbOKOnly, "警告"
              Me.txtZY(1).SetFocus
              Exit Sub
             End If
             
             'If Trim(txtZY(4).Text) = MfgZY.TextMatrix(I, 4) Then
              'MsgBox "编号出现重复，请重新输入编号！", vbExclamation + vbOKOnly, "警告"
              'Me.txtZY(4).SetFocus
              'Exit Sub
             'End If
            Next
           End If
  End If
  If ButtonStatus = "Edit" Then
     If MfgZY.Rows >= 1 Then
       For I = 1 To MfgZY.Rows - 1
        If Trim(UCase(txtZY(1).Text)) = UCase(MfgZY.TextMatrix(I, 1)) And I <> txtRow.Text Then
              MsgBox "合同编号出现重复，请重新输入合同编号！！", vbExclamation + vbOKOnly, "警告"
              Me.txtZY(1).SetFocus
              Exit Sub
        End If
       Next
     End If
  End If
  
  If ButtonStatus <> "Delete" Then
    If checkData = False Then
      Exit Sub
    End If
    
    If MsgBox("确定要保存吗？", vbInformation + vbOKCancel, "保存") = vbCancel Then
      Exit Sub
    End If
  End If
  

   Select Case ButtonStatus
    Case "New"
         StrSQL = "insert into Freight "
         StrSQL = StrSQL & "values("
         TemSQL = ""
         For I = 1 To 6
          Select Case I
           Case 3
            TemSQL = TemSQL & "," & StrToSQL(Me.txtZY(I).Text)
 
           Case 5
            If Trim(txtZY(I).Text) <> "" Then
               TemSQL = TemSQL & ",'" & StrToSQL(Me.txtZY(I).Text) & "'"
            Else
               TemSQL = TemSQL & "," & "Null"
            End If
           Case Else
            TemSQL = TemSQL & ",'" & StrToSQL(Me.txtZY(I).Text) & "'"
          End Select
         Next
         StrSQL = StrSQL & Mid(TemSQL, 2) & ")"
         TemSQL = ""
          
    Case "Edit"
       If Trim(txtZY(5).Text) = "" Then
        StrSQL = "update Freight set CONTACT_ID='" & StrToSQL(txtZY(1).Text) & "'," & _
                 "CONSIG_NAME='" & StrToSQL(txtZY(2).Text) & "',IN_OUT='" & StrToSQL(txtZY(3).Text) & "',START_DATE=Null" & _
                 "Where PERSON=" & StrToSQL(txtZY(4).Text)
       Else
        StrSQL = "update Freight set PERSON='" & StrToSQL(txtZY(4).Text) & "'," & _
                 "CONSIG_NAME='" & StrToSQL(txtZY(2).Text) & "',IN_OUT='" & StrToSQL(txtZY(3).Text) & "',START_DATE='" & StrToSQL(txtZY(5).Text) & "' " & _
                 "Where CONTACT_ID=" & StrToSQL(txtZY(1).Text)
       End If
       
    Case "Delete"
        StrSQL = "Delete from Freight Where CONTACT_ID=" & StrToSQL(txtZY(1).Text) & ""
 End Select
 
 cnDB.Execute StrSQL
 SetFormData (SetSQL("", ""))
   If MfgZY.Rows >= 1 Then
     SetButton True
   Else
     cmdNew.Enabled = True
   End If
   cmdEdit.Enabled = False
   cmdDelete.Enabled = False
   DtpZZ.Visible = False
   MfgZY.Enabled = True
   txtZY(4).Enabled = True
   'SetTextNull
   'cmdNew.SetFocus
   cmd1.Enabled = True
   'cmd1.SetFocus
   Cmd2.Enabled = True
 Exit Sub
 
SaveErr:
 
 MsgBox Err.Description
 Call cmdCancel_Click
End Sub
Private Sub cmdtaxis_Click()
FrmTaxis.TaxisSQL = "SELECT Freight.CONTACT_ID, Freight.CONSIG_NAME, Freight.IN_OUT, Freight.PERSON,Freight.START_DATE ,Freight.PRICES From Freight"
            
 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
   cmdSave.SetFocus
  End If
End Sub
Private Sub DtpZZ_LostFocus()
 txtZY(5).Text = Format(DtpZZ.Value, "YYYY年MM月DD日")
 txtZY(5).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
 Dim I As Integer
 gRow = MfgZY.row
 gcount = MfgZY.Cols
 Me.txtRow.Text = gRow
 If MfgZY.Rows > 1 Then
    For I = 1 To gcount - 1
      txtZY(I).Text = MfgZY.TextMatrix(gRow, I)
      If I = 5 Then
       txtZY(I).Text = Format(MfgZY.TextMatrix(gRow, I), "YYYY年MM月DD日")
      End If
    Next
    'cmdEdit.Enabled = True
    'cmdDelete.Enabled = True
    cmd1.Enabled = True
    Cmd2.Enabled = True
 End If
End Sub
Private Sub SetTextNull()
 Dim I As Integer
 For I = 1 To 5
  txtZY(I).Text = ""
   'If I = 3 Then
   '    txtZY(3).Text = 1
   'End If
 Next
End Sub
Private Function checkData() As Boolean
  If txtZY(1).Text = "" Then
   MsgBox "合 同 编 号 不 能 为 空！", vbInformation + vbOKOnly, "提示"
   txtZY(1).SetFocus
   checkData = False
   Exit Function
  End If
  If txtZY(3).Text = "" Then
   MsgBox "出/入库标记不能为空！", vbInformation + vbOKOnly, "提示"
   txtZY(3).SetFocus
   checkData = False
   Exit Function
  End If
  checkData = True
End Function
Private Sub txtZY_GotFocus(Index As Integer)
 Select Case Index
  Case 5
   If txtZY(5).Text = "" Then
     txtZY(5).Text = Format(Now, "YYYY年MM月DD日")
   End If
   DtpZZ.Value = txtZY(5).Text
   DtpZZ.Visible = True
   DtpZZ.SetFocus
   txtZY(5).Visible = False
 End Select
   
 
End Sub
Private Sub txtZY_KeyPress(Index As Integer, KeyAscii As Integer)
 Select Case Index
  Case 1
    If KeyAscii = 8 Then
      Exit Sub
    End If
    If KeyAscii = 13 Then
        txtZY(Index + 1).SetFocus
        Exit Sub
    End If
    If KeyAscii < 48 Or KeyAscii > 57 Then
        Beep
        KeyAscii = 0
    End If
 ' Case 2
 '   If KeyAscii = 8 Then
 '     Exit Sub
 '   End If
 '   If KeyAscii = 13 Then
 '       txtZY(Index + 1).SetFocus
 '       Exit Sub
 '   End If
 '   If KeyAscii < 48 Or KeyAscii > 57 = 0 Then
 '       Beep
 '       KeyAscii = 0
 '   End If
  Case 3
   If KeyAscii = 8 Then
      Exit Sub
   End If
    If KeyAscii = 13 Then
        txtZY(Index + 1).SetFocus
        Exit Sub
    End If
If KeyAscii < 48 Or KeyAscii > 49 Then
        Beep
        KeyAscii = 0
    End If
'  Case 4
'    If KeyAscii = 8 Then
'      Exit Sub
'    End If
'    If KeyAscii = 13 Then
'        txtZY(Index + 1).SetFocus
'        Exit Sub
'    End If
'    If KeyAscii < 48 Or KeyAscii > 57 = 0 Then
'        Beep
'        KeyAscii = 0
'    End If
  Case 5
     If KeyAscii = 13 Then
       cmdSave.SetFocus
     End If
  Case Else
    If KeyAscii = 13 Then
     
        txtZY(Index + 1).SetFocus

    End If
  End Select
End Sub
Private Sub cmdSearch_Click()
 FrmQuery.QuerySQL = "SELECT Freight.CONTACT_ID, Freight.CONSIG_NAME, Freight.IN_OUT, Freight.PERSON,Freight.START_DATE  From Freight"
            
 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