frmstorageinputinformation.frm

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

            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   405
         Index           =   0
         Left            =   4860
         TabIndex        =   1
         Top             =   240
         Width           =   3630
      End
      Begin VB.Label Label1 
         Caption         =   "书号："
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   11.25
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   345
         Index           =   1
         Left            =   4140
         TabIndex        =   8
         Top             =   300
         Width           =   720
      End
      Begin VB.Label Label1 
         Caption         =   "库区号："
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   11.25
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   285
         Index           =   0
         Left            =   720
         TabIndex        =   7
         Top             =   300
         Width           =   900
      End
   End
End
Attribute VB_Name = "frmStorageInputInformation"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim intFormState As Integer     '标示窗体的状态，“正常/浏览/新增/编辑”
Dim blnIsModified As Boolean   '是否有输入或修改数据     True for changed
'Public blnAddNew As Boolean

Private Sub cmdExit_Click(Index As Integer)
  Unload Me
End Sub
Public Sub cmdCancel_Click()
  Unload Me
End Sub


Private Sub CmdSave_Click()
  Dim sqlstring As String
  Dim rstmp As New ADODB.Recordset
  Dim strcx As String
  Dim i As Integer
 
  On Error GoTo SaveErr
  
  If frmBookType.blnAddNew Then
     If Trim(txtFields(0).Text) = "" Or Trim(txtFields(1).Text) = "" Or Trim(txtFields(5).Text) = "" Then
       MsgBox "编码、名称、数量不能为空！", vbInformation
       Exit Sub
     End If
     
     If CheckExist Then
        MsgBox "此图书已存在，请修改。", vbInformation + vbOKOnly
        Call setselect(txtFields(0))
        Exit Sub
     End If
     
     sqlstring = "Insert into BookStorage (IntAmount) values (" & CInt(txtFields(5).Text) & ") "
     cN.BeginTrans
     cN.Execute (sqlstring)
     cN.CommitTrans

  Else
     If Trim(txtFields(0).Text) = "" Or Trim(txtFields(1).Text) = "" Or Trim(txtFields(5).Text) = "" Then
       MsgBox "编码、名称、数量不能为空！", vbInformation
       Exit Sub
     End If
      sqlstring = "select ChrStorageNo,ChrStorageName from StorageSection where ChrStorageName='" & cmbFields(0).Text & "'"
      Set rstmp = New ADODB.Recordset
      rstmp.Open sqlstring, cN, adOpenStatic, adLockBatchOptimistic
      
      If rstmp.EOF Then Exit Sub
      strcx = rstmp.Fields("ChrStorageNo").Value
      
      sqlstring = "Update BookStorage  set IntAmount='" & CInt(txtFields(5).Text) & "' where ChrBookNo='" & Trim(txtFields(0).Text) & "' and ChrBookName='" & Trim(txtFields(1).Text) & "' and ChrStorageNo='" & strcx & "'"

     cN.BeginTrans
     cN.Execute (sqlstring)
     cN.CommitTrans
     Call clearAll
     txtFields(0).SetFocus
  End If
     
  Exit Sub
SaveErr:
  cN.RollbackTrans
  MsgBox "保存记录失败：" & err.Description, vbInformation
End Sub


Private Sub cmdSearch_Click(Index As Integer)
  Dim strQuery As String
  Dim strSQL As String
  Dim arrQuery As Variant
  
  If cmbFields(0).Text = "" Then
     MsgBox "请输入库区号！", vbInformation
     Exit Sub
  End If
  
  Select Case Index
    Case 0

        
        strSQL = "select distinct t1.ChrBookNo, t1.ChrBookName, t1.ChrBookType, t4.ChrCompanyName, t1.ChrGHS,t3.intamount " & _
                 "from (( BookData t1 left JOIN bookStorage t3 ON t1.ChrBookNo=t3.ChrBookNo and t1.ChrBookName=t3.ChrBookName) left JOIN StorageSection t2 ON " & _
                 "t2.ChrStorageNo=t3.ChrStorageNo) left JOIN  PublishingCompanyData t4 ON t1.Chrbookconcern=t4.ChrCompanyNo where " & _
                 "t2.ChrStorageName = '" & cmbFields(0).Text & "' order by  t1.ChrBookNo"
        g_CommonSelect " 书号   |    书名   |  图书类型  |  出版社  |  供货商  |  数量  ", strSQL, "0,1,2,3,4,5", , , , , arrQuery

        If TypeName(arrQuery) = "Variant()" Then
             txtFields(0).Text = IIf(IsNull(arrQuery(0, 0)), "", arrQuery(0, 0))
             txtFields(1).Text = IIf(IsNull(arrQuery(0, 1)), "", arrQuery(0, 1))
             txtFields(2).Text = IIf(IsNull(arrQuery(0, 2)), "", arrQuery(0, 2))
             txtFields(3).Text = IIf(IsNull(arrQuery(0, 3)), "", arrQuery(0, 3))
             txtFields(4).Text = IIf(IsNull(arrQuery(0, 4)), "", arrQuery(0, 4))
             txtFields(5).Text = IIf(IsNull(arrQuery(0, 5)), "", arrQuery(0, 5))
            
        End If
   End Select
End Sub


Private Sub Form_Load()
Dim sqlstring As String
Dim rsNewTmp As New ADODB.Recordset

'库区名称
    sqlstring = "select  * from StorageSection order by ChrStorageNo"
        rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        cmbFields(0).Text = Trim(rsNewTmp("ChrStorageName").Value)
        Do While Not rsNewTmp.EOF
          cmbFields(0).AddItem Trim(rsNewTmp("ChrStorageName").Value)
          rsNewTmp.MoveNext
        Loop
        
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  Call autoreturn(KeyCode)
End Sub
Private Function CheckExist() As Boolean
  Dim sqlstring As String
  Dim rstmp As New ADODB.Recordset
  On Error GoTo err
  
  sqlstring = "select * from BookStorage where chrBookNo='" & Trim(txtFields(0).Text) & "' and chrBookName='" & Trim(txtFields(1).Text) & "'"
  rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
  If rstmp.EOF Then
    CheckExist = False
  Else
    CheckExist = True
  End If
  
  Exit Function
err:
  MsgBox "打开记录失败：" & err.Description, vbInformation
End Function
Private Sub clearAll()          '清除所有可填数据的位置
    Dim i As Integer
    
    For i = 0 To txtFields.UBound
        Select Case i
          Case 0, 1, 2, 3, 4, 5 '书号、书名、图书类型、出版社、供货商、数量
              txtFields(i).Text = ""
        End Select
    Next i
    
End Sub
Private Sub txtFields_KeyPress(Index As Integer, KeyAscii As Integer)
  Select Case Index
    Case 0
'      KeyAscii = ValiText(KeyAscii, vbExpInteger, "", txtFields(Index).Text)
    Case 5
      KeyAscii = ValiText(KeyAscii, vbExpDecimal, "", txtFields(Index).Text)
  End Select
End Sub
Private Sub txtFields_GotFocus(Index As Integer)
'    If Index = 1 Or Index = 2 Then
'        txtFields(Index).SelStart = 0
'        txtFields(Index).SelLength = 20
'    End If
End Sub

Private Sub txtFields_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        If Index = 1 Then
            CmdSave_Click
            Exit Sub
        End If
        SendKeys "{TAB}"
    End If
End Sub

Private Sub txtFields_Validate(Index As Integer, Cancel As Boolean)
    Dim sqlstring As String
    Dim arrQuery As Variant
    Dim rstmp As New ADODB.Recordset
    
    Select Case Index:
        Case 0:
            Debug.Print "validate" & txtFields(0).Text

            If txtFields(0).Text <> "" Then
                sqlstring = "select t1.ChrBookNo, t1.ChrBookName, t1.ChrBookType, t4.ChrCompanyName, t1.ChrGHS,t3.intamount " & _
                            "from (( BookData t1 left JOIN bookStorage t3 ON t1.ChrBookNo=t3.ChrBookNo) left JOIN StorageSection t2 ON " & _
                            "t2.ChrStorageNo=t3.ChrStorageNo) left JOIN  PublishingCompanyData t4 ON t1.Chrbookconcern=t4.ChrCompanyNo where  t1.ChrbookNo='" & Trim(txtFields(0).Text) & "' and t2.ChrStorageName='" & Trim(cmbFields(0).Text) & "' "
                Set rstmp = New ADODB.Recordset
                rstmp.Open sqlstring, cN, adOpenStatic, adLockReadOnly
                If rstmp.Recordcount = 0 Then
                    MsgBox "书号不存在！"
                    Cancel = True
                    Set rstmp = Nothing
                    Call clearAll
                    Exit Sub
                Else
                    If rstmp.Recordcount > 1 Then
                         strSQL = "select distinct t1.ChrBookNo, t1.ChrBookName, t1.ChrBookType, t4.ChrCompanyName, t1.ChrGHS,t3.intamount " & _
                                    "from (( BookData t1 left JOIN bookStorage t3 ON t1.ChrBookNo=t3.ChrBookNo and t1.ChrBookName=t3.ChrBookName) left JOIN StorageSection t2 ON " & _
                                    "t2.ChrStorageNo=t3.ChrStorageNo) left JOIN  PublishingCompanyData t4 ON t1.Chrbookconcern=t4.ChrCompanyNo where " & _
                                    "t2.ChrStorageName = '" & cmbFields(0).Text & "' and t3.ChrBookNo='" & txtFields(0).Text & "' order by  t1.ChrBookNo"
                        g_CommonSelect " 书号   |    书名   |  图书类型  |  出版社  |  供货商  |  数量  ", strSQL, "0,1,2,3,4,5", , , , , arrQuery

                        If TypeName(arrQuery) = "Variant()" Then
                             txtFields(0).Text = IIf(IsNull(arrQuery(0, 0)), "", arrQuery(0, 0))
                             txtFields(1).Text = IIf(IsNull(arrQuery(0, 1)), "", arrQuery(0, 1))
                             txtFields(2).Text = IIf(IsNull(arrQuery(0, 2)), "", arrQuery(0, 2))
                             txtFields(3).Text = IIf(IsNull(arrQuery(0, 3)), "", arrQuery(0, 3))
                             txtFields(4).Text = IIf(IsNull(arrQuery(0, 4)), "", arrQuery(0, 4))
                             txtFields(5).Text = IIf(IsNull(arrQuery(0, 5)), "", arrQuery(0, 5))
                        End If
                        Exit Sub
                    End If
                
                End If
                txtFields(1).Text = rstmp.Fields("ChrbookName")
                txtFields(2).Text = rstmp.Fields("ChrBookType")
                txtFields(3).Text = IIf(IsNull(rstmp.Fields("ChrCompanyName").Value), "", rstmp.Fields("chrCompanyName").Value)
                txtFields(4).Text = IIf(IsNull(rstmp.Fields("ChrGHS").Value), "", rstmp.Fields("ChrGHS").Value)
                txtFields(5).Text = rstmp.Fields("intamount")
               
                
                
                Set rstmp = Nothing
      End If
      End Select
End Sub
Private Sub Form_Activate()
  SetToolBar ("0000X00X001X111")
End Sub