frmadjprice.frm

注释：用VB开发的进销存系统源码

         Tag             =   "保存"
         ToolTipText     =   "保存单据"
         Top             =   30
         Width           =   930
         _ExtentX        =   1640
         _ExtentY        =   820
         _Version        =   131073
         ForeColor       =   0
         Caption         =   "保存[&S]"
         ButtonStyle     =   3
         BevelWidth      =   0
      End
      Begin Threed.SSCommand cmdToolCommit 
         Height          =   465
         Left            =   945
         TabIndex        =   12
         Tag             =   "确认"
         ToolTipText     =   "确认单据，使之生效"
         Top             =   30
         Width           =   930
         _ExtentX        =   1640
         _ExtentY        =   820
         _Version        =   131073
         ForeColor       =   0
         Caption         =   "确认[&O]"
         ButtonStyle     =   3
         BevelWidth      =   0
      End
      Begin Threed.SSCommand cmdToolAdd 
         CausesValidation=   0   'False
         Height          =   465
         Left            =   15
         TabIndex        =   11
         Tag             =   "新建"
         ToolTipText     =   "新建单据"
         Top             =   30
         Width           =   930
         _ExtentX        =   1640
         _ExtentY        =   820
         _Version        =   131073
         ForeColor       =   0
         Caption         =   "新建[&N]"
         ButtonStyle     =   3
         BevelWidth      =   0
      End
   End
   Begin VB.Label Label1 
      Appearance      =   0  'Flat
      BackColor       =   &H80000015&
      ForeColor       =   &H80000008&
      Height          =   4980
      Left            =   75
      TabIndex        =   8
      Top             =   690
      Width           =   9390
   End
End
Attribute VB_Name = "frmAdjPrice"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::::::::::::::::::::售价调整单:::::::::::::::::::::::::::::::::
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

Option Explicit

Dim i, j As Integer

Public Rs As New ADODB.Recordset               '用于只打开单记录集时

Private Const TableName As String = "售价调整单"     '定义表头名称
Private QueryFlag As Boolean                    '记录查询状态
Private TableState As String                    '当前状态

Private Function CommSaveTable() As Boolean
    On Error GoTo CommSaveErr
    sSQL = "DELETE FROM " & TableName & " WHERE 表单号='" & txtPurcode.Text & "'"
    Cmd.ActiveConnection = Conn
    Cmd.CommandText = sSQL
    Cmd.Execute
    If SaveTable() Then
        CommSaveTable = True
        Exit Function
    Else
        CommSaveTable = False
        Exit Function
    End If
CommSaveErr:
    CommSaveTable = False
End Function


'代销市场调进价
Private Sub AdjPrice()
    On Error GoTo PrcErr
    
    Dim GoodsNum      '记录从某一单据上改动的数量
    Dim strOperMsg As String    '单据改动信息
    
    
    '开始事务
    Conn.BeginTrans
    
    sSQL = "UPDATE " & TableName & " SET 确认状态=1 WHERE 表单号='" & Trim(txtPurcode.Text) & "'"
    Cmd.ActiveConnection = Conn
    Cmd.CommandText = sSQL
    Cmd.Execute
    
    '移到第一条
    grdDET.MoveFirst
    For i = 0 To grdDET.Rows - 1
        '对每一条进行处理
        
        '***********************************************
        '修改商品主档中的进价
        '***********************************************
        
        sSQL = "UPDATE 商品主档 SET 零售价=" & grdDET.Columns(4).Value & _
            ",更新标志=0 WHERE 商品编码='" & Trim(grdDET.Columns(0).Text) & "'"
        If RunSQL(sSQL) <> 0 Then
            MsgBox "修改商品主档时失败!,请检查数据是否正确!", vbExclamation, "提示窗口"
            Conn.RollbackTrans
            Exit Sub
        End If
        
        sSQL = "UPDATE 商品信息 SET 更新标志=0 WHERE 商品编码='" & Trim(grdDET.Columns(0).Text) & "'"
        If RunSQL(sSQL) <> 0 Then
            MsgBox "修改商品信息时失败!,请检查数据是否正确!", vbExclamation, "提示窗口"
            Conn.RollbackTrans
            Exit Sub
        End If
        
        grdDET.MoveNext
    Next i
    
    cmdToolCommit.Enabled = False
    cmdToolSave.Enabled = False
    Conn.CommitTrans
    Exit Sub
PrcErr:
    MsgBox "调进价失败!", vbExclamation, "错误窗口"
    Conn.RollbackTrans
End Sub

'
'检查数据是否合法
'
Private Function DataOK() As Boolean
    
    
    If Trim(txtPurcode.Text) = "" Then
        DataOK = False
        Exit Function
    End If
    If Trim(txtPurdate.Text) = "" Then
        DataOK = False
        Exit Function
    End If
'    If Trim(txtRtfno.Text) = "" Then
'        DataOK = False
'        Exit Function
'    End If
'    If Trim(txtManager.Text) = "" Then
'        DataOK = False
'        Exit Function
'    End If
    If Trim(txtIptno.Text) = "" Then
        DataOK = False
        Exit Function
    End If
    
    If grdDET.Rows = 0 Then
        DataOK = False
        Exit Function
    End If
    DataOK = True
End Function


'在状态条上显示记录信息和状态信息

Private Sub ShowStatus(Flag As Integer)
    Select Case Flag
        Case 0      '查询记录移动
            If Rs.EOF Then
                Temp = "已经移到记录末尾了"
            ElseIf Rs.BOF Then
                Temp = "已经移到记录开始"
            Else
                Temp = "第" & Rs.AbsolutePosition & "条"
            End If
            stbData.Panels("状态信息").Text = "总共:" & Rs.RecordCount & _
                "条之第: " & Temp
        Case 1      '开始查询
            stbData.Panels("状态信息").Text = "请输入查询条件:"
        Case 2      '请输入新表单
            stbData.Panels("状态信息").Text = "请输入新表单:"
        Case 3      '保存表单
            stbData.Panels("状态信息").Text = "表单保存完毕"
        Case 4      '保存表单
            stbData.Panels("状态信息").Text = "该表单已经确认"
        Case 5
            stbData.Panels("状态信息").Text = "该表单已经删除 "
        Case Else
            stbData.Panels("状态信息").Text = ""
    End Select
End Sub


'将表的表头和明细清空
Private Sub ClearTable()
    '清空表头
    txtPurcode.Text = ""
    
    txtPurdate.Text = ""        'CStr(Now)
'    txtRtfno.Text = ""
'    txtManager.Text = ""
    txtIptno.Text = ""
    
    
    '清空明细
    grdDET.Update
    grdDET.RemoveAll
End Sub

'刷新表显示

Private Sub RefreshTable(vRs As ADODB.Recordset)
    On Error GoTo RefErr
    If vRs.EOF Or vRs.BOF Then Exit Sub
    grdDET.Update
    grdDET.RemoveAll
    
    
    '表头文本框刷新
    
    txtPurcode.Text = vRs("表单号")
    txtPurdate.Text = CStr(Format(vRs("制表日期"), "YYYY-MM-DD 00:00"))
    txtIptno.Text = vRs("录入员")
    
    '如果确认状态为真则不允许修改
    If vRs("确认状态").Value Then
        cmdToolCommit.Enabled = False
        cmdToolDelete.Enabled = False
        cmdToolSave.Enabled = False
        grdDET.AllowUpdate = False
    Else
        cmdToolCommit.Enabled = True
        cmdToolDelete.Enabled = True
        cmdToolSave.Enabled = True
        grdDET.AllowUpdate = True
    End If
    
    While Not vRs.EOF
        grdDET.AddItem Trim(vRs("商品编码")) & vbTab & _
                    Trim(vRs("品名")) & vbTab & _
                    Trim(vRs("单位")) & vbTab & _
                    Str(vRs("原售价")) & vbTab & _
                    Str(vRs("现售价"))
        '记录后移
        vRs.MoveNext
    Wend
    Call CalTotal
    Exit Sub
RefErr:
    ErrNum = Err.number
    MsgBox "读数据库发生错误!" & vbCrLf & Error$(ErrNum), vbExclamation, "提示窗口"

End Sub

'保存表
Private Function SaveTable() As Boolean
    On Error GoTo TransErr
    grdDET.Update
    '增加记录
    grdDET.MoveFirst
    For i = 0 To grdDET.Rows - 1
    sSQL = "INSERT INTO 售价调整单(表单号, 制表日期, " & _
        "录入员, 商品编码, 品名, 单位, " & _
        "原售价,现售价)VALUES('" & _
            Trim(txtPurcode.Text) & "','" & _
            Trim(txtPurdate.Text) & "','" & _
            Trim(txtIptno.Text) & "','" & _
            grdDET.Columns(0).Value & "','" & _
            grdDET.Columns(1).Value & "','" & _
            grdDET.Columns(2).Value & "'," & _
            Str(grdDET.Columns(3).Value) & "," & _
            Str(grdDET.Columns(4).Value) & ")"
           
        If RunSQL(sSQL) <> 0 Then
            MsgBox "明细更新失败!" & vbCrLf & Error$(ErrNum), vbExclamation, "警告窗口"
            SaveTable = False
            Exit Function
        End If
        grdDET.MoveNext
    Next i
    SaveTable = True
    Exit Function
TransErr:       '错误处理
    SaveTable = False
    ErrNum = Err.number
End Function


'增加新表
Private Sub cmdToolAdd_Click()
    On Error Resume Next
    TableState = "新建"
    grdDET.AllowUpdate = True
    Set Rs = Nothing
    QueryFlag = False
    Call ShowStatus(2)
    '清除整个表显示
    Call ClearTable
    txtIptno.Text = UserCode
    txtPurcode.Text = GeneratePurcode(TableName)
    txtPurdate.Text = Format(Now, "yyyy-mm-dd")

    cmdToolSave.Enabled = True
    cmdToolCommit.Enabled = False
    cmdToolPrevious.Enabled = False
    cmdToolNext.Enabled = False
    cmdToolDelete.Enabled = False
'    txtPurcode.SetFocus
End Sub

'改变确认状态
'只有审核员才能进行该操作
Private Sub cmdToolCommit_Click()
    On Error GoTo ComErr
    If txtPurcode.Text = "" Then
        MsgBox "表单号不能为空!", vbExclamation, "提示窗口"
        Exit Sub
    End If
    Temp = "确认之后将不能再作改动,继续吗?"
    Temp = MsgBox(Temp, vbQuestion + vbYesNo, "提示窗口")
    If Temp = vbNo Then Exit Sub
    If Not CommSaveTable() Then
        MsgBox "保存数据时发生错误!", vbExclamation, "错误窗口"
        Exit Sub
    End If
    Call AdjPrice
    Exit Sub
ComErr:
    ErrNum = Err.number