frmorderlist.frm

这是一个进销管理系统

         Width           =   855
      End
   End
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   7920
      Top             =   0
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   2
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmOrderList.frx":0034
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmOrderList.frx":0146
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.Toolbar Toolbar1 
      Align           =   1  'Align Top
      Height          =   420
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   11100
      _ExtentX        =   19579
      _ExtentY        =   741
      ButtonWidth     =   609
      ButtonHeight    =   582
      Appearance      =   1
      ImageList       =   "ImageList1"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   2
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "btnSave"
            ImageIndex      =   1
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "btnPrint"
            ImageIndex      =   2
         EndProperty
      EndProperty
   End
   Begin MSAdodcLib.Adodc Adodc2 
      Height          =   330
      Left            =   9720
      Top             =   6720
      Visible         =   0   'False
      Width           =   1200
      _ExtentX        =   2117
      _ExtentY        =   582
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   2
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   1
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   "Provider=MSDASQL.1;Persist Security Info=False;Data Source=jxclink"
      OLEDBString     =   "Provider=MSDASQL.1;Persist Security Info=False;Data Source=jxclink"
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   "仓库清单"
      Caption         =   "Adodc1"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
End
Attribute VB_Name = "frmOrderList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub SetTaxForDelOrUpgrade()
    Dim total As Integer
    Dim i As Integer
    Dim rate As Integer
    total = 0
    rate = CInt(Trim(Me.lblRateValue.Caption))
    '计算税额
    For i = 1 To Me.fgOrderList.Rows - 1
        total = total + CInt(Trim(fgOrderList.TextMatrix(i, 7)))
    Next
    Me.txbTax.Text = total - total / (1 + rate / 100)
    Me.txbTotal.Text = total
    Me.txbWithoutTax.Text = total / (1 + rate / 100)
End Sub

Private Sub SetTaxForAdd(ByVal total As Integer)
    '计算税额
    Dim rate As Integer
    Dim iAll As Integer
    rate = CInt(Trim(Me.lblRateValue.Caption))
    iAll = total + CInt(Trim(Me.txbTotal.Text))
    Me.txbTotal.Text = iAll
    Me.txbTax.Text = (iAll - iAll / (1 + rate / 100))
    Me.txbWithoutTax.Text = (iAll / (1 + rate / 100))
End Sub

Private Sub ToPrint()
    Dim rptOrderList As New drOrderList
    Dim envOrderList As deOrderlist
    Set envOrderList = rptOrderList.DataSource
    envOrderList.rsCommand1.Requery
    rptOrderList.Show
End Sub

Private Sub btnAdd_Click()
'验证添加的数据是否有错误
    If ValidateNew() = False Then
        MsgBox "数据错误"
        Exit Sub
    End If
'添加新的数据行
    fgOrderList.Rows = fgOrderList.Rows + 1
    Dim i As Integer
    i = fgOrderList.Rows - 1
    fgOrderList.TextMatrix(i, 0) = i
    fgOrderList.TextMatrix(i, 1) = Trim(Me.txbGoodID.Text)      '货号
    fgOrderList.TextMatrix(i, 2) = Trim(txbGoodName.Text)       '品名
    fgOrderList.TextMatrix(i, 3) = Trim(Me.txbGoodsCount.Text)  '数量
    fgOrderList.TextMatrix(i, 4) = Trim(Me.txbUnit.Text)        '单位
    fgOrderList.TextMatrix(i, 5) = Trim(Me.txbGoodPrice.Text)   '单价
    fgOrderList.TextMatrix(i, 6) = Me.cbbDepotID.Text           '仓库
'计算税率
    Dim total As Integer
    total = CInt(Trim(Me.txbGoodPrice.Text)) * _
            CInt(Trim(Me.txbGoodsCount.Text))
    Dim rate As Integer
    rate = CInt(Trim(Me.lblRateValue.Caption))

    fgOrderList.TextMatrix(i, 7) = total                            '稅价合计
    fgOrderList.TextMatrix(i, 8) = Trim(Me.lblRateValue.Caption)    '税率
    fgOrderList.TextMatrix(i, 9) = total - total / (1 + rate / 100) '税额
    fgOrderList.TextMatrix(i, 10) = total / (1 + rate / 100)        '不含税价

    SetTaxForAdd (CInt(Trim(Me.txbGoodPrice.Text)) * _
            CInt(Trim(Me.txbGoodsCount.Text)))
    Clear
End Sub

Private Function ValidateNew() As Boolean
    If Len(Trim(txbSupplyID.Text)) = 0 _
    Or Len(Trim(txbGoodID.Text)) = 0 Then
        ValidateNew = False
    End If
    If Len(Trim(txbGoodsCount.Text)) = 0 Or _
        Len(Trim(txbGoodPrice.Text)) = 0 Then
        ValidateNew = False
    End If
    ValidateNew = True
End Function

Private Sub Clear()
    Me.txbGoodPrice.Text = 0
    Me.txbGoodsCount.Text = 0
End Sub

Public Sub ClearAll()
    Me.txbGoodPrice.Text = 0
    Me.txbGoodsCount.Text = 0
    Me.txbGoodID.Text = ""
    Me.txbGoodName.Text = ""
    Me.txbListMaker.Text = ""
    Me.txbSupplyID = ""
    Me.txbSupplyName = ""
    Me.txbTax = "0"
    Me.txbTotal = "0"
    Me.txbUnit = ""
    Me.txbWithoutTax = "0"
    Me.fgOrderList.Rows = 1
End Sub

Private Sub btnDelete_Click()
    If MsgBox("你确认要删除此条记录吗?", vbYesNo) = vbYes Then
        fgOrderList.Rows = fgOrderList.Rows - 1
        SetTaxForDelOrUpgrade
    End If
End Sub

Private Sub btnModify_Click()
    i = fgOrderList.Row
    fgOrderList.TextMatrix(i, 1) = Trim(Me.txbGoodID.Text)      '货号
    fgOrderList.TextMatrix(i, 2) = Trim(txbGoodName.Text)       '品名
    fgOrderList.TextMatrix(i, 3) = Trim(Me.txbGoodsCount.Text)  '数量
    fgOrderList.TextMatrix(i, 4) = Trim(Me.txbUnit.Text)        '单位
    fgOrderList.TextMatrix(i, 5) = Trim(Me.txbGoodPrice.Text)   '单价
    fgOrderList.TextMatrix(i, 6) = Me.cbbDepotID.Text           '仓库
'计算税率
    Dim total As Integer
    total = CInt(Trim(Me.txbGoodPrice.Text)) * _
            CInt(Trim(Me.txbGoodsCount.Text))
    Dim rate As Integer
    rate = CInt(Trim(Me.lblRateValue.Caption))
    fgOrderList.TextMatrix(i, 7) = total                            '稅价合计
    fgOrderList.TextMatrix(i, 8) = Trim(Me.lblRateValue.Caption)    '税率
    fgOrderList.TextMatrix(i, 9) = total - total / (1 + rate / 100) '税额
    fgOrderList.TextMatrix(i, 10) = total / (1 + rate / 100)        '不含税价
    SetTaxForDelOrUpgrade
End Sub


Private Sub btnSelectGood_Click()
    Dim frm As New frmSelectGood
    frm.Setorderorsell (1)
    frm.Show vbModal
End Sub

Private Sub btnSelectSupply_Click()
    Dim frm As New frmSelectSupply
    frm.Show vbModal
End Sub

Private Sub fgOrderList_Click()
    Dim i As Integer
    i = fgOrderList.Row
    If i < fgOrderList.Rows Then
        Me.txbGoodID.Text = fgOrderList.TextMatrix(i, 1)             '货号
        Me.txbGoodName.Text = fgOrderList.TextMatrix(i, 2)          '品名
        Me.txbGoodsCount.Text = fgOrderList.TextMatrix(i, 3)        '数量
        Me.txbUnit.Text = fgOrderList.TextMatrix(i, 4)              '单位
        Me.txbGoodPrice.Text = fgOrderList.TextMatrix(i, 5)         '单价
        Me.cbbDepotID.Text = fgOrderList.TextMatrix(i, 6)           '仓库
    End If
End Sub

Private Sub Form_Load()
    Dim db As New DataBases
'操作员姓名
    txbListMaker.Text = UserName
'制单日期
    txbOrderDate.Text = Format(Now(), "yyyy-mm-dd")
    Adodc1.Visible = False
    Adodc2.Visible = False
'新建表
    fgOrderList.Cols = 11
    fgOrderList.TextMatrix(0, 1) = "货号"
    fgOrderList.TextMatrix(0, 2) = "品名"
    fgOrderList.TextMatrix(0, 3) = "数量"
    fgOrderList.TextMatrix(0, 4) = "单位"
    fgOrderList.TextMatrix(0, 5) = "单价"
    fgOrderList.TextMatrix(0, 6) = "仓库"
    fgOrderList.TextMatrix(0, 7) = "稅价合计"
    fgOrderList.TextMatrix(0, 8) = "税率"
    fgOrderList.TextMatrix(0, 9) = "税额"
    fgOrderList.TextMatrix(0, 10) = "不含税价"
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    '判断按下的是否为“Save”按钮
    If StrComp(Button.Key, "btnSave") = 0 Or StrComp(Button.Key, "btnPrint") = 0 Then
        If fgOrderList.Rows = 0 Then
            Exit Sub
        End If
        Dim strSQL As String
        strSQL = ""
        Dim db As New DataBases
        ' 获取单据ID
        Dim rs As ADODB.Recordset
        Set rs = db.RunSelectSQL("select max(编号) as 编号 from 进货单历史")
        Dim sId As String
        sId = "0000000001"
        If rs("编号") > 0 Then
            sId = CInt(rs("编号") + 1)
        End If
        Dim count As Integer
        For count = Len(Trim(sId)) To 9
            sId = "0" + sId
        Next
        ' 删除已有数据
        db.RunSelectSQL ("delete from 进货单明细 where 进货单号='" _
                + sId + "'")
        db.RunSelectSQL ("delete from 进货单 where 编号='" _
                + sId + "'")
        ' 写入进货单
        strSQL = "insert into 进货单(编号,供货商号,进货日期, 制单人,"
        strSQL = strSQL + "业务员,税价合计,不含税价,税额) values('" + sId + "','"
        strSQL = strSQL + Trim(txbSupplyID.Text) + "','" _
                + txbOrderDate.Text + "','" + Trim(txbListMaker.Text) + "','"
        strSQL = strSQL + Trim(cbbWorker.Text)
        strSQL = strSQL + "'," + Trim(txbTotal.Text) + ","
        strSQL = strSQL + Trim(txbWithoutTax.Text)
        strSQL = strSQL + "," + txbTax.Text + ")"
        db.RunSelectSQL (strSQL)
        ' 写入明细
        Dim sId1 As String
        sId1 = "0000000000"
        Set rs = db.RunSelectSQL("select max(编号) as 编号  from 进货单明细历史")
        If rs("编号") > 0 Then
            sId1 = rs("编号")
        End If
        Dim i As Integer
        For i = 1 To fgOrderList.Rows - 1
            sId1 = CInt(sId1) + 1
            For count = Len(Trim(sId1)) To 9
                sId1 = "0" + sId1
            Next
            strSQL = "insert into 进货单明细(编号,进货单号,货号,进货数量," _
                    + "进价,仓库,税价合计,税率,不含税价,税额) values('" + sId1 _
                    + "','" + sId + "','" + fgOrderList.TextMatrix(i, 1) + "','" _
                    + fgOrderList.TextMatrix(i, 3) + "','" _
                    + fgOrderList.TextMatrix(i, 5) + "','"
            strSQL = strSQL + fgOrderList.TextMatrix(i, 6) + "','" _
                    + fgOrderList.TextMatrix(i, 7) + "','"
            strSQL = strSQL + fgOrderList.TextMatrix(i, 8) + "','" _
                    + fgOrderList.TextMatrix(i, 10) + "','"
            strSQL = strSQL + fgOrderList.TextMatrix(i, 9) + "')"
            db.RunSelectSQL (strSQL)
        Next
    End If
    If StrComp(Button.Key, "btnPrint") = 0 Then
    '判断按下的是否为“Print”按钮
        ToPrint
    End If
End Sub

Private Sub txbGoodID_LostFocus()
    If Len(Trim(txbGoodID.Text)) > 0 Then
        Dim rs As ADODB.Recordset
        Dim db As New DataBases
        Set rs = db.RunSelectSQL("select 品名,单位 from 商品清单 where 货号='" _
                                + Trim(txbGoodID.Text) + "'")
        '货物ID存在
        If rs.RecordCount > 0 Then
            txbGoodName.Text = rs("品名")
            txbUnit.Text = rs("单位")
        Else
        '货物ID不存在
            txbGoodID.Text = ""
            txbGoodName.Text = ""
            txbUnit.Text = ""
        End If
    End If
End Sub



Private Sub txbSupplyID_LostFocus()
    If Len(Trim(txbSupplyID.Text)) > 0 Then
        Dim rs As ADODB.Recordset
        Dim db As New DataBases
        Set rs = db.RunSelectSQL("select 名称 from 供货商清单 where 供货商号 = '" _
                                + Trim(txbSupplyID.Text) + "'")
        '货物ID存在
        If rs.RecordCount > 0 Then
            txbSupplyName.Text = rs("名称")
        Else
        '货物ID不存在
            txbSupplyID.Text = ""
            txbSupplyName.Text = ""

        End If
    End If
End Sub