frmbookinputl.frm

通用书店管理系统

'      End If
'  Next
  
  '填入制品类型内容
'  Set rstmp = New ADODB.Recordset
'  sqlstring = "select * from ProduceType order by chrProduceType"
'
'  rstmp.Open sqlstring, cN, adOpenForwardOnly, adLockReadOnly
'
'  Do While Not rstmp.EOF
'     cmbType(0).AddItem Trim(rstmp.Fields("chrProduceType").Value)
'     rstmp.MoveNext
'  Loop
'  rstmp.Close
  
  
  '填入图书类型内容
'  Set rstmp = New ADODB.Recordset
'  sqlstring = "select * from BookType order by chrBookType "
'
'  rstmp.Open sqlstring, cN, adOpenForwardOnly, adLockReadOnly
'
'  Do While Not rstmp.EOF
'     cmbType(1).AddItem Trim(rstmp.Fields("chrBookType").Value)
'     rstmp.MoveNext
'  Loop
'  rstmp.Close
  
  
'  '填入出版社内容
'  Set rstmp = New ADODB.Recordset
'  sqlstring = "select * from PublishingCompanyData  order by chrCompanyName"
'
'  rstmp.Open sqlstring, cN, adOpenForwardOnly, adLockReadOnly
'
'  Do While Not rstmp.EOF
'     cmbType(2).AddItem Trim(rstmp.Fields("chrCompanyName").Value)
'     rstmp.MoveNext
'  Loop
'  rstmp.Close
'
'  '填入供应商内容
'  Set rstmp = New ADODB.Recordset
'  sqlstring = "select chrClientNo,ChrClientName from ClientData where intFlag=0 order by chrClientName "
'
'  rstmp.Open sqlstring, cN, adOpenForwardOnly, adLockReadOnly
'
'  Do While Not rstmp.EOF
'     cmbType(5).AddItem Trim(rstmp.Fields("chrClientNo")) & " " & Trim(rstmp.Fields("chrClientName"))
'     rstmp.MoveNext
'  Loop
'  rstmp.Close

  Exit Sub
err:
  MsgBox "初始化失败：" & err.Description
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set rstmp = Nothing
    If Trim(txtFields(2).Text) <> "" Then
        SaveLastInfo "software\" & App.CompanyName & "\" & App.ProductName & "\图书资料管理", "制品类型", Trim(txtFields(2).Text)
    End If
    If Trim(txtFields(3).Text) <> "" Then
        SaveLastInfo "software\" & App.CompanyName & "\" & App.ProductName & "\图书资料管理", "图书类型", Trim(txtFields(3).Text)
    End If

End Sub

Private Sub txtFields_DblClick(Index As Integer)
    Select Case Index
'    Case 2, 3, 5, 7, 8, 11:
    Case 2, 3, 5, 7, 8, 11:
        Comm_txtFields_Validate Index, True
    Case Else:
    End Select

End Sub

Private Sub txtFields_GotFocus(Index As Integer)
    txtFields(Index).SelStart = 0
    txtFields(Index).SelLength = Len(Trim(txtFields(Index)))
End Sub

Private Sub txtFields_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyF2 Then
        Select Case Index
    '    Case 2, 3, 5, 7, 8, 11:
        Case 2, 3, 5, 7, 8, 11:
            Comm_txtFields_Validate Index, True
        Case Else:
        End Select
        Exit Sub
    End If
End Sub

Private Sub txtFields_KeyPress(Index As Integer, KeyAscii As Integer)
  Select Case Index
'    Case 0
'      KeyAscii = ValiText(KeyAscii, vbExpChar, "0123456789", txtFields(Index).Text, 13)
'    Case 3
'      KeyAscii = ValiText(KeyAscii, vbExpDate, "", txtFields(Index).Text)
    Case 9, 10
      KeyAscii = ValiText(KeyAscii, vbExpDecimal, "", txtFields(Index).Text)
    Case Else
      Exit Sub
  End Select
End Sub

Private Sub ReSet()
    Dim i As Integer
    For i = 0 To 1
        txtFields(i).Text = ""
        txtFields(i).Tag = ""
    Next i
    For i = 3 To 12
        txtFields(i).Text = ""
        txtFields(i).Tag = ""
    Next i
    
End Sub

Private Sub Comm_txtFields_Validate(ByVal Index As Integer, ByVal blnSearch As Boolean)
    Dim intFlag As Integer ' 选择标志 0：文本框等于代码，1：文本框等于名称，2：文本框等于名称，存盘使用代码。
    Dim strSQL As String, strQuery As String
    Dim blnAllowEmpty As Boolean    ' 文本框是否允许为空
    Dim blnAllowCreate As Boolean   ' 文本框代码是否允许新建
    Dim strSelect1 As String, strSelect2 As String, strSelectCon As String
    Dim strTableName As String
    Dim strColName As String
    Dim strLabel1 As String
    Dim strLabel2 As String
                 
    Dim strResult As String
    Dim arrQuery
    Dim st As ADODB.Recordset
    
    On Error GoTo err
    
    
    strResult = "0,1"
    blnAllowCreate = True
    Select Case Index
    Case 2:                     ' 制品类型
        strSelect1 = "类型编码|类型名称"
        strSelect2 = "select ChrProduceNo,ChrProduceType from ProduceType "
        strSelectCon = "select ChrProduceNo,ChrProduceType from ProduceType" _
            & " where ChrProduceNo like '%" & txtFields(Index).Text & "%'" _
            & " or ChrProduceType like '%" & txtFields(Index).Text & "%'"
        'strResult = "1"
        intFlag = 1
        blnAllowEmpty = False
        strTableName = "ProduceType"
        strColName = "ChrProduceNo"
        strLabel1 = "制品编号："
        strLabel2 = "制品名称："
    Case 3:                         ' 图书类型
        strSelect1 = "图书类型编号|图书类型编号名称"
        strSelect2 = "select ChrBookTypeNo,ChrBookType from BookType "
        strSelectCon = "select ChrBookTypeNo,ChrBookType from BookType" _
            & " where ChrBookTypeNo like '%" & txtFields(Index).Text & "%'" _
            & " or ChrBookType like '%" & txtFields(Index).Text & "%'"
        'strResult = "1"
        intFlag = 1
        blnAllowEmpty = False
        strTableName = "BookType"
        strColName = "ChrBookTypeNo"
        strLabel1 = "图书类型编号"
        strLabel2 = "图书类型名称"
    
    Case 5:                         ' 出版社
        strSelect1 = "出版社编码|出版社名称"
        strSelect2 = "select chrCompanyNo,ChrCompanyName from PublishingCompanyData "
        strSelectCon = "select chrCompanyNo,ChrCompanyName from PublishingCompanyData" _
            & " where chrCompanyNo like '%" & txtFields(Index).Text & "%'" _
            & " or ChrCompanyName like '%" & txtFields(Index).Text & "%'"
        'strResult = "1"
        intFlag = 2
        blnAllowEmpty = True
        strTableName = "PublishingCompanyData"
        strColName = "chrCompanyNo"
        strLabel1 = "出版社编号"
        strLabel2 = "出版社名称"
    Case 7:                         ' 开本
        strResult = "0"
        strSelect1 = "开本名称"
        strSelect2 = "select '64' as  ChrFormat from BookData Union select '16' as  ChrFormat from BookData Union select '大32' as  ChrFormat from BookData " & _
                   "  Union select '32' as  ChrFormat from BookData "
        strSelectCon = "select ChrFormat from (" & strSelect2 & ")" _
            & " where ChrFormat like '%" & txtFields(Index).Text & "%'"
            
        intFlag = 0
        blnAllowCreate = False
        blnAllowEmpty = True
'        strTableName = "PublishingCompanyData"
'        strColName = "chrCompanyNo"
'        strLabel1 = "开本编号"
'        strLabel2 = "开本名称"
    Case 8:                         ' 开本
        strResult = "0"
        strSelect1 = "装订方式"
        strSelect2 = "select '精装' as  chrBindMode from BookData Union select '平装' as  chrBindMode from BookData "
        strSelectCon = "select chrBindMode from (" & strSelect2 & ")" _
            & " where chrBindMode like '%" & txtFields(Index).Text & "%'"
        intFlag = 0
        blnAllowCreate = False
        blnAllowEmpty = True
    Case 11:                         ' 供应商
        strResult = "0,1"
        strSelect1 = "供应商代码|供应商名称|联系人|    地    址    |电  话|业务员"
        strSelect2 = "select chrClientNo,ChrClientName,ChrLinkman,ChrAddress,ChrPhoneCode,ChrMissionary from ClientData" & " where intFlag=0"
        strSelectCon = "select chrClientNo,ChrClientName,ChrLinkman,ChrAddress,ChrPhoneCode,ChrMissionary from ClientData" _
            & " where intFlag=0 and" _
            & " chrClientNo like '%" & txtFields(Index).Text & "%'" _
            & " or ChrClientName like '%" & txtFields(Index).Text & "%'"
        intFlag = 2
        blnAllowCreate = True
        blnAllowEmpty = True
        strTableName = "ClientData"
        strColName = "chrClientNo"
        strLabel1 = "供应商代码"
        strLabel2 = "供应商名称"
        
    End Select
    
    If txtFields(Index).Text = "" Then
        If (Not blnSearch) And blnAllowEmpty Then err.Raise vbObjectError + 1111, , "正常"
        
        strQuery = g_CommonSelect(strSelect1, strSelect2, strResult, , , , -1, arrQuery)
        Select Case intFlag
        Case 0:
            If TypeName(arrQuery) = "Variant()" Then
                txtFields(Index).Text = arrQuery(0, 0)
            Else
                txtFields(Index).Text = ""
            End If
        Case 1, 2:
            If TypeName(arrQuery) = "Variant()" Then
                txtFields(Index).Text = arrQuery(0, 1)
                txtFields(Index).Tag = arrQuery(0, 0)
            Else
                txtFields(Index).Text = ""
                txtFields(Index).Tag = ""
            End If
        End Select
        
        err.Raise vbObjectError + 1111, , "正常"
    End If
    
    
'    Select Case Index
'    Case 2, 7, 8, 11:
'        strsql = "select ChrProduceNo,ChrProduceType from ProduceType" _
'            & " where ChrProduceNo like '%" & txtFields(Index).Text & "%'" _
'            & " or ChrProduceType like '%" & txtFields(Index).Text & "%'"
'        strResult = "1"
'    Case 3:
'        strsql = "select ChrBookTypeNo,ChrBookType from BookType" _
'            & " where ChrBookTypeNo like '%" & txtFields(Index).Text & "%'" _
'            & " or ChrBookType like '%" & txtFields(Index).Text & "%'"
'        strResult = "1"
'    Case 5:
'        strsql = "select chrCompanyNo,ChrCompanyName from PublishingCompanyData" _
'            & " where chrCompanyNo like '%" & txtFields(Index).Text & "%'" _
'            & " or ChrCompanyName like '%" & txtFields(Index).Text & "%'"
'        strResult = "1"
'    End Select
    
        Set st = New ADODB.Recordset
        strSQL = strSelectCon
        st.Open strSQL, cN, adOpenStatic, adLockReadOnly
        If st.Recordcount > 0 Then
            If st.Recordcount = 1 Then
                Select Case intFlag
                Case 0:
                    txtFields(Index).Text = st.Fields(0)
                Case 1, 2:
                    txtFields(Index).Text = st.Fields(1)
                    txtFields(Index).Tag = st.Fields(0)
                End Select
                
                err.Raise vbObjectError + 1111, , "正常"
            Else
                strQuery = g_CommonSelect(strSelect1, strSelectCon, strResult, , , , -1, arrQuery)
                Select Case intFlag
                Case 0:
                    If TypeName(arrQuery) = "Variant()" Then
                        txtFields(Index).Text = arrQuery(0, 0)
                    Else
                        txtFields(Index).Text = ""
                    End If
                Case 1, 2:
                    If TypeName(arrQuery) = "Variant()" Then
                        txtFields(Index).Text = arrQuery(0, 1)
                        txtFields(Index).Tag = arrQuery(0, 0)
                    Else
                        txtFields(Index).Text = ""
                        txtFields(Index).Tag = ""
                    End If
                End Select
    
            End If      ' recordcount=1
        Else
        
        If Not blnAllowCreate Then
            txtFields(Index).Text = ""
            txtFields(Index).Tag = ""
            err.Raise vbObjectError + 1111, , "正常"
        End If
        
            If MsgBox("该类型不存在！是否新增？", vbYesNo) = vbNo Then
                txtFields(Index).Text = ""
                txtFields(Index).Tag = ""
                err.Raise vbObjectError + 1111, , "正常"
            Else
                frmProductTypeL.strBeginString = Trim(txtFields(Index).Text)
                frmProductTypeL.strTableName = strTableName
                frmProductTypeL.strColName = strColName
                frmProductTypeL.Label1(0) = strLabel1
                frmProductTypeL.Label1(1) = strLabel2
                
                frmProductTypeL.Show vbModal
                If frmProductTypeL.blnOK Then
                    Select Case intFlag
                    Case 0:
                        txtFields(Index).Text = frmProductTypeL.strLastID
                    Case 1, 2:
                        txtFields(Index).Text = frmProductTypeL.strLastName
                        txtFields(Index).Tag = frmProductTypeL.strLastID
                    End Select

'                    Select Case Index
'                    Case 2, 7, 8, 11:
'                        txtFields(Index).Text = frmProductTypeL.strLastName
'                        txtFields(Index).Tag = frmProductTypeL.strLastID
'                    Case 3:
'                        txtFields(Index).Text = frmProductTypeL.strLastName
'                        txtFields(Index).Tag = frmProductTypeL.strLastID
'                    Case 5:
'                        txtFields(Index).Text = frmProductTypeL.strLastName
'                        txtFields(Index).Tag = frmProductTypeL.strLastID
'
'                    End Select
                Else
                    txtFields(Index).Text = ""
                    txtFields(Index).Tag = ""
                End If
                Unload frmProductTypeL
                err.Raise vbObjectError + 1111, , "正常"
            End If          'MsgBox("该类型不存在！是否新增？", vbYesNo)
        End If          ' recordcount>0
    'End Select
    err.Raise vbObjectError + 1111, , "正常"
    Exit Sub
err:
    If err.Description <> "正常" Then
        MsgBox err.Description
    Else
        Set st = Nothing
    End If
    Exit Sub
End Sub

Private Sub txtFields_Validate(Index As Integer, Cancel As Boolean)
    Select Case Index
'    Case 2, 3, 5, 7, 8, 11:
    Case 2, 3, 5, 7, 8, 11:
        Comm_txtFields_Validate Index, False
    Case Else:
    End Select
    
End Sub
'Private Sub clearAll()
'    X.ReDim 0, -1, 0, 10
'    frmBookInStorage.tdbBook.ReBind
'End Sub