frmplace.frm

网上销售源代码

        cboStorageID.AddItem Ars("StorageID")
    Ars.MoveNext
        cboStorageID.ListIndex = 0
    Loop
End If

If Trim(cboAreaStorID.Text) <> "" And Trim(cboStorageID.Text) <> "" Then
    cboAreaID.Clear
    sql = "select AreaID from Area Where AreaStorID='" & Trim(cboAreaStorID.Text) & "' and StorageID='" & Trim(cboStorageID.Text) & "'"
    Set Ars = SQLDB.Execute(sql)

    Do While Not Ars.EOF
        cboAreaID.AddItem Ars("AreaID")
    Ars.MoveNext
    cboAreaID.ListIndex = 0
    Loop
End If
End Sub

Private Sub cboStorageID_Click()
Dim sql As String
Dim Ars As New ADODB.Recordset

If Trim(cboAreaStorID.Text) <> "" And Trim(cboStorageID.Text) <> "" Then
    cboAreaID.Clear
    sql = "select AreaID from Area Where AreaStorID='" & Trim(cboAreaStorID.Text) & "' and StorageID='" & Trim(cboStorageID.Text) & "'"
    Set Ars = SQLDB.Execute(sql)

    Do While Not Ars.EOF
        cboAreaID.AddItem Ars("AreaID")
    Ars.MoveNext
    cboAreaID.ListIndex = 0
    Loop
End If
End Sub

Private Sub Form_Load()

'初使化下接柜
    Initcbo
End Sub

Private Sub tlbOperate_ButtonClick(ByVal Button As MSComctlLib.Button)
 Select Case Button.Key
        Case "update"
            '保存数据
                If P_SID = "" Then
                    Sava
                Else
                    Update
                End If
                
        Case "cancel"
            '撤消
            InitClear
        
        Case "first"
            '首页
            frmMQSmallGenus.mintCurPage = 1
            gFillFg frmMQSmallGenus.fg, frmMQSmallGenus.mrstDriveRoom, frmMQSmallGenus.tlbOperate.Buttons, frmMQSmallGenus.mintCurPage, frmMQSmallGenus.mintPageSize
            P_SID = frmMQSmallGenus.fg.TextMatrix(1, 1)
            
            frmMQSmallGenus.fg.TextMatrix(0, 0) = "序号"
            frmMQSmallGenus.ShowID
            
            If frmMQSmallGenus.mintCurPage = 1 Then
                If frmMQSmallGenus.fg.Row = 1 Then
                    Me.tlbOperate.Buttons("first").Enabled = False
                    Me.tlbOperate.Buttons("prev").Enabled = False
                    Me.tlbOperate.Buttons("next").Enabled = True
                    Me.tlbOperate.Buttons("last").Enabled = True
                End If
            End If
            
        Case "prev"
            '前页
            If frmMQSmallGenus.fg.Row = frmMQSmallGenus.fg.Rows - 1 Then
                If frmMQSmallGenus.mintCurPage <= frmMQSmallGenus.mrstDriveRoom.PageCount Then
                    frmMQSmallGenus.mintCurPage = frmMQSmallGenus.mintCurPage - 1
                    gFillFg frmMQSmallGenus.fg, frmMQSmallGenus.mrstDriveRoom, frmMQSmallGenus.tlbOperate.Buttons, frmMQSmallGenus.mintCurPage, frmMQSmallGenus.mintPageSize
                    P_SID = frmMQSmallGenus.fg.TextMatrix(frmMQSmallGenus.fg.Rows - 1, 1)
                                        frmMQSmallGenus.fg.TextMatrix(0, 0) = "序号"
                    frmMQSmallGenus.ShowID
                End If
            End If
            
            If frmMQSmallGenus.mintCurPage = 1 Then
                If frmMQSmallGenus.fg.Row = 1 Then
                    Me.tlbOperate.Buttons("first").Enabled = False
                    Me.tlbOperate.Buttons("prev").Enabled = False
                    Me.tlbOperate.Buttons("next").Enabled = True
                    Me.tlbOperate.Buttons("last").Enabled = True
                End If
            End If
        
        Case "next"
            '下页
            If frmMQSmallGenus.fg.Row = frmMQSmallGenus.fg.Rows - 1 Then
                frmMQSmallGenus.mintCurPage = frmMQSmallGenus.mintCurPage + 1
                gFillFg frmMQSmallGenus.fg, frmMQSmallGenus.mrstDriveRoom, frmMQSmallGenus.tlbOperate.Buttons, frmMQSmallGenus.mintCurPage, frmMQSmallGenus.mintPageSize
                P_SID = frmMQSmallGenus.fg.TextMatrix(1, 1)
                frmMQSmallGenus.fg.TextMatrix(0, 0) = "序号"
                frmMQSmallGenus.ShowID
            End If
            
            If frmMQSmallGenus.mintCurPage = frmMQSmallGenus.mrstDriveRoom.PageCount Then
                If frmMQSmallGenus.fg.Row = frmMQSmallGenus.fg.Rows - 1 Then
                    Me.tlbOperate.Buttons("first").Enabled = True
                    Me.tlbOperate.Buttons("prev").Enabled = True
                    Me.tlbOperate.Buttons("next").Enabled = False
                    Me.tlbOperate.Buttons("last").Enabled = False
                End If
            End If
            
        Case "last"
            '末页
            frmMQSmallGenus.mintCurPage = -1
            gFillFg frmMQSmallGenus.fg, frmMQSmallGenus.mrstDriveRoom, frmMQSmallGenus.tlbOperate.Buttons, frmMQSmallGenus.mintCurPage, frmMQSmallGenus.mintPageSize
            P_SID = frmMQSmallGenus.fg.TextMatrix(frmMQSmallGenus.fg.Rows - 1, 1)
            frmMQSmallGenus.fg.TextMatrix(0, 0) = "序号"
            frmMQSmallGenus.ShowID
               
            If frmMQSmallGenus.mintCurPage = frmMQSmallGenus.mrstDriveRoom.PageCount Then
                If frmMQSmallGenus.fg.Row = frmMQSmallGenus.fg.Rows - 1 Then
                    Me.tlbOperate.Buttons("first").Enabled = True
                    Me.tlbOperate.Buttons("prev").Enabled = True
                    Me.tlbOperate.Buttons("next").Enabled = False
                    Me.tlbOperate.Buttons("last").Enabled = False
                End If
            End If
            
        Case "quit"
            Unload Me
     End Select
End Sub

Private Sub Sava()
'保存数据
Dim sql     As String
Dim Asql    As String
Dim o       As Integer
Dim Ars     As New ADODB.Recordset
Dim iLong   As Double
Dim iWidth  As Double
Dim iHigh   As Double
Dim iRow    As Integer
Dim iCol    As Integer

If Trim(cboAreaStorID.Text) = "" Then
    MsgBox "区办信息不能为空", vbInformation, "提示"
    Exit Sub
End If

If Trim(cboStorageID.Text) = "" Then
    MsgBox "仓库名称不能为空", vbInformation, "提示"
    Exit Sub
End If

If Trim(cboAreaID.Text) = "" Then
    MsgBox "区域编号不能为空", vbInformation, "提示"
    Exit Sub
End If

If Trim(txtPlaceID.Text) = "" Then
    MsgBox "储位编号不能为空", vbInformation, "提示"
    Exit Sub
End If

If Trim(txtPlaceName.Text) = "" Then
    MsgBox "储位名称不能为空", vbInformation, "提示"
    Exit Sub
End If

iRow = Trim(txtRow.Text)
iCol = Trim(txtCol.Text)

'查询当前区办，仓库，区域下的储位是否有编号
sql = "Select PlaceID from Place Where AreaStorID='" & Trim(cboAreaStorID.Text) & "' and StorageID='" & Trim(cboStorageID.Text) & "' and AreaID='" & Trim(cboAreaID.Text) & "' and PlaceID='" & Trim(txtPlaceID.Text) & "'"
Set Ars = SQLDB.Execute(sql)
If Not Ars.EOF Then
    MsgBox "当前区办下的仓库储位编号已存在，不能重复添加", vbInformation, "提示"
    Exit Sub
End If

'查询同一大类下面的小类名称是否已存在
sql = "Select PlaceName from Place Where AreaStorID='" & Trim(cboAreaStorID.Text) & "' and StorageID='" & Trim(cboStorageID.Text) & "' and AreaID='" & Trim(cboAreaID.Text) & "' and PlaceName='" & Trim(txtPlaceName.Text) & "'"
Set Ars = SQLDB.Execute(sql)
If Not Ars.EOF Then
    MsgBox "当前区办下的仓库储位名称已存在，不能重复添加", vbInformation, "提示"
    Exit Sub
End If

If Trim(txtLong.Text) = "" Then
    iLong = 0
Else
    iLong = Trim(txtLong.Text)
End If

If Trim(txtWidth.Text) = "" Then
    iWidth = 0
Else
    Width = Trim(txtWidth.Text)
End If

If Trim(txtHigh.Text) = "" Then
    iHigh = 0
Else
    iHigh = Trim(txtHigh.Text)
End If

On Error GoTo ErrShow
SQLDB.BeginTrans
    '添加主表信息
    Asql = "Insert into Place(AreaStorID,StorageID,AreaID,PlaceID,PlaceName,long,width,high,Remark,Row,Col) " & _
           "Values('" & Trim(cboAreaStorID.Text) & "','" & Trim(cboStorageID.Text) & "'," & _
           "'" & Trim(cboAreaID.Text) & "','" & Trim(txtPlaceID.Text) & "','" & Trim(txtPlaceName.Text) & "'," & _
           "" & iLong & "," & iWidth & "," & iHigh & ",'" & Trim(txtRemark.Text) & "'," & iRow & "," & iCol & ")"
    SQLDB.Execute Asql
SQLDB.CommitTrans
InitClear
frmMQPlace.QuerySalesRoom
MsgBox "添加成功", vbInformation, "提示"
Exit Sub
ErrShow:
    SQLDB.RollbackTrans
    MsgBox "添加储位信息出错" & err.Description, vbInformation, "提示"
End Sub

Private Sub Update()
'修改数据
Dim sql     As String
Dim Asql    As String
Dim o       As Integer
Dim Ars     As New ADODB.Recordset
Dim iLong   As Double
Dim iWidth  As Double
Dim iHigh   As Double
Dim iRow    As Integer
Dim iCol    As Integer

If Trim(cboAreaStorID.Text) = "" Then
    MsgBox "区办信息不能为空", vbInformation, "提示"
    Exit Sub
End If

If Trim(cboStorageID.Text) = "" Then
    MsgBox "仓库名称不能为空", vbInformation, "提示"
    Exit Sub
End If

If Trim(cboAreaID.Text) = "" Then
    MsgBox "区域编号不能为空", vbInformation, "提示"
    Exit Sub
End If

If Trim(txtPlaceID.Text) = "" Then
    MsgBox "储位编号不能为空", vbInformation, "提示"
    Exit Sub
End If

If Trim(txtPlaceName.Text) = "" Then
    MsgBox "储位名称不能为空", vbInformation, "提示"
    Exit Sub
End If

'查询同一大类下面的小类名称是否已存在
sql = "Select PlaceName from Place Where AreaStorID='" & Trim(cboAreaStorID.Text) & "' and StorageID='" & Trim(cboStorageID.Text) & "' and AreaID='" & Trim(cboAreaID.Text) & "' and PlaceName='" & Trim(txtPlaceName.Text) & "' and PlaceID<>'" & Trim(txtPlaceID.Text) & "'"
Set Ars = SQLDB.Execute(sql)
If Not Ars.EOF Then
    MsgBox "当前区办下的仓库储位名称已存在，不能重复添加", vbInformation, "提示"
    Exit Sub
End If

If Trim(txtLong.Text) = "" Then
    iLong = 0
Else
    iLong = Trim(txtLong.Text)
End If

If Trim(txtWidth.Text) = "" Then
    iWidth = 0
Else
    Width = Trim(txtWidth.Text)
End If

If Trim(txtHigh.Text) = "" Then
    iHigh = 0
Else
    iHigh = Trim(txtHigh.Text)
End If

iRow = Trim(txtRow.Text)
iCol = Trim(txtCol.Text)

On Error GoTo ErrShow
SQLDB.BeginTrans
    '添加主表信息
    Asql = "Update Place set PlaceName='" & Trim(txtPlaceName.Text) & "',long=" & iLong & "," & _
            "width=" & iWidth & ",high=" & iHigh & ",Remark='" & Trim(txtRemark.Text) & "',Row=" & iRow & ",Col=" & iCol & " Where " & _
            "AreaStorID='" & Trim(cboAreaStorID.Text) & "' and StorageID='" & Trim(cboStorageID.Text) & "' " & _
            "and AreaID='" & Trim(cboAreaID.Text) & "' " & _
            "and PlaceID<>'" & Trim(txtPlaceID.Text) & "'"
    SQLDB.Execute Asql
SQLDB.CommitTrans
InitClear
frmMQPlace.QuerySalesRoom
MsgBox "添加成功", vbInformation, "提示"
Exit Sub
ErrShow:
    SQLDB.RollbackTrans
    MsgBox "添加储位信息出错" & err.Description, vbInformation, "提示"
End Sub

Private Sub InitClear()
'清空文本柜数据
    txtPlaceID.Text = ""
    txtPlaceName.Text = ""
    txtLong.Text = 0
    txtWidth.Text = 0
    txtHigh.Text = 0
    txtRemark.Text = ""
End Sub

Private Sub Initcbo()
'初使化区办信息
Dim sql As String
Dim Ars As New ADODB.Recordset

sql = "Select AreaStorID from AreaStor "
Set Ars = SQLDB.Execute(sql)

Do While Not Ars.EOF
    cboAreaStorID.AddItem Ars("AreaStorID")
Ars.MoveNext
    cboAreaStorID.ListIndex = 0
Loop

If Trim(cboAreaStorID.Text) <> "" Then
    cboStorageID.Clear
    sql = "Select StorageID from Storage Where AreaStorID='" & Trim(cboAreaStorID.Text) & "'"
    Set Ars = SQLDB.Execute(sql)
    
    Do While Not Ars.EOF
        cboStorageID.AddItem Ars("StorageID")
    Ars.MoveNext
        cboStorageID.ListIndex = 0
    Loop
End If

If Trim(cboAreaStorID.Text) <> "" And Trim(cboStorageID.Text) <> "" Then
    cboAreaID.Clear
    sql = "select AreaID from Area Where AreaStorID='" & Trim(cboAreaStorID.Text) & "' and StorageID='" & Trim(cboStorageID.Text) & "'"
    Set Ars = SQLDB.Execute(sql)

    Do While Not Ars.EOF
        cboAreaID.AddItem Ars("AreaID")
    Ars.MoveNext
    cboAreaID.ListIndex = 0
    Loop
End If

End Sub