frmwar_ou.frm

智能仓库管理系统

         BackStyle       =   0  'Transparent
         Caption         =   "记录编号："
         Height          =   255
         Index           =   3
         Left            =   0
         TabIndex        =   30
         Top             =   480
         Width           =   1020
      End
      Begin VB.Label Label4 
         Caption         =   "入库日期："
         Height          =   255
         Index           =   5
         Left            =   5760
         TabIndex        =   25
         Top             =   960
         Width           =   1020
      End
      Begin VB.Label Label4 
         Caption         =   "出库日期："
         Height          =   255
         Index           =   4
         Left            =   120
         TabIndex        =   24
         Top             =   1440
         Width           =   1020
      End
      Begin VB.Label Label4 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "收费单价："
         Height          =   255
         Index           =   1
         Left            =   3120
         TabIndex        =   20
         Top             =   960
         Width           =   1020
      End
      Begin VB.Label Label4 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "物品数量："
         Height          =   255
         Index           =   9
         Left            =   0
         TabIndex        =   5
         Top             =   960
         Width           =   1020
      End
   End
   Begin MSForms.CommandButton CmdEnsure 
      Height          =   585
      Left            =   3240
      TabIndex        =   34
      Top             =   4920
      Width           =   2265
      VariousPropertyBits=   19
      Caption         =   "确定出库"
      PicturePosition =   524294
      Size            =   "3995;1032"
      Picture         =   "frmWar_Ou.frx":3E70
      FontName        =   "宋体"
      FontEffects     =   1073741825
      FontHeight      =   300
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
      FontWeight      =   700
   End
   Begin VB.Label Label1 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Index           =   1
      Left            =   1440
      TabIndex        =   22
      Top             =   4920
      Width           =   1575
   End
   Begin VB.Label Label4 
      Caption         =   "合 同 编 号："
      Height          =   375
      Index           =   7
      Left            =   120
      TabIndex        =   21
      Top             =   4920
      Width           =   1215
   End
End
Attribute VB_Name = "frmWar_Ou"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private cnDB As New ADODB.Connection
Private rs As New ADODB.Recordset
Private ButtonStatus As String
Private Sub Form_Load()
   txtzy2 = con_id
  gQuerySQL = "where contact_id='" & txtzy2 & "' and STATE_I=1"
   DBConnection
   SetFormData (SetSQL("", ""))
   Label1(1).Caption = txtzy2
   gDSN = "DSN=Warehouse"
   SetTxtzy_Data
   fra1.Enabled = True
   SetButton False
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=Warehouse"
    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 StoreRoom.ID, StoreRoom.CONTACT_ID, StoreRoom.S_CODE, StoreRoom.AMOUNT,StoreRoom.PRICE,StoreRoom.IN_DATE,StoreRoom.OUT_DATE,StoreRoom.STATE_I " & _
           "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.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
   ' MfgZY.ColWidth(9) = 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()
   gQuerySQL = "where contact_id='" & txtzy2 & "' and STATE_I=1"
   Call SetFormData(SetSQL("", "")) '设置窗口显示数据
End Sub

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


Private Sub Cmdensure_Click()

If Trim(MfgZY.TextMatrix(1, 1)) = "" Then
      MsgBox "准许出库的记录已为空！", vbExclamation + vbOKOnly, "提示"
      Exit Sub
Else
      If MsgBox("确定要出库吗？", vbInformation + vbOKCancel, "确定") = vbCancel Then
      Exit Sub
      End If
End If
ButtonStatus = "CmdEnsure"
SaveSub (ButtonStatus)
End Sub
Private Sub cmdSave_Click()

 If MsgBox("确定要保存吗？", vbInformation + vbOKCancel, "保存") = vbCancel Then
      Exit Sub
    End If
ButtonStatus = "cmdsave"
SaveSub (ButtonStatus)

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
   txtZY(Index + 1).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()
SetTxtzy_Data
End Sub
Private Sub txtZY_KeyPress(Index As Integer, KeyAscii As Integer)
Select Case Index
  
  Case 8
   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 > 59 Then
        Beep
        KeyAscii = 0
    End If

  Case 9
   If KeyAscii = 8 Then
      Exit Sub
   End If
    If KeyAscii = 13 Then
        cmdSave.SetFocus
        Exit Sub
    End If
    If KeyAscii < 48 Or KeyAscii > 59 Then
        Beep
        KeyAscii = 0
    End If
    
End Select
End Sub


Private Sub txtZY_GotFocus(Index As Integer)
 Select Case Index
  Case 7
   
      DtpZZ.Visible = True
      DtpZZ.SetFocus
      'txtZY(7).Visible = False
      DtpZZ.Value = txtZY(7).Text
 
 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 SetTxtzy_Data()
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
      If I = 1 Then
      txtZY(I).Text = MfgZY.TextMatrix(gRow, I)
      End If
      If I = 2 Then
      txtZY(I).Text = MfgZY.TextMatrix(gRow, I)
      End If
      If I = 3 Then
      txtZY(I).Text = MfgZY.TextMatrix(gRow, I)
      End If
      If I = 4 Then
      txtZY(I).Text = MfgZY.TextMatrix(gRow, I)
      End If
      If I = 5 Then
      txtZY(I).Text = MfgZY.TextMatrix(gRow, I)
      End If
      If I = 6 Then
          If MfgZY.TextMatrix(gRow, I) <> "" Then
             txtZY(6).Text = Format(MfgZY.TextMatrix(gRow, I), "YYYY年MM月DD日")
           Else
             txtZY(6).Text = ""
           End If
      End If
      If I = 7 Then
          If MfgZY.TextMatrix(gRow, I) <> "" Then
             txtZY(7).Text = Format(MfgZY.TextMatrix(gRow, I), "YYYY年MM月DD日")
           Else
             txtZY(7).Text = ""
           End If
      End If
      If I = 8 And MfgZY.TextMatrix(gRow, I) <> "" Then
         Chk1.Value = MfgZY.TextMatrix(gRow, I)
      End If
      
    Next
      
End If

Label1(1).Caption = txtZY(2)
txtzy2 = txtZY(2)
End Sub
Private Sub SaveSub(MyCmd As String)
 Dim StrSQL As String
Dim TemSQL As String
Dim I, j As Integer
On Error GoTo SaveErr

If Trim(Me.txtZY(7)) = "" Then
      MsgBox "出库日期不能为空，请输入出库日期！", vbExclamation + vbOKOnly, "提示"
      txtZY(7).SetFocus
      Exit Sub
End If

 
 
Select Case MyCmd
  Case "cmdsave"
          StrSQL = "update StoreRoom set OUT_DATE='" & CDate((txtZY(7).Text)) & "'," & _
                                         "STATE_I='" & StrToSQL(Me.Chk1.Value) & "'" & _
                    "Where ID=" & StrToSQL(txtZY(1).Text) & " and CONTACT_ID=" & "'" & StrToSQL(txtZY(2).Text) & "'"
   Case "CmdEnsure"
         StrSQL = "update StoreRoom set OUT_DATE='" & CDate((txtZY(7).Text)) & "'," & _
                                        "STATE_I='2 '" & _
                  "Where ID=" & StrToSQL(txtZY(1).Text) & " and CONTACT_ID=" & "'" & StrToSQL(txtZY(2).Text) & "'"
End Select
            
 cnDB.Execute StrSQL
 SetFormData (SetSQL("", ""))
 cmdEdit.Enabled = False
 DtpZZ.Visible = False
 MfgZY.Enabled = True
Exit Sub
 
SaveErr:
 
 MsgBox Err.Description
 Call cmdCancel_Click
End Sub