frmbookinput.frm

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

      Caption         =   "出版日期"
      Height          =   255
      Index           =   6
      Left            =   90
      TabIndex        =   19
      Top             =   2655
      Width           =   975
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "出版社"
      Height          =   255
      Index           =   5
      Left            =   90
      TabIndex        =   18
      Top             =   2265
      Width           =   975
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "作者"
      Height          =   255
      Index           =   4
      Left            =   90
      TabIndex        =   17
      Top             =   1845
      Width           =   975
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "图书类型"
      Height          =   255
      Index           =   3
      Left            =   90
      TabIndex        =   16
      Top             =   1425
      Width           =   975
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "制品类型"
      Height          =   255
      Index           =   2
      Left            =   90
      TabIndex        =   15
      Top             =   1005
      Width           =   975
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "书名"
      Height          =   255
      Index           =   1
      Left            =   90
      TabIndex        =   14
      Top             =   555
      Width           =   975
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "书号"
      Height          =   255
      Index           =   0
      Left            =   90
      TabIndex        =   13
      Top             =   120
      Width           =   975
   End
End
Attribute VB_Name = "frmBookInput"
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
Public intRow As Integer 'TDBGRID的当前行号
Private Sub cmdAdd_Click(Index As Integer)
  On Error Resume Next
  
  Select Case Index
    Case 0
      frm编码维护.strTableName = "ProduceType"
      frm编码维护.Show 1
      
      cmbType(0).Clear
      
      '填入制品类型内容
      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
      
      
    Case 1
      frm编码维护.strTableName = "BookType"
      frm编码维护.Show 1
      
      cmbType(1).Clear
      '填入图书类型内容
      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
      
      
    Case 2
      frm编码维护.strTableName = "PublishingCompanyData"
      frm编码维护.Show 1
        
      cmbType(2).Clear
      
      '填入出版社内容
      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
    
      
    Case 3
      frm编码维护.strTableName = "ClientData"
      frm编码维护.Show 1
      
      cmbType(5).Clear
      
      '填入供应商内容
      Set rstmp = New ADODB.Recordset
      sqlstring = "select * 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("chrClientName").Value)
         rstmp.MoveNext
      Loop
      rstmp.Close
  End Select
End Sub

Private Sub cmdExit_Click()
  Unload Me
End Sub

Private Sub cmdSave_Click()
  Dim sqlstring As String
  Dim rsNewtmp As New ADODB.Recordset
  
  On Error GoTo Err
  
  If frmBook.intFormState = modadd Then
        sqlstring = "select * from BookData where chrBookNo='" & txtFields(0).Text & "' and chrBookName='" & txtFields(1).Text & "'"
        
        rsNewtmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        
        If rsNewtmp.EOF Then
          frmBook.tdbBook.Columns(0).Text = txtFields(0).Text
          frmBook.tdbBook.Columns(1).Text = txtFields(1).Text
          frmBook.tdbBook.Columns(2).Text = cmbType(0).Text
          frmBook.tdbBook.Columns(3).Text = cmbType(1).Text
          frmBook.tdbBook.Columns(4).Text = txtFields(2).Text
          frmBook.tdbBook.Columns(5).Text = cmbType(2).Text
          frmBook.tdbBook.Columns(6).Text = txtFields(3).Text
          frmBook.tdbBook.Columns(7).Text = txtFields(4).Text
          frmBook.tdbBook.Columns(8).Text = cmbType(3).Text
          frmBook.tdbBook.Columns(9).Text = cmbType(4).Text
          frmBook.tdbBook.Columns(10).Text = txtFields(5).Text
          frmBook.tdbBook.Columns(11).Text = txtFields(6).Text
          frmBook.tdbBook.Columns(12).Text = cmbType(5).Text
          frmBook.tdbBook.Columns(13).Text = txtFields(7).Text
          Unload Me
        Else
          
          MsgBox "图书资料表中已存在该书号的图书，请修改！"
          txtFields(0).SetFocus
          
        End If
  ElseIf frmBook.intFormState = modedit Then
        frmBook.tdbBook.Columns(0).Text = txtFields(0).Text
        frmBook.tdbBook.Columns(1).Text = txtFields(1).Text
        frmBook.tdbBook.Columns(2).Text = cmbType(0).Text
        frmBook.tdbBook.Columns(3).Text = cmbType(1).Text
        frmBook.tdbBook.Columns(4).Text = txtFields(2).Text
        frmBook.tdbBook.Columns(5).Text = cmbType(2).Text
        frmBook.tdbBook.Columns(6).Text = txtFields(3).Text
        frmBook.tdbBook.Columns(7).Text = txtFields(4).Text
        frmBook.tdbBook.Columns(8).Text = cmbType(3).Text
        frmBook.tdbBook.Columns(9).Text = cmbType(4).Text
        frmBook.tdbBook.Columns(10).Text = txtFields(5).Text
        frmBook.tdbBook.Columns(11).Text = txtFields(6).Text
        frmBook.tdbBook.Columns(12).Text = cmbType(5).Text
        frmBook.tdbBook.Columns(13).Text = txtFields(7).Text
        Unload Me
  Else
        Unload Me
  End If
  Exit Sub
Err:
  MsgBox "读取记录失败：" & Err.Description, vbInformation
End Sub



Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  Call autoreturn(KeyCode)
End Sub

Private Sub Form_Load()
  Dim i As Integer
  On Error GoTo Err
  
  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
  
  '清空所有下拉框
  For i = 0 To cmbType.Count - 1
      If i <> 3 And i <> 4 Then
        cmbType(i).Clear
      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 * 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("chrClientName").Value)
     rstmp.MoveNext
  Loop
  rstmp.Close

  Exit Sub
Err:
  MsgBox "初始化失败：" & Err.Description
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 5, 6
      KeyAscii = ValiText(KeyAscii, vbExpDecimal, "", txtFields(Index).Text)
    Case Else
      Exit Sub
  End Select
End Sub