frmbookinstorage.frm

通用书店管理系统

   
   If txtFields(2).Text = "" Then
     MsgBox "请录入要删除的入库单号！", vbInformation
     Exit Sub
   End If
   sqlstring = "select * from InstorageInformation where ChrRKDH='" & txtFields(2).Text & "' and DatCheckDate is not null"
   rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
   If Not rsNewTmp.EOF Then
      MsgBox "入库单：" & txtFields(2) & "已经通过审批，不能删除！", , "警告"
      Exit Sub
   End If
   
   cN.BeginTrans
   '删除主表
   sqlstring = "delete from InstorageInformation where ChrRKDH='" & txtFields(2).Text & "'"
   cN.Execute sqlstring
   
   '删除从表
   sqlstring = "delete from InstorageInformation_List where ChrRKDH='" & txtFields(2).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
        txtFields(0).Text = "无"        ' 如果用户不输入供应商，暂时设为“无”
        '  MsgBox "供应商号不能为空！", , "警告"
        '  Exit Sub
    ElseIf txtFields(2).Text = "" Then
          MsgBox "入库单号不能为空！", , "警告"
          Exit Sub
    ElseIf txtFields(5).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(2).Text = "" Then
          MsgBox "付款方式不能为空！", , "警告"
          Exit Sub
    ElseIf cmbFields(3).Text = "" Then
          MsgBox "入库类型不能为空！", , "警告"
          Exit Sub
    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
    Frame3.Visible = False
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 chrClientNo,chrClientName,chrLinkman,chrAddress from ClientData where intFlag=0 order by chrClientNo", "0,1", , , , -1, arrQuery)
      If TypeName(arrQuery) = "Variant()" Then
           txtFields(0).Text = arrQuery(0, 0)
           txtFields(1).Text = arrQuery(0, 1)
      End If
          
    Case 1
      strQuery = g_CommonSelect("   入库单号   |    供应商号   |   入库类型  |  库区  |  经办人  |  发书单号  |  来单数  |  实收数  |  制单人  |  制单日期  ", "select ChrRKDH,ChrClientNo,ChrInStorageNo,ChrStorageNo,ChrJBR," & _
                                "ChrFSDH,IntLDS,IntSSS,ChrZDR,DatZDDate from InstorageInformation where DatCheckDate is null order by ChrRKDH")
      txtFields(2).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(2).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 Command1_Click()
Dim frmB As frmBookInputL
Dim blnOK As Boolean
  If tdbBook.Columns(1) = "" Then
     MsgBox "请输入新书号！", vbInformation
  End If

  If tdbBook.Columns(1) <> "" Then

    Set frmB = New frmBookInputL
    frmB.intStatus = 12
    frmB.blnAddOne = True   ' 只增加一个记录
    frmB.txtFields(0) = tdbBook.Columns(1)
    frmB.Show vbModal
    blnOK = frmB.blnActOK
    
    
    If Not blnOK Then
        tdbBook.Col = 1
'        tdbBook.Columns(1).Text = ""
        Exit Sub
    End If
     tdbBook.Columns(1) = frmB.txtFields(0).Text
     tdbBook.Columns(2) = frmB.txtFields(1).Text
     tdbBook.Columns(3) = frmB.txtFields(10).Text
     tdbBook.Columns(4) = frmB.txtFields(9).Text
     tdbBook.Columns(8) = Format(frmB.DTP1.Value, "yyyy-mm-dd")

    Unload frmB
    Frame3.Visible = False
  End If
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
  
  '初始化变量
  intFormState = ModNormal
  blnIsModified = False

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

  setFormState (ModNormal)

   
  X.ReDim 0, -1, 0, 10
  Set tdbBook.Array = X
  
  '设置TDBGRID各列属性
  SetTdbGridStatus 0, 1, , , False
'  SetTdbGridStatus 3, 1, True, gColor_LockedText   ' lzw 2002-04-11
'  SetTdbGridStatus 4, 1, True, gColor_LockedText
'   SetTdbGridStatus 8, 1, True, gColor_LockedText
  SetTdbGridStatus 9, 1
  SetTdbGridStatus 10, 1
'
'  tdbBook.Columns(4).DropDown = TDBDropDown1
  
  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(0).Clear
  Do While Not rsNewTmp.EOF
    cmbFields(0).AddItem Trim(rsNewTmp("ChrStorageName").Value)
    rsNewTmp.MoveNext
  Loop
  
  rsNewTmp.Close
  
  '入库类型
  sqlstring = "select * from InStorageType order by ChrInStorageNo"
  rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
  cmbFields(3).Clear
  Do While Not rsNewTmp.EOF
    cmbFields(3).AddItem Trim(rsNewTmp("ChrInStorageName").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(3)) <> "" Then
        SaveLastInfo "software\" & App.CompanyName & "\" & App.ProductName & "\库存管理", "最近入库入库类型", Trim(cmbFields(3))
    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_KeyDown(KeyCode As Integer, Shift As Integer)
  Dim strQuery As String
  Dim arrQuery
  Dim sqlstring As String
  Dim rstmp As New ADODB.Recordset
  
  '按F2键弹出选择框
  If KeyCode = vbKeyF2 Then
     Select Case tdbBook.Col
       Case 1
           Call g_BookCommonSelect("  书号  |  书名  |  单价  |  折扣  |  供货商  |  出版社  |  出版日期  ", "select chrBookNo,chrBookName,DecPrice,DecAgio,ChrGHS,Chrbookconcern,DatPublishDate" & _
                               " from BookData where chrBookNo like '%" & tdbBook.Columns(1).Text & "%'", "0,1,2,3,6", , , , -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 InstorageInformation_list where chrBookNo like '%" & tdbBook.Columns(1).Text & "%' order by chrRKDH 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
                 tdbB