frmpdinput.frm

通用书店管理系统

      _StyleDefs(39)  =   "Splits(0).Columns(2).HeadingStyle:id=43,.parent=14"
      _StyleDefs(40)  =   "Splits(0).Columns(2).FooterStyle:id=44,.parent=15"
      _StyleDefs(41)  =   "Splits(0).Columns(2).EditorStyle:id=45,.parent=17"
      _StyleDefs(42)  =   "Splits(0).Columns(3).Style:id=50,.parent=13"
      _StyleDefs(43)  =   "Splits(0).Columns(3).HeadingStyle:id=47,.parent=14"
      _StyleDefs(44)  =   "Splits(0).Columns(3).FooterStyle:id=48,.parent=15"
      _StyleDefs(45)  =   "Splits(0).Columns(3).EditorStyle:id=49,.parent=17"
      _StyleDefs(46)  =   "Splits(0).Columns(4).Style:id=54,.parent=13"
      _StyleDefs(47)  =   "Splits(0).Columns(4).HeadingStyle:id=51,.parent=14"
      _StyleDefs(48)  =   "Splits(0).Columns(4).FooterStyle:id=52,.parent=15"
      _StyleDefs(49)  =   "Splits(0).Columns(4).EditorStyle:id=53,.parent=17"
      _StyleDefs(50)  =   "Splits(0).Columns(5).Style:id=66,.parent=13"
      _StyleDefs(51)  =   "Splits(0).Columns(5).HeadingStyle:id=63,.parent=14"
      _StyleDefs(52)  =   "Splits(0).Columns(5).FooterStyle:id=64,.parent=15"
      _StyleDefs(53)  =   "Splits(0).Columns(5).EditorStyle:id=65,.parent=17"
      _StyleDefs(54)  =   "Splits(0).Columns(6).Style:id=70,.parent=13"
      _StyleDefs(55)  =   "Splits(0).Columns(6).HeadingStyle:id=67,.parent=14"
      _StyleDefs(56)  =   "Splits(0).Columns(6).FooterStyle:id=68,.parent=15"
      _StyleDefs(57)  =   "Splits(0).Columns(6).EditorStyle:id=69,.parent=17"
      _StyleDefs(58)  =   "Splits(0).Columns(7).Style:id=74,.parent=13"
      _StyleDefs(59)  =   "Splits(0).Columns(7).HeadingStyle:id=71,.parent=14"
      _StyleDefs(60)  =   "Splits(0).Columns(7).FooterStyle:id=72,.parent=15"
      _StyleDefs(61)  =   "Splits(0).Columns(7).EditorStyle:id=73,.parent=17"
      _StyleDefs(62)  =   "Named:id=33:Normal"
      _StyleDefs(63)  =   ":id=33,.parent=0"
      _StyleDefs(64)  =   "Named:id=34:Heading"
      _StyleDefs(65)  =   ":id=34,.parent=33,.valignment=2,.bgcolor=&H8000000F&,.fgcolor=&H80000012&"
      _StyleDefs(66)  =   ":id=34,.wraptext=-1"
      _StyleDefs(67)  =   "Named:id=35:Footing"
      _StyleDefs(68)  =   ":id=35,.parent=33,.valignment=2,.bgcolor=&H8000000F&,.fgcolor=&H80000012&"
      _StyleDefs(69)  =   "Named:id=36:Selected"
      _StyleDefs(70)  =   ":id=36,.parent=33,.bgcolor=&H8000000D&,.fgcolor=&H8000000E&"
      _StyleDefs(71)  =   "Named:id=37:Caption"
      _StyleDefs(72)  =   ":id=37,.parent=34,.alignment=2"
      _StyleDefs(73)  =   "Named:id=38:HighlightRow"
      _StyleDefs(74)  =   ":id=38,.parent=33,.bgcolor=&H8000000D&,.fgcolor=&H8000000E&"
      _StyleDefs(75)  =   "Named:id=39:EvenRow"
      _StyleDefs(76)  =   ":id=39,.parent=33,.bgcolor=&HFFFF00&"
      _StyleDefs(77)  =   "Named:id=40:OddRow"
      _StyleDefs(78)  =   ":id=40,.parent=33"
      _StyleDefs(79)  =   "Named:id=41:RecordSelector"
      _StyleDefs(80)  =   ":id=41,.parent=34"
      _StyleDefs(81)  =   "Named:id=42:FilterBar"
      _StyleDefs(82)  =   ":id=42,.parent=33"
   End
End
Attribute VB_Name = "frmPDInput"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim x As New XArrayDB          '从表1
Dim intFormState As Integer     '标示窗体的状态，“正常/浏览/新增/编辑”
Dim blnIsModified As Boolean   '是否有输入或修改数据     True for changed
Public strDate As String  '盘点录入日期
Dim blnOrder(8) As Boolean
Dim strOldBookNo As String


Public Sub cmdAddNew_Click()
  Dim sqlstring As String
  Dim rstmp As New ADODB.Recordset
  Dim rsnewtmp As New ADODB.Recordset
  Dim i As Integer
  
  On Error GoTo err
  
  If Not checkpermission("书店管理系统", strUserName, , "库存管理.盘点信息录入.新增") Then
       Exit Sub
  End If
   
  If Trim(txtFields(0).Text) = "" Then
     MsgBox "请输入库区号！", , "警告"
     Exit Sub
  ElseIf Trim(txtFields(1).Text) = "" Then
     MsgBox "库区表中没有该库区号的信息，不能执行下步操作！", , "警告"
     Exit Sub
  Else
      If Trim(txtFields(1).Text) <> GetStorageName(txtFields(0).Text) Then
        MsgBox "该库区号与库区名称不对应，不能执行下步操作！", , "警告"
        Exit Sub
      End If
  End If
  
  SetTdbGridStatus 1, , True, gColor_LockedText
  SetTdbGridStatus 2, , True, gColor_LockedText
  SetTdbGridStatus 3, , True, gColor_LockedText
  SetTdbGridStatus 5, , True, gColor_LockedText
  SetTdbGridStatus 6, , True, gColor_LockedText
  SetTdbGridStatus 7, , True, gColor_LockedText
  
  sqlstring = "select * from MonthlyPDInput where chrStorageNo='" & Trim(txtFields(0).Text) & "'"
  rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
  If Not rstmp.EOF Then
'     If MsgBox("是否清空重新录入？", vbYesNo) = vbYes Then
'          sqlstring = "delete from MonthlyPDInput where chrStorageNo='" & Trim(txtFields(0).Text) & "'"
'          cN.Execute sqlstring
'     Else
          sqlstring = "select * from BookData order by ChrBookType,ChrGHS,chrBookName"
          Set rstmp = New ADODB.Recordset
          rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
              
          x.ReDim 0, rstmp.Recordcount - 1, 0, 7
          i = 0
          If rstmp.Recordcount = 0 Then
             frmMain.prgBar.Max = 1
          Else
             frmMain.prgBar.Max = rstmp.Recordcount - 1
          End If
          
          Do While Not rstmp.EOF
                sqlstring = "select * from MonthlyPDInput where chrBookNo='" & rstmp.Fields("chrBookNo").Value & _
                          "' and chrBookName='" & rstmp.Fields("chrBookName").Value & "' and chrStorageNo='" & _
                          Trim(txtFields(0).Text) & "'"
                Set rsnewtmp = New ADODB.Recordset
                rsnewtmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
                If rsnewtmp.EOF Then
                    x(i, 0) = 0
                    x(i, 1) = rstmp.Fields("chrBookNo").Value
                    x(i, 2) = rstmp.Fields("chrBookName").Value
                    x(i, 3) = Trim(txtFields(0).Text)
                    x(i, 4) = 0
                    x(i, 5) = rstmp.Fields("ChrBookType").Value
                    x(i, 6) = rstmp.Fields("Chrbookconcern").Value
                    x(i, 7) = rstmp.Fields("ChrGHS").Value
                Else
                    x(i, 0) = -1
                    x(i, 1) = rsnewtmp.Fields("chrBookNo").Value
                    x(i, 2) = rsnewtmp.Fields("chrBookName").Value
                    x(i, 3) = Trim(txtFields(0).Text)
                    x(i, 4) = rsnewtmp.Fields("intAmount").Value
                    x(i, 5) = rstmp.Fields("ChrBookType").Value
                    x(i, 6) = rstmp.Fields("Chrbookconcern").Value
                    x(i, 7) = rstmp.Fields("ChrGHS").Value
                  End If
                
                rstmp.MoveNext
                i = i + 1
                Call ShowBar(i, True)
          Loop
          Call ShowBar(1, False)
          tdbStorageInput.ReBind
          setFormState (modadd)
    
          blnIsModified = False
          Exit Sub
'     End If
  End If
    
  sqlstring = "select * from BookData order by ChrBookType"
  Set rstmp = New ADODB.Recordset
  rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
    
  x.ReDim 0, rstmp.Recordcount - 1, 0, 7
  i = 0
  Do While Not rstmp.EOF
          x(i, 0) = -1
          x(i, 1) = rstmp.Fields("chrBookNo").Value
          x(i, 2) = rstmp.Fields("chrBookName").Value
          x(i, 3) = Trim(txtFields(0).Text)
          x(i, 4) = 0
          x(i, 5) = rstmp.Fields("ChrBookType").Value
          x(i, 6) = rstmp.Fields("Chrbookconcern").Value
          x(i, 7) = rstmp.Fields("ChrGHS").Value
          rstmp.MoveNext
          i = i + 1
  Loop
  tdbStorageInput.ReBind
  
  setFormState (modadd)
    
  blnIsModified = False
  
  
  Exit Sub
  
err:
  MsgBox "新增记录失败：" & err.Description, vbInformation
End Sub


Public Sub cmdCancel_Click()
   Unload Me
   SetToolBar ("0000X00X001X111")
End Sub

Public Sub cmdEdit_Click()
   
   If Not checkpermission("书店管理系统", strUserName, , "库存管理.盘点信息录入.修改") Then
       Exit Sub
   End If
   If Trim(txtFields(0).Text) = "" Then
       MsgBox "请输入库区号！", , "警告"
       Exit Sub
   ElseIf Trim(txtFields(1).Text) = "" Then
       MsgBox "库区表中没有该库区号的信息，不能执行下步操作！", , "警告"
       Exit Sub
   Else
      If Trim(txtFields(1).Text) <> GetStorageName(txtFields(0).Text) Then
        MsgBox "该库区号与库区名称不对应，不能执行下步操作！", , "警告"
        Exit Sub
      End If
   End If

   SetTdbGridStatus 1, , True, gColor_LockedText
   SetTdbGridStatus 2, , True, gColor_LockedText
   SetTdbGridStatus 3, , True, gColor_LockedText
   SetTdbGridStatus 5, , True, gColor_LockedText
   SetTdbGridStatus 6, , True, gColor_LockedText
   SetTdbGridStatus 7, , True, gColor_LockedText
   setFormState (modEdit)
   blnIsModified = False           '初始状态，没做任何修改
End Sub

Public Sub cmdQuery_Click()
   Dim i As Integer
   Dim sqlstring As String
   Dim rstmp As New ADODB.Recordset
   
   On Error GoTo err
   sqlstring = "select t1.*,ChrBookType,Chrbookconcern,ChrGHS from MonthlyPDInput t1 left join BookData t2 " & _
               " on t1.chrBookNo=t2.chrBookNo and t1.chrBookName=t2.chrBookName where t1.chrStorageNo='" & Trim(txtFields(0).Text) & _
               "' and chrPDDate=#" & Format(strDate, "yyyy-mm-dd") & "#"
   rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
   
   x.ReDim 0, rstmp.Recordcount - 1, 0, 7
   If rstmp.EOF Then
      MsgBox "盘点信息录入表中没有库区：" & txtFields(0).Text & " 的库存记录！"
      tdbStorageInput.ReBind
      Exit Sub
   End If
   
   i = 0
   Do While Not rstmp.EOF
      x(i, 0) = -1
      x(i, 1) = rstmp.Fields("chrBookNo").Value
      x(i, 2) = rstmp.Fields("chrBookName").Value
      x(i, 3) = rstmp.Fields("chrStorageNo").Value
      x(i, 4) = rstmp.Fields("intAmount").Value
      x(i, 5) = rstmp.Fields("ChrBookType").Value
      x(i, 6) = rstmp.Fields("Chrbookconcern").Value
      x(i, 7) = rstmp.Fields("ChrGHS").Value
      rstmp.MoveNext
      i = i + 1
   Loop
   tdbStorageInput.ReBind
   
   setFormState (modBrowsing)
   
   Exit Sub
err:
   MsgBox "查询记录出错：" & err.Description, vbInformation
   
End Sub

Public Sub CmdSave_Click()
    On Error GoTo SaveErr
    Dim i As Integer
    Dim sqlstring As String
    Dim rsnewtmp As New ADODB.Recordset
      
    tdbStorageInput.Update
    sqlstring = "delete From MonthlyPDInput where chrStorageNo='" & Trim(txtFields(0).Text) & "' and chrPDDate=#" & Format(strDate, "yyyy-mm-dd") & "#"
    cN.BeginTrans
    cN.Execute sqlstring
    For i = 0 To x.UpperBound(1)
      If x(i, 0) Then