frmbookoutstorage.frm

来自「通用书店管理系统」· FRM 代码 · 共 1,729 行 · 第 1/5 页

   End If
   sqlstring = "select * from OutstorageInformation where ChrCKDH='" & txtFields(0).Text & "' and datSPDate is not null"
   rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
   If Not rsNewTmp.EOF Then
      MsgBox "出库单：" & txtFields(0) & "已经通过审批，不能删除！", , "警告"
      Exit Sub
   End If
   
   cN.BeginTrans
   '删除主表
   sqlstring = "delete from OutstorageInformation where ChrCKDH='" & txtFields(0).Text & "'"
   cN.Execute sqlstring
   
   '删除从表
   sqlstring = "delete from OutstorageInformation_List where ChrCKDH='" & txtFields(0).Text & "'"
   cN.Execute sqlstring
   
   cN.CommitTrans
   
   setFormState (ModNormal)
   Call clearAll
   Exit Sub
DelErr:
   cN.RollbackTrans
   MsgBox "删除记录失败：" & err.Description, vbInformation
End Sub

Public Sub CmdSave_Click()
    On Error GoTo SaveErr
    Dim i As Integer
    Dim intIsCancel As Integer
    Dim sqlstring As String
    Dim rsNewTmp As New ADODB.Recordset
    Dim strNull
    
    strNull = Null
    
    tdbBook_BeforeUpdate intIsCancel                        '检查从表一
    If intIsCancel = True Then
        tdbBook.SetFocus
        Exit Sub
    End If

    tdbBook.Update
    If X.UpperBound(1) < 0 Then
        MsgBox "出库单明细数据不能为空", vbOKOnly, "警告"
        Exit Sub
    End If
    
    '检查出库单号是否为空
    If txtFields(0).Text = "" Then
          MsgBox "出库单号不能为空！", , "警告"
          Exit Sub
    ElseIf txtFields(2).Text = "" Then
          MsgBox "折扣不能为空！", , "警告"
          Exit Sub
    End If
    
    '检查库区号、出库类型是否为空
    If cmbFields(0).Text = "" Then
          MsgBox "出库类型不能为空！", , "警告"
          Exit Sub
    ElseIf cmbFields(1).Text = "" Then
          MsgBox "出库区号不能为空！", , "警告"
          Exit Sub
    ElseIf cmbFields(0).Text = "调拨" Then
          If cmbFields(2).Text = "" Then
            MsgBox "入库区号不能为空！", , "警告"
            Exit Sub
          End If
          
          If cmbFields(1).Text = cmbFields(2).Text Then
            MsgBox "出、入库区号不能相同！", , "警告"
            Exit Sub
          End If
    End If
    
    
    Select Case intFormState
        Case modadd
            If SaveAddingNew Then
                setFormState modBrowsing       '如果保存成功
                blnIsModified = False
            Else
                Exit Sub
            End If
        Case modEdit
            If SaveUpdate Then
                setFormState modBrowsing         '如果更新成功
                blnIsModified = False
            Else
                Exit Sub
            End If
        Case Else
            Exit Sub
    End Select
    
    Call clearAll
    blnIsModified = False
    Exit Sub
SaveErr:
    cN.RollbackTrans
    MsgBox "保存记录出错：" & err.Description, vbInformation
End Sub

Public Sub cmdUndo_Click()
   '询问是否放弃当前内容
    If blnIsModified Then
        If MsgBox("当前修改的内容会丢失。确认要取消吗？", vbOKCancel, "询问") <> vbOK Then Exit Sub
    End If
    clearAll
    setFormState (ModNormal)
    blnIsModified = False
End Sub



Private Sub cmbFields_Click(Index As Integer)
  Select Case Index
    Case 0
      If cmbFields(0).Text = "调拨" Then
         cmbFields(2).Text = ""
         cmbFields(2).Visible = True
         Label1(7).Visible = True
      Else
         cmbFields(2).Text = ""
         cmbFields(2).Visible = False
         Label1(7).Visible = False
      End If
    Case Else
  End Select
End Sub

Private Sub cmdSearch_Click(Index As Integer)
  On Error GoTo err
  Dim strQuery As String
  Dim arrQuery
  
  Select Case Index
    Case 0

      strQuery = g_CommonSelect("   出库单号   |     出库类型  |  出库库区  |  入库库区  |  经办人  |  总数量  |  码洋  |  实洋  |  制单人  |  制单日期  ", "select ChrCKDH,ChrOutStorageNo,ChrStorageNo1,ChrStorageNo2,ChrJBR," & _
                                "intTotal,decMY,decSY,ChrZDR,DatDate from OutstorageInformation where datSPDate is null order by ChrCKDH")
      txtFields(0).Text = strQuery
  End Select
  
  
  Exit Sub
err:
   MsgBox "查询数据失败：" & err.Description, vbInformation
End Sub

Public Sub cmdQuery_Click()
  On Error GoTo err
  Dim sqlstring As String
  Dim rsNewTmp As New ADODB.Recordset
  
  If txtFields(0).Text = "" Then
     MsgBox "请输入要查询的出库单号！", vbInformation
  Else
     If ShowMainRecorder Then
        Call ShowSubRecorder
     Else
        MsgBox "没有要查询的出库单信息，输入是否有误？"
        Exit Sub
     End If
  End If
  Exit Sub
err:
   MsgBox "查询数据失败：" & err.Description, vbInformation
End Sub




Private Sub Form_Activate()
   SetToolBar ("1100X10X101X111X1")
   
   If intFormState = modadd Then
      SetToolBar ("0011X10X001X111X1")
  End If
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If ActiveControl.Name <> "tdbBook" Then
        Call autoreturn(KeyCode)
    End If
End Sub



Private Sub Form_Load()
  On Error GoTo err
  Dim i As Integer
  Dim sqlstring As String
  Dim rsNewTmp As New ADODB.Recordset
  
  
    With tdbBook
       .FetchRowStyle = False
       .Columns(8).FetchStyle = True
    End With
    
  '初始化变量
  intFormState = ModNormal
  blnIsModified = False

  '初始化控件状态
  Me.WindowState = vbMaximized
  
  strDate = Format(Date, "yyyymmdd")

  setFormState (ModNormal)

   
  X.ReDim 0, -1, 0, 8
  Set tdbBook.Array = X
  
  '设置TDBGRID各列属性
  SetTdbGridStatus 0, 1, , , False
'  SetTdbGridStatus 3, 1, True, gColor_LockedText
  SetTdbGridStatus 8, 1
  
  For i = 0 To dtpInDate.UBound
    dtpInDate(i).Value = Format(Date, "yyyy-mm-dd")
  Next
  
  '库区名称
  sqlstring = "select * from StorageSection order by ChrStorageNo"
  rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
  cmbFields(1).Clear
  cmbFields(2).Clear
  Do While Not rsNewTmp.EOF
    cmbFields(1).AddItem Trim(rsNewTmp("ChrStorageName").Value)
    cmbFields(2).AddItem Trim(rsNewTmp("ChrStorageName").Value)
    rsNewTmp.MoveNext
  Loop
  
  rsNewTmp.Close
  
  '出库类型
  sqlstring = "select * from OutStorageType order by ChrOutStorageNo"
  rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
  cmbFields(0).Clear
  Do While Not rsNewTmp.EOF
    cmbFields(0).AddItem Trim(rsNewTmp("ChrOutStorageName").Value)
    rsNewTmp.MoveNext
  Loop
  
  rsNewTmp.Close
  
    
  Exit Sub
err:
  MsgBox "打开表失败：" & err.Description, vbInformation
End Sub

Private Sub Form_Unload(Cancel As Integer)

    If Trim(cmbFields(0)) <> "" Then
        SaveLastInfo "software\" & App.CompanyName & "\" & App.ProductName & "\库存管理", "最近出库出库类型", Trim(cmbFields(0))
    End If
    If Trim(cmbFields(1)) <> "" Then
        SaveLastInfo "software\" & App.CompanyName & "\" & App.ProductName & "\库存管理", "最近出库库区名称", Trim(cmbFields(1))
    End If
    If Trim(cmbFields(2)) <> "" Then
        SaveLastInfo "software\" & App.CompanyName & "\" & App.ProductName & "\库存管理", "最近出库库区号", Trim(cmbFields(2))
    End If
    
    Unload frmLogin
    SetToolBar ("0000X00X001X111X1")
End Sub


Private Sub Tdbbook_FetchCellStyle(ByVal Condition As Integer, ByVal Split As Integer, Bookmark As Variant, ByVal Col As Integer, ByVal CellStyle As TrueOleDBGrid70.StyleDisp)
Dim sqlstring As String
Dim rsNewTmp As New ADODB.Recordset

'    If TdbSale.Col = 4 Then
        sqlstring = "select IntAmount from BookStorage where chrBookNo ='" & tdbBook.Columns(1).CellText(Bookmark) & "' "
        Set rsNewTmp = New ADODB.Recordset
        rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        If rsNewTmp.EOF Then Exit Sub
        Debug.Print rsNewTmp("IntAmount").Value
        If rsNewTmp("IntAmount").Value <= 1 Then
         
           'TdbSale.Columns(4).c = vbRed
           'CellStyle.BackColor = vbRed
           CellStyle.ForeColor = vbRed
           
        End If
'    End If

End Sub

Private Sub tdbBook_KeyDown(KeyCode As Integer, Shift As Integer)
  Dim strQuery As String
  Dim arrQuery
  Dim sqlstring As String
  Dim rstmp As ADODB.Recordset
  
  '按F2键弹出选择框
  If KeyCode = vbKeyF2 Then
     Select Case tdbBook.Col
       Case 1
           Call g_CommonSelect("  书号  |  书名  |  单价  |  折扣  |  供货商  |  出版社  |  出版日期  ", "select chrBookNo,chrBookName,DecPrice,DecAgio,ChrGHS,Chrbookconcern,DatPublishDate" & _
                               " from BookData where chrBookNo like '%" & tdbBook.Columns(1).Text & "%'", "0,1,2,3", , , , -1, arrQuery)
           If TypeName(arrQuery) = "Variant()" Then
              tdbBook.Columns(1) = arrQuery(0, 0)
              tdbBook.Columns(2) = arrQuery(0, 1)
              tdbBook.Columns(3) = arrQuery(0, 2)
               
              sqlstring = "select top 1 DecAgio from outstorageInformation_list where chrBookNo like '%" & tdbBook.Columns(1).Text & "%' order by chrCKDH desc"
              Set rstmp = New ADODB.Recordset
              rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
              If Not rstmp.EOF Then
                tdbBook.Columns(4) = rstmp.Fields("decagio")
              Else
                tdbBook.Columns(4) = arrQuery(0, 3)
              End If
              
              If tdbBook.Columns(4) = "" Then
                 tdbBook.Columns(4) = 1
              End If
    
              tdbBook_AfterColUpdate tdbBook.Col
         
        End If
       Case 2
           Call g_CommonSelect("  书号  |  书名  |  单价  |  折扣  |  供货商  |  出版社  |  出版日期  ", "select chrBookNo,chrBookName,DecPrice,DecAgio,ChrGHS,Chrbookconcern,DatPublishDate" & _
                               " from BookData where chrBookName like '%" & tdbBook.Columns(2).Text & "%'", "0,1,2,3", , , , -1, arrQuery)
           If TypeName(arrQuery) = "Variant()" Then
              tdbBook.Columns(1) = arrQuery(0, 0)
              tdbBook.Columns(2) = arrQuery(0, 1)
              tdbBook.Columns(3) = arrQuery(0, 2)
              
            sqlstring = "select top 1 DecAgio from outstorageInformation_list where chrBookNo like '%" & tdbBook.Columns(1).Text & "%' order by chrCKDH desc"
            Set rstmp = New ADODB.Recordset
            rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
            If Not rstmp.EOF Then
              tdbBook.Columns(4) = rstmp.Fields("decagio")
            Else
              tdbBook.Columns(4) = arrQuery(0, 3)
            End If
            If tdbBook.Columns(4) = "" Then
               tdbBook.Columns(4) = 1