frmpdinput.frm

通用书店管理系统

         If IsVacancy(x(i, 4)) Then
            sqlstring = "Insert into MonthlyPDInput (chrPDdate,chrBookNo,chrBookName,chrStorageNo,intAmount) values " & _
                        "(#" & Format(strDate, "yyyy-mm-dd") & "#,'" & x(i, 1) & "','" & x(i, 2) & "','" & x(i, 3) & "',0)"
         Else
            sqlstring = "Insert into MonthlyPDInput (chrPDdate,chrBookNo,chrBookName,chrStorageNo,intAmount) values " & _
                        "(#" & Format(strDate, "yyyy-mm-dd") & "#,'" & x(i, 1) & "','" & x(i, 2) & "','" & x(i, 3) & "'," & x(i, 4) & ")"
         End If
         cN.Execute sqlstring
      End If
    Next
    cN.CommitTrans
    Call clearAll
    blnIsModified = False
    setFormState (modBrowsing)
    Exit Sub
SaveErr:
    cN.RollbackTrans
    MsgBox "保存记录出错：" & err.Description, vbInformation
End Sub

Private Sub cmdSearch_Click(Index As Integer)
  Dim arrQuery
  
  Select Case Index
    Case 0
        Call g_CommonSelect("       库区号   |   库区名称   ", "select ChrStorageNo,ChrStorageName  from StorageSection  " & _
                                 " where ChrStorageNo like '%" & txtFields(0).Text & "%'", "0,1", , , , -1, arrQuery)
        If TypeName(arrQuery) = "Variant()" Then
             txtFields(0).Text = arrQuery(0, 0)
             txtFields(1).Text = arrQuery(0, 1)
        End If
    
  End Select
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 Form_Activate()
  SetToolBar ("1100X01X101X111X1")
  
  If intFormState = modadd Then
    SetToolBar ("0011X00X001X111X1")
  End If
  
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  Dim strBookNo As String
  Dim intNo As Integer
  On Error GoTo err
  If Shift = 2 And KeyCode = vbKeyF Then
     strBookNo = InputBox("请输入书号", "查询", strOldBookNo)
     If Trim(strBookNo) = "" Then Exit Sub
     strOldBookNo = strBookNo
     intNo = x.Find(0, 1, strBookNo, XORDER_ASCEND, XCOMP_DEFAULT)
     If intNo <> -1 Then
        tdbStorageInput.Bookmark = intNo
     Else
        MsgBox "没有书号为:" & strBookNo & " 的图书记录!", vbInformation
        tdbStorageInput.Bookmark = 0
     End If
  End If
  Exit Sub
err:
End Sub

Private Sub Form_Load()
  x.ReDim 0, -1, 0, 7
  Set tdbStorageInput.Array = x
  tdbStorageInput.ReBind
End Sub


Private Sub setFormState(intState As Integer)   '设置窗体的不同状态
    
    intFormState = intState
    Select Case intState
        Case ModNormal
            Me.Caption = "盘点信息录入"
            setTxtWritable ("10")
    
            tdbStorageInput.AllowAddNew = False
            tdbStorageInput.AllowUpdate = False
            tdbStorageInput.AllowDelete = False
            SetToolBar ("1100X01X111X111X1")
    
    
        Case modBrowsing
            Me.Caption = "盘点信息录入——浏览"
            setTxtWritable ("10")
    
            tdbStorageInput.AllowAddNew = False
            tdbStorageInput.AllowUpdate = False
            tdbStorageInput.AllowDelete = False
            SetToolBar ("1100X01X111X111X1")
        Case modadd
            Me.Caption = "盘点信息录入——新增"
    
            setTxtWritable ("10")
    
            tdbStorageInput.AllowAddNew = False
            tdbStorageInput.AllowUpdate = True
            tdbStorageInput.AllowDelete = False
            SetToolBar ("0011X00X001X111X1")
        Case modEdit
            Me.Caption = "盘点信息录入——修改"
            setTxtWritable ("10")

            tdbStorageInput.AllowAddNew = False
            tdbStorageInput.AllowUpdate = True
            tdbStorageInput.AllowDelete = False
            SetToolBar ("0011X00X001X111X1")
    End Select

End Sub

Private Sub clearAll()          '清除所有可填数据的位置
    Dim i As Integer
    
    For i = 0 To txtFields.UBound
        txtFields(i).Text = ""
    Next i
    
    x.ReDim 0, -1, 0, 7
    tdbStorageInput.ReBind

End Sub

Private Sub setTxtWritable(strIn As String)     '设置各文本框的可写属性
    Dim i As Integer
    
    For i = 0 To txtFields.UBound
        If Mid(strIn, i + 1, 1) = 1 Then
            txtFields(i).Locked = False
            txtFields(i).BackColor = RGB(255, 255, 255)
        Else
            txtFields(i).Locked = True
            txtFields(i).BackColor = gColor_LockedText
        End If
    Next i
End Sub

'--------------------------------------------------------------------------------
'功能：    设置TDBGRID列的属性 如对齐方式、是否锁定、背景色等

'参数说明：

'          intCol           列号
'          intAlignment     对齐方式  0 左对齐    1 右对齐    2 居中（默认为2）
'          blnLock          是否锁定列  TRUE 锁定  FALSE 可编辑 （默认为FALSE）
'          strBackColor     列背景色  默认为白色
'          blnVisible       是否可见

'返回值：  ()
'--------------------------------------------------------------------------------
Private Sub SetTdbGridStatus(ByVal intCol As Integer, Optional intAlignment = 2, _
                            Optional blnlock = False, Optional strBackColor = vbWhite, Optional blnVisible = True)
  On Error Resume Next

    
  tdbStorageInput.Columns(intCol).Locked = blnlock
  tdbStorageInput.Columns(intCol).Alignment = intAlignment
  tdbStorageInput.Columns(intCol).BackColor = strBackColor
  tdbStorageInput.Columns(intCol).Visible = blnVisible
End Sub

Private Sub tdbStorageInput_HeadClick(ByVal ColIndex As Integer)
  Select Case tdbStorageInput.Columns(ColIndex).Caption
    Case "书号"
      If blnOrder(1) Then
         x.QuickSort 0, x.UpperBound(1), 1, XORDER_ASCEND, XTYPE_STRING
         blnOrder(1) = False
      Else
         x.QuickSort 0, x.UpperBound(1), 1, XORDER_DESCEND, XTYPE_STRING
         blnOrder(1) = True
      End If
    Case "书名"
      If blnOrder(2) Then
         x.QuickSort 0, x.UpperBound(1), 2, XORDER_ASCEND, XTYPE_STRING
         blnOrder(2) = False
      Else
         x.QuickSort 0, x.UpperBound(1), 2, XORDER_DESCEND, XTYPE_STRING
         blnOrder(2) = True
      End If
      
    Case "数量"
      If blnOrder(4) Then
         x.QuickSort 0, x.UpperBound(1), 4, XORDER_ASCEND, XTYPE_INTEGER
         blnOrder(4) = False
      Else
         x.QuickSort 0, x.UpperBound(1), 4, XORDER_DESCEND, XTYPE_INTEGER
         blnOrder(4) = True
      End If
      
    Case "图书类型"
      If blnOrder(5) Then
         x.QuickSort 0, x.UpperBound(1), 5, XORDER_ASCEND, XTYPE_STRING
         blnOrder(5) = False
      Else
         x.QuickSort 0, x.UpperBound(1), 5, XORDER_DESCEND, XTYPE_STRING
         blnOrder(5) = True
      End If
      
    Case "出版社"
      If blnOrder(6) Then
         x.QuickSort 0, x.UpperBound(1), 6, XORDER_ASCEND, XTYPE_STRING
         blnOrder(6) = False
      Else
         x.QuickSort 0, x.UpperBound(1), 6, XORDER_DESCEND, XTYPE_STRING
         blnOrder(6) = True
      End If
      
    Case "供货商"
      If blnOrder(7) Then
         x.QuickSort 0, x.UpperBound(1), 7, XORDER_ASCEND, XTYPE_STRING
         blnOrder(7) = False
      Else
         x.QuickSort 0, x.UpperBound(1), 7, XORDER_DESCEND, XTYPE_STRING
         blnOrder(7) = True
      End If
      
  End Select
  tdbStorageInput.ReBind
End Sub

Private Sub tdbStorageInput_KeyPress(KeyAscii As Integer)
  '限制输入条件必须为数字或某些特殊字符
    Select Case tdbStorageInput.Col
      Case 4 '数量
        KeyAscii = ValiText(KeyAscii, vbExpInteger, "", tdbStorageInput.Columns(tdbStorageInput.Col).Text)
      Case Else
        Exit Sub
    End Select
End Sub


Private Sub TxtFields_Change(Index As Integer)
  Dim sqlstring As String
  Dim rstmp As New ADODB.Recordset
  
  On Error GoTo err
  Select Case Index
    Case 0
      sqlstring = "select * from StorageSection where chrStorageNo='" & Trim(txtFields(0)) & "'"
      rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
      If Not rstmp.EOF Then
        txtFields(1).Text = rstmp.Fields("chrStorageName").Value
      Else
        txtFields(1).Text = ""
      End If
      
  End Select
  
  Exit Sub
err:
  MsgBox err.Description, vbInformation
End Sub