tsdbxg.frm

出版社图书出货管理系统,包括图书的出库,入库,结果输出

      Height          =   315
      Left            =   210
      TabIndex        =   43
      Top             =   8220
      Width           =   1155
   End
   Begin VB.Label Label14 
      Caption         =   "从"
      Height          =   345
      Left            =   1800
      TabIndex        =   41
      Top             =   7740
      Width           =   285
   End
   Begin VB.Label Label12 
      Caption         =   "到"
      Height          =   375
      Left            =   4050
      TabIndex        =   39
      Top             =   4620
      Width           =   345
   End
   Begin VB.Label Label10 
      Caption         =   "金额："
      Height          =   255
      Left            =   9810
      TabIndex        =   26
      Top             =   7770
      Width           =   555
   End
   Begin VB.Label Label9 
      Caption         =   "册数："
      Height          =   255
      Left            =   8520
      TabIndex        =   25
      Top             =   7770
      Width           =   585
   End
   Begin VB.Label Label8 
      Caption         =   "种数："
      Height          =   225
      Index           =   0
      Left            =   7170
      TabIndex        =   24
      Top             =   7770
      Width           =   735
   End
   Begin VB.Label Label7 
      Caption         =   "到"
      Height          =   375
      Left            =   2580
      TabIndex        =   19
      Top             =   7740
      Width           =   405
   End
   Begin VB.Label Label6 
      Caption         =   "当前包号："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   120
      TabIndex        =   15
      Top             =   4560
      Width           =   1215
   End
   Begin VB.Label Label5 
      Caption         =   "排序按："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   6030
      TabIndex        =   11
      Top             =   90
      Width           =   1035
   End
   Begin VB.Label Label4 
      Caption         =   "为："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2880
      TabIndex        =   7
      Top             =   540
      Width           =   555
   End
   Begin VB.Label Label3 
      Caption         =   "并且字段:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   300
      TabIndex        =   5
      Top             =   540
      Width           =   1155
   End
   Begin VB.Label Label2 
      Caption         =   "为："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2880
      TabIndex        =   4
      Top             =   120
      Width           =   495
   End
   Begin VB.Label Label1 
      Caption         =   "请选择字段："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   60
      TabIndex        =   3
      Top             =   120
      Width           =   1515
   End
End
Attribute VB_Name = "tsdbxg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

Const SND_SYNC = &H0
Private Sub Command1_Click()
  Dim field1 As String
  Dim field2 As String
  Dim ordstr As String
  Dim sqlstr As String
  Dim sqllast1 As String
  Dim sqllast2 As String
  Dim sqllast3 As String
  Command6.Enabled = True
  On Error Resume Next
  field1 = Combo1.Text
  field2 = Combo2.Text
  ordstr = Combo3.Text
 
  sqlstr = "select * from 预采数据 "
  If Text1.Text = "" Then
     sqllast1 = ""
     Else
     If field1 = "ISBN号" Then sqllast1 = "isbn like '" & Text1.Text & "*'"
     If field1 = "书  名" Then sqllast1 = "bookname like '*" & Text1.Text & "*'"
     If field1 = "作  者" Then sqllast1 = "author like '*" & Text1.Text & "*'"
     If field1 = "出版社" Then sqllast1 = "bms like '*" & Text1.Text & "*'"
     If field1 = "出版年" Then sqllast1 = "bmn like '*" & Text1.Text & "*'"
     If field1 = "提供商" Then sqllast1 = "provide like '*" & Text1.Text & "*'"
     If field1 = "排架号" Then sqllast1 = "bjh like '*" & Text1.Text & "*'"
     sqlstr = sqlstr & " where " & sqllast1
     End If
     
  If Text2.Text = "" Then
    sqllast2 = ""
    Else
    If field2 = "ISBN号" Then sqllast2 = "isbn like '" & Text2.Text & "*'"
    If field2 = "书  名" Then sqllast2 = "bookname like '*" & Text2.Text & "*'"
    If field2 = "作  者" Then sqllast2 = "author like '*" & Text2.Text & "*'"
    If field2 = "出版社" Then sqllast2 = "bms like '*" & Text2.Text & "*'"
    If field2 = "出版年" Then sqllast2 = "bmn like '*" & Text2.Text & "*'"
     If field2 = "提供商" Then sqllast2 = "provide like '*" & Text2.Text & "*'"
     If field2 = "排架号" Then sqllast2 = "bjh like '*" & Text2.Text & "*'"
    If Text1.Text = "" Then
      sqlstr = sqlstr & " where " & sqllast2
      Else
       sqlstr = sqlstr & " and " & sqllast2
      End If
    End If
   
  ' If Text3.Text = "" Then
  '  sqlstr = sqlstr
 '  Else
  '   If Text2.Text = "" And Text1.Text = "" Then
  '    sqlstr = sqlstr & " where baohao='" & Text3.Text & "'"
   '  Else
   '   sqlstr = sqlstr & " and baohao='" & Text3.Text & "'"
  '   End If
  ' End If
  ' firstbh = Val(Text3.Text)
  'nextbh = Val(Text4.Text)
  
   
   If ordstr = "控制号" Then sqllast3 = "order by ID"
   If ordstr = "ISBN号" Then sqllast3 = "order by isbn"
   If ordstr = "书  名" Then sqllast3 = "order by bookname"
   If ordstr = "作  者" Then sqllast3 = "order by author"
   If ordstr = "出版社" Then sqllast3 = "order by bms"
   If ordstr = "出版年" Then sqllast3 = "order by bmn"
   If ordstr = "价  格" Then sqllast3 = "order by jg desc"
   If ordstr = "选书数" Then sqllast3 = "order by fbl desc"
   If ordstr = "时  间" Then sqllast3 = "order by modidate desc"
   If ordstr = "排架号" Then sqllast3 = "order by bjh"
   If ordstr = "包  号" Then sqllast3 = "order by baohao,val(jg)"
   
 sqlstr = sqlstr & " " & sqllast3
 ' MsgBox sqlstr
  
  Data3.RecordSource = sqlstr
  Data3.Refresh
  Dim db As Database
  Dim rs As Recordset
 
 ' On Error GoTo aa:
 
 ' Set db = Workspaces(0).OpenDatabase("d:\cbssys\bookcgk.mdb")
 ' Set rs = db.OpenRecordset("select count(*) as zongsum,sum(fbl)as csum,sum(fbl*val(jg)) as je from 预采数据 where fbl>0")
 ' Text5.Text = rs.Fields("zongsum").Value
 ' Text6.Text = rs.Fields("csum").Value
 ' Text7.Text = rs.Fields("je").Value
 ' rs.Close
 ' db.Close
 ' Exit Sub
   Text1.SelStart = 0
  Text1.SelLength = 20
  Text1.SetFocus
aa:
  Text5.Text = 0
  Text6.Text = 0
  Text7.Text = 0
End Sub




Private Sub Command10_Click()
dwcode = Combo4.Text
dwdh = Text12.Text

If Len(Text9.Text) = 0 Then
  Exit Sub
  End If
  currentbao = Val(Text9.Text)

If currentbao <= 0 Then currentbao = 1
Text9.Text = ""
Text11.Text = Trim(Str(currentbao))
Data2.RecordSource = "select * from 本馆数据 where baohao=" & currentbao & " and 名称='" & dwcode & "' and  单号='" & dwdh & "' order by modidate desc"
  Data2.Refresh
  Text1.SelStart = 0
  Text1.SelLength = 20
  Text1.SetFocus
End Sub

Private Sub Command12_Click()
On Error Resume Next
'data3的当前记录出库,从fbl中减,dgs中加
dwcode = Combo4.Text
dwdh = Text12.Text
If Data3.Recordset.RecordCount = 0 Then
  MsgBox ("没有选择当前记录!")
  Exit Sub
  End If
cksum = Val(Text10.Text)
If cksum > Val(Text8.Text) Or cksum <= 0 Then
  MsgBox ("输入出库数量错误！")
  Exit Sub
  End If
 Data3.Recordset.Edit
 Data3.Recordset.Fields("fbl").Value = Data3.Recordset.Fields("fbl").Value - cksum
 Data3.Recordset.Update
 
 Data2.Recordset.AddNew
     Data2.Recordset("bookname") = Data3.Recordset("bookname")
     Data2.Recordset("author") = Data3.Recordset("author")
     Data2.Recordset("isbn") = Data3.Recordset("isbn")
     Data2.Recordset("bms") = Data3.Recordset("bms")
     Data2.Recordset("bmn") = Data3.Recordset("bmn")
     Data2.Recordset("jg") = Data3.Recordset("jg")
     'Data2.Recordset("fbl") = Val(LTrim$(RTrim$(Left$(fbl, 5))))
     Data2.Recordset("dgs") = cksum
     'Data2.Recordset("context") = context
     'Data2.Recordset("provide") = LTrim$(RTrim$(Left$(provide, 25)))
     Data2.Recordset("bjh") = Data3.Recordset("bjh")
     Data2.Recordset("class") = Data3.Recordset("class")
      Data2.Recordset("baohao") = Val(Text11.Text)
     Data2.Recordset("modidate") = Now()
       Data2.Recordset("名称") = dwcode
      Data2.Recordset("单号") = dwdh
     Data2.Recordset.Update
    
     Data2.Refresh
 
  Text1.SelStart = 0
  Text1.SelLength = 20
  Text1.SetFocus
 
End Sub

Private Sub Command2_Click()
 Unload Me
End Sub

Private Sub Command3_Click()
 '图书扫描打包，两种情况：提示与不提示。
  Dim topint As Long
  Dim sqlstr As String
  topint = 0
  sqlstr = ""
  Command6.Enabled = False
 'On Error Resume Next
' Data3.RecordSource = "select * from 预采数据 where baohao>'0' order by modidate"
' Data3.Refresh
' Data3.Recordset.MoveLast
On Error Resume Next
 If Text1.Text = "" Then Exit Sub
 
 If Text3.Text = "" Then
  MsgBox "您还没有定义包号！"
  Text3.SetFocus
  Exit Sub
 End If
 If Not IsNumeric(Text3.Text) Then
    MsgBox "包号应为数字！"
    Text3.SetFocus
    Exit Sub
    End If
 If Combo1.Text <> "ISBN号" Then Exit Sub

   isbntext = isbndel(Text1.Text)
   sqlstr = "select * from 预采数据 where isbn='" & isbntext & "'"
   
   Data1.RecordSource = sqlstr
   Data1.Refresh
   If Data1.Recordset.RecordCount <> 0 Then
   Data1.Recordset.MoveLast
   End If
   topint = Data1.Recordset.RecordCount '预采数据查重
'下面进行判断
If topint = 0 Then
'提示通过别的途径查询
  
  Data3.RecordSource = "select * from 预采数据 where baohao=" & Text3.Text & " order by modidate"
  Data3.Refresh
  'Data3.Recordset.MoveLast
  MsgBox "未找到此书，请通过书名、作者或排架号来查询！"
Else
  If topint = 1 Then
   '判断是否已加包号，如果包号为空，则自动加入，否则提示已加过包号。
   baohao1 = ""
   baohao1 = Data1.Recordset("baohao").Value
   If IsNull(baohao1) Then
     
     Data1.Recordset.Edit
     Data1.Recordset("baohao").Value = Val(Text3.Text)
     Data1.Recordset("modidate").Value = Now()
     Data1.Recordset.Update
      sndPlaySound "d:\cbssys\wav\cg.wav", SND_SYNC
     Data3.RecordSource = "select * from 预采数据 where baohao=" & Text3.Text & " order by modidate"
      Data3.Refresh
      Data3.Recordset.MoveLast
      
   Else
     If baohao1 = "" Or Val(baohao1) < 1 Then
       
     Data1.Recordset.Edit
     Data1.Recordset("baohao").Value = Val(Text3.Text)
     Data1.Recordset("modidate").Value = Now()
     Data1.Recordset.Update
       sndPlaySound "d:\cbssys\wav\cg.wav", SND_SYNC
     Data3.RecordSource = "select * from 预采数据 where baohao=" & Text3.Text & " order by modidate"
      Data3.Refresh
      Data3.Recordset.MoveLast
      
     Else
   
      Data3.RecordSource = "select * from 预采数据 where baohao=" & Text3.Text & " order by modidate"
      Data3.Refresh
      Data3.Recordset.MoveLast
     MsgBox "此种图书已打过一次包，记录如下面列表框！"
     Data2.RecordSource = sqlstr
     Data2.Refresh
     End If
   End If
   
  Else
   '为丛书，需选择哪一本来加包号
      On Error Resume Next
      Data3.RecordSource = "select * from 预采数据 where baohao=" & Text3.Text & " order by modidate"
      Data3.Refresh
      Data3.Recordset.MoveLast
      MsgBox "检索到多条记录，请在下面列表框中修改！"
      Data2.RecordSource = sqlstr
      Data2.Refresh
      
  End If
End If
 
  Text1.SetFocus
  Text1.SelStart = 0
  Text1.SelLength = 20
  '统计
  Dim db As Database
  Dim rs As Recordset
 
  On Error GoTo aa:
  baohao1 = Val(Text3.Text)
  Set db = Workspaces(0).OpenDatabase("d:\cbssys\bookcgk.mdb")
  Set rs = db.OpenRecordset("select count(*) as zongsum,sum(dgs)as csum,sum(dgs*jg) as je from 预采数据 where baohao=" & baohao1)
  Text5.Text = rs.Fields("zongsum").Value
  Text6.Text = rs.Fields("csum").Value
  Text7.Text = rs.Fields("je").Value
  rs.Close
  db.Close
  Exit Sub
aa:
  Text5.Text = 0
  Text6.Text = 0
  Text7.Text = 0
  
  
  
End Sub

Private Sub Command4_Click()
'打印打包标签

Dim cury As Double
Dim curx As Double
Dim zongsum As Long
Dim cesum As Long
Dim jesum As Double
Dim t_zongsum As Long
Dim t_cesum As Long
Dim t_jesum As Double

Dim suhao As Integer
'读参数
Dim db As Database