frmbookinputl.frm

通用书店管理系统

      Index           =   4
      Left            =   90
      TabIndex        =   20
      Top             =   1845
      Width           =   975
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "图书类型"
      Height          =   255
      Index           =   3
      Left            =   90
      TabIndex        =   19
      Top             =   1425
      Width           =   975
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "制品类型"
      Height          =   255
      Index           =   2
      Left            =   90
      TabIndex        =   18
      Top             =   1005
      Width           =   975
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "书名"
      Height          =   255
      Index           =   1
      Left            =   90
      TabIndex        =   17
      Top             =   555
      Width           =   975
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "书号"
      Height          =   255
      Index           =   0
      Left            =   90
      TabIndex        =   16
      Top             =   120
      Width           =   975
   End
End
Attribute VB_Name = "frmBookInputL"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim sqlstring As String
Dim rstmp As New ADODB.Recordset

Dim X As New XArrayDB

Public intRow As Integer 'TDBGRID的当前行号
Public intStatus As Integer ' 状态 10-浏览，11-修改，12-新增
Public blnActOK As Boolean  ' 是否增加或修改成功
Public blnAddOne As Boolean  ' 增加一个记录后是否马上退出

' 进入前的图书信息，用于修改功能
Public strPreBookNo As String
Public strPreBookName As String

Private Sub cmdAdd_Click(Index As Integer)

End Sub


Private Sub cmdExit_Click()
  Me.Hide
  
'    Call clearAll
Exit Sub
'Unload Me
End Sub

Private Sub CmdSave_Click()
    Dim i As Integer
    Dim strSQL As String
    Dim strClientNo As String
    Dim rs As ADODB.Recordset
'    Dim rstmp As ADODB.Recordset
    Dim lngTran As Long
  
  
  lngTran = 0
  
  blnActOK = False
  
  On Error GoTo err
    If Trim(txtFields(0).Text) = "" Then
        txtFields(0).SetFocus
        Exit Sub
    End If
    If Trim(txtFields(1).Text) = "" Then
        txtFields(1).SetFocus
        Exit Sub
    End If
    If Trim(txtFields(9).Text) = "" Then       ' 折扣
        txtFields(9).SetFocus
        Exit Sub
    End If
    If Trim(txtFields(10).Text) = "" Then       ' 单价
        txtFields(10).SetFocus
        Exit Sub
    End If

    
'  i = InStr(1, cmbType(5).Text, " ")
'  If i > 0 Then strClientNo = Left(cmbType(5).Text, i - 1)
  
  If intStatus = 12 Then            ' 新增
        strSQL = "select * from BookData where chrBookNo='" & txtFields(0).Text & "' and chrBookName='" & txtFields(1).Text & "'"
        Set rs = New ADODB.Recordset
        rs.Open strSQL, cN, adOpenKeyset, adLockReadOnly
        
        If rs.EOF Then
        
            lngTran = cN.BeginTrans
            strSQL = "Insert into BookData " _
                & " (ChrBookNo,ChrBookName,chrProduceType,chrBookType,chrAuthoer,chrBookConcern,datPublishDate,chrDegree,chrFormat,chrBindMode,decAgio,decPrice,chrGHS,chrRemark) values " _
                & "('" & txtFields(0).Text & "','" & txtFields(1).Text & "','" & txtFields(2).Text & "','" & txtFields(3).Text & "','" & txtFields(4).Text & "','" & txtFields(5).Tag & "'," & "'" & Format(txtFields(13).Text, "yyyy-mm-dd") & "'" _
                & "," & "'" & txtFields(6).Text & "'" & "," & "'" & txtFields(7).Text & "'" & "," & "'" & txtFields(8).Text & "'" & "," & Format(txtFields(9).Text, "0.00") & "," & Format(txtFields(10).Text, "0.00") & ",'" & txtFields(11).Tag & _
                "'," & "'" & txtFields(12).Text & "'" & ")"
            Debug.Print strSQL
            cN.Execute (strSQL)
            cN.CommitTrans
            blnActOK = True
            If blnAddOne Then
                Me.Hide
                Exit Sub
            End If
            ReSet
        Else
          
            MsgBox "图书资料表中已存在该书号的图书，请修改！"
            txtFields(0).SetFocus
        End If  ' rs.EOF

        txtFields(9).Text = "1"     ' 默认折扣
        'txtFields(10).Text = "0"     ' 默认单价
        txtFields(0).SetFocus
        If blnAddOne Then Me.Hide
        Exit Sub
    End If    ' 12
  If intStatus = 11 Then            ' 修改
    
        strSQL = "select chrBookno,chrbookname from Bookstorage where chrBookNo='" & Me.strPreBookNo & "' and ChrBookName='" & Me.strPreBookName & "'"
        Set rs = New ADODB.Recordset
        rs.Open strSQL, cN, adOpenKeyset, adLockReadOnly
        If Not rs.EOF Then
           strSQL = "update bookstorage set chrBookNo='" & txtFields(0).Text & "',chrBookName='" & txtFields(1).Text & "'"
           strSQL = strSQL & "where chrBookNo='" & Me.strPreBookNo & "'" _
                    & " and ChrBookName='" & Me.strPreBookName & "'"
            cN.Execute (strSQL)
        End If
        
        strSQL = "select chrBookno,chrbookname from InstorageInformation_List where chrBookNo='" & Me.strPreBookNo & "' and ChrBookName='" & Me.strPreBookName & "'"
        Set rs = New ADODB.Recordset
        rs.Open strSQL, cN, adOpenKeyset, adLockReadOnly
        If Not rs.EOF Then
           strSQL = "update InstorageInformation_List set chrBookNo='" & txtFields(0).Text & "',chrBookName='" & txtFields(1).Text & "'"
           strSQL = strSQL & "where chrBookNo='" & Me.strPreBookNo & "'" _
                    & " and ChrBookName='" & Me.strPreBookName & "'"
            cN.Execute (strSQL)
        End If
        
        strSQL = "select chrBookno,chrbookname from OutstorageInformation_List where chrBookNo='" & Me.strPreBookNo & "' and ChrBookName='" & Me.strPreBookName & "'"
        Set rs = New ADODB.Recordset
        rs.Open strSQL, cN, adOpenKeyset, adLockReadOnly
        If Not rs.EOF Then
           strSQL = "update OutstorageInformation_List set chrBookNo='" & txtFields(0).Text & "',chrBookName='" & txtFields(1).Text & "'"
           strSQL = strSQL & "where chrBookNo='" & Me.strPreBookNo & "'" _
                    & " and ChrBookName='" & Me.strPreBookName & "'"
            cN.Execute (strSQL)
        End If
        
        lngTran = cN.BeginTrans
'        strSql = "Insert into BookData " _
'            & " (ChrBookNo,ChrBookName,chrProduceType,chrBookType,chrAuthoer,chrBookConcern,datPublishDate,chrDegree,chrFormat,chrBindMode,decAgio,decPrice,chrGHS,chrRemark) values " _
'            & "('" & txtFields(0).Text & "','" & txtFields(1).Text & "','" & txtFields(2).Text & "','" & txtFields(3).Text & "','" & txtFields(4).Text & "','" & txtFields(5).Tag & "'," & "'" & Format(DTP1.Value, "yyyy-mm-dd") & "'" _
'            & "," & "'" & txtFields(6).Text & "'" & "," & "'" & txtFields(7).Text & "'" & "," & "'" & txtFields(8).Text & "'" & "," & Format(txtFields(9).Text, "0.00") & "," & Format(txtFields(10).Text, "0.00") & ",'" & txtFields(11).Tag & _
'            "'," & "'" & txtFields(12).Text & "'" & ")"
        strSQL = "update BookData " _
            & " set ChrBookNo='" & txtFields(0).Text & "'" _
            & ",ChrBookName='" & txtFields(1).Text & "'" _
            & ",chrProduceType='" & txtFields(2).Text & " '" _
            & ",chrBookType='" & txtFields(3).Text & "'" _
            & ",chrAuthoer='" & txtFields(4).Text & "'" _
            & ",chrBookConcern='" & txtFields(5).Tag & "'" _
            & ",datPublishDate=" & Format(txtFields(13).Text, "yyyy-mm-dd") & "" _
            & ",chrDegree='" & txtFields(6).Text & "'" _
            & ",chrFormat='" & txtFields(7).Text & "'" _
            & ",chrBindMode='" & txtFields(8).Text & "'" _
            & ",decAgio=" & Format(txtFields(9).Text, "0.00") _
            & ",decPrice=" & Format(txtFields(10).Text, "0.00") _
            & ",chrGHS='" & txtFields(11).Tag & "'" _
            & ",chrRemark='" & txtFields(12).Text & "'"
        strSQL = strSQL & "where chrBookNo='" & Me.strPreBookNo & "'" _
            & " and ChrBookName='" & Me.strPreBookName & "'"
        
        Debug.Print strSQL
        cN.Execute (strSQL)
        cN.CommitTrans
        blnActOK = True
        ReSet

        txtFields(0).SetFocus
        Me.Hide
        Exit Sub
    End If    ' 11
        
  Exit Sub
err:
    If lngTran > 0 Then cN.RollbackTrans
    MsgBox "操作数据库记录失败，请检查图书资料是否输入完整。" & err.Description, vbInformation
    Exit Sub
End Sub



Private Sub cmdSearch_Click(Index As Integer)
'  Dim strQuery As String
'  Dim arrQuery
'
'  Select Case Index
'    Case 0
'        If InStr(1, strCtlName, "text_have_validate") > 0 _
'            And InStr(1, strCtlName, " 8 ") > 0 Then Exit Sub
'
'        'My_txtFields_Validate 8
'        strQuery = g_CommonSelect("类型编码|类型名称", "select ChrProduceNo,ChrProduceType from ProduceType ", 1)
'        txtFields(8).Text = strQuery
'        txtFields(8).SetFocus
''        Debug.Print "5"
'    Case 1
'        '
'    Case 2
'  End Select
'
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Debug.Print KeyCode
    If KeyCode = vbKeyReturn Then
        SendKeys "{TAB}"
        Exit Sub
    End If
      If KeyCode = vbKeyUp Then
        Debug.Print "now send shift+tab"
        SendKeys "+{TAB}"
        Exit Sub
    End If
    If KeyCode = vbKeyDown Then
        SendKeys "{TAB}"
        Exit Sub
    End If
    
'    If (vbCtrlMask And Shift) > 0 And KeyCode = vbKeyF2 Then
'        frmHideFun.Show vbModal
'    End If
'
    
    ' 隐藏功能 根据图书资料更新出版社代码表，同时修改图书资料中的出版社（名称-》代号）
  
'    If (vbCtrlMask And Shift) > 0 And KeyCode = vbKeyF2 Then
'        Dim st As ADODB.Recordset
'        Dim SS As String
'        Dim intB As Integer
'
'        On Error GoTo Err
'
'        cN.BeginTrans
'
'        intB = 300
'
'        Set st = New ADODB.Recordset
'        SS = "select distinct Chrbookconcern from (SELECT chrbookno, chrbookname, Chrbookconcern, chrCompanyNo, ChrCompanyName" _
'            & " FROM bookdata left JOIN PublishingCompanyData ON bookdata.Chrbookconcern=PublishingCompanyData.ChrCompanyName" _
'            & " where trim(Chrbookconcern)<>'' and ChrCompanyName is NULL)"
'        st.Open SS, cN, adOpenStatic, adLockReadOnly
'        Do While Not st.EOF
'            If DBLen(Trim(st.Fields(0))) <> Len(Trim(st.Fields(0))) Then ' 是中文名称
'                SS = "insert into PublishingCompanyData (chrCompanyNo,ChrCompanyName,ChrBenelux) values ( " _
'                    & "'" & intB & "'," & "'" & st.Fields(0) & "','" & st.Fields(0) & "'" & ")"
'                cN.Execute SS
'                intB = intB + 1
'            End If
'            st.MoveNext
'        Loop
'
'        st.Close
'        SS = "SELECT chrbookno, chrbookname, Chrbookconcern, chrCompanyNo, ChrCompanyName" _
'            & " FROM bookdata INNER JOIN PublishingCompanyData ON bookdata.Chrbookconcern=PublishingCompanyData.ChrCompanyName"
'        st.Open SS, cN, adOpenStatic, adLockReadOnly
'        Do While Not st.EOF
'            SS = "update bookdata set Chrbookconcern='" & st.Fields("chrCompanyNo") & "'" _
'                & " where chrbookno='" & st.Fields("chrbookno") & "'" _
'                & " and chrbookname='" & st.Fields("chrbookname") & "'"
'            cN.Execute SS
'            st.MoveNext
'        Loop
'        cN.CommitTrans
'        Exit Sub
'    End If
    
'    Exit Sub
'Err:
'    cN.RollbackTrans
'    MsgBox Err.Description
'    Exit Sub
End Sub

Private Sub Form_Load()
    Dim i As Integer
    On Error GoTo err
    
    Me.KeyPreview = True
    
    If intStatus < 10 Then intStatus = 10 ' 浏览状态
    
    ' 设置长日期格式
'    DTP1.Format = dtpCustom
'    DTP1.CustomFormat = "yyyy-mm-dd"
    
    If intStatus = 12 Then      ' 新增
        txtFields(13).Text = Format(Date, "yyyy-mm-dd")
        txtFields(9).Text = "1" ' 折扣默认为1
    End If
'  Select Case frmBook.intFormState
'    Case modadd
'
'    Case modedit
'      txtFields(0).Enabled = False
'      txtFields(1).Enabled = False
'
'    Case Else
'      For i = 0 To 7
'        txtFields(i).Enabled = False
'        If i <= 5 Then
'          cmbType(i).Enabled = False
'          If i <= 3 Then
'             cmdAdd(i).Enabled = False
'          End If
'        End If
'      Next i
'      Exit Sub
'  End Select
'  Select Case intStatus
'    Case 12
'
'    Case 11
'      txtFields(0).Enabled = False
'      txtFields(1).Enabled = False
'
'    Case Else
''      For i = 0 To 7
''        txtFields(i).Enabled = False
''        If i <= 5 Then
''          cmbType(i).Enabled = False
''          If i <= 3 Then
''             cmdAdd(i).Enabled = False
''          End If
''        End If
''      Next i
'      Exit Sub
'  End Select
  
'  '清空所有下拉框
'  For i = 0 To cmbType.Count - 1
'      If i <> 3 And i <> 4 Then
'        cmbType(i).Clear