frmbookspricediscount.frm

通用书店管理系统

      Caption         =   "结束日期"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   2880
      TabIndex        =   14
      Top             =   1080
      Width           =   975
   End
   Begin VB.Label Label4 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00C0E0FF&
      Caption         =   "起始日期"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   0
      TabIndex        =   13
      Top             =   1080
      Width           =   975
   End
   Begin VB.Label Label3 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00C0E0FF&
      Caption         =   "单价"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   3525
      TabIndex        =   12
      Top             =   120
      Width           =   855
   End
   Begin VB.Label Label2 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00C0E0FF&
      Caption         =   "书名"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   0
      TabIndex        =   11
      Top             =   600
      Width           =   855
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00C0E0FF&
      Caption         =   "书号"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   0
      TabIndex        =   10
      Top             =   120
      Width           =   855
   End
End
Attribute VB_Name = "frmBooksPriceDiscount"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public strPrimaryKey As String
Public blnAddNew As Boolean

Private Sub cmdExit_Click()
  Unload Me
End Sub

Private Sub CmdSave_Click()
  Dim sqlstring As String
  Dim rstmp As New ADODB.Recordset
  On Error GoTo SaveErr
  
  If blnAddNew Then
     If Trim(txtFields(0).Text) = "" Or Trim(txtFields(1).Text) = "" Or Trim(txtFields(2).Text) = "" Or Trim(txtFields(3).Text) = "" Or Trim(txtFields(4).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 BooksPriceDiscount (ChrBookNo,ChrBookName,DatInceptDate,DatEndDate,DecPrice," & _
                 "ChrRetailFrame,DecRetailPrice,DecTradeDiscount,DecTradePrice) values ('" & txtFields(0).Text & "','" & txtFields(1).Text & _
                 "',#" & txtFields(2).Text & "#,#" & txtFields(3).Text & "#," & CDbl(txtFields(4).Text) & ",'" & _
                 txtFields(5).Text & "'," & CDbl(txtFields(6).Text) & "," & CDbl(txtFields(7).Text) & "," & CDbl(txtFields(8).Text) & ")"
     cN.BeginTrans
     cN.Execute (sqlstring)
     cN.CommitTrans
     Unload Me
     Call frmFields.cmdRefresh_Click
  Else
     If Trim(txtFields(0).Text) = "" Or Trim(txtFields(1).Text) = "" Or Trim(txtFields(2).Text) = "" Or Trim(txtFields(3).Text) = "" Or Trim(txtFields(4).Text) = "" Then
       MsgBox "编码、名称不能为空！", vbInformation
       Exit Sub
     End If
     
     sqlstring = "Update BooksPriceDiscount set ChrBookName='" & txtFields(1).Text & "'," & _
                 " DatInceptDate=#" & txtFields(2).Text & "#,DatEndDate=#" & txtFields(3).Text & _
                 "#,DecPrice=" & CDbl(txtFields(4).Text) & ",ChrRetailFrame='" & txtFields(5).Text & _
                 "',DecRetailPrice=" & CDbl(txtFields(6).Text) & ",DecTradeDiscount=" & CDbl(txtFields(7).Text) & ",DecTradePrice=" & CDbl(txtFields(8).Text) & _
                 " where ChrBookNo='" & Trim(txtFields(0).Text) & "'"
     cN.BeginTrans
     cN.Execute (sqlstring)
     cN.CommitTrans
     Unload Me
     Call frmFields.cmdRefresh_Click
  End If
  
  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 chrBookNo,chrBookName,DecPrice,DecAgio,ChrGHS,Chrbookconcern,DatPublishDate" & _
                               " from BookData where chrBookNo like '%" & txtFields(0).Text & "%'", "0,1,2", , , , -1, arrQuery)
           If TypeName(arrQuery) = "Variant()" Then
              txtFields(0).Text = arrQuery(0, 0)
              txtFields(1).Text = arrQuery(0, 1)
              txtFields(4).Text = arrQuery(0, 2)
           End If
  End Select
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 BooksPriceDiscount where ChrBookNo='" & Trim(txtFields(0).Text) & "' and ChrBookName='" & Trim(txtFields(1).Text) & "' and DatInceptDate=#" & Trim(txtFields(2).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 TxtFields_Change(Index As Integer)
  Select Case Index
    Case 5
      If Trim(txtFields(5)) <> "" And Trim(txtFields(4)) <> "" Then
         txtFields(6) = CDbl(txtFields(5)) * CDbl(txtFields(4))
      End If
    Case 7
      If Trim(txtFields(7)) <> "" And Trim(txtFields(4)) <> "" Then
         txtFields(8) = CDbl(txtFields(7)) * CDbl(txtFields(4))
      End If
  End Select
End Sub

Private Sub txtFields_KeyPress(Index As Integer, KeyAscii As Integer)
  Select Case Index
    Case 0
      KeyAscii = ValiText(KeyAscii, vbExpInteger, "", txtFields(Index).Text, 13)
    Case 2, 3
      KeyAscii = ValiText(KeyAscii, vbExpDate, "", txtFields(Index).Text)
    Case 5, 7
      KeyAscii = ValiText(KeyAscii, vbExpDecimal, "", txtFields(Index).Text)
  End Select
End Sub