frmwareslist.frm

针对农资系统的管理模式而开发的业务部门与财务部门的转账模式和过程

    End With
    
    With grdList
        Set .DataSource = m_DatListRs
        sGrdWidth = GetPrivateSetting(Me.Caption, "GrdWidth", "")
        .RowHeight = GetPrivateSetting(Me.Caption, "GrdHeight", "275")
        
        i = 0
        .Columns(i).Caption = "本级代码"
        SetColumnWidth sGrdWidth, .Columns(i), 800
        ThisCodeCol = i
        i = i + 1
        .Columns(i).Caption = "商品代码"
        SetColumnWidth sGrdWidth, .Columns(i), 1000
        .Columns(CodeCol).Locked = True
        CodeCol = i
        i = i + 1
        .Columns(i).Caption = "名称"
        SetColumnWidth sGrdWidth, .Columns(i), 1650
        NameCol = i
        i = i + 1
        .Columns(i).Caption = "规格"
        SetColumnWidth sGrdWidth, .Columns(i), 1000
        SpecCol = i
        i = i + 1
        .Columns(i).Caption = "计量单位"
        SetColumnWidth sGrdWidth, .Columns(i), 800
        MeasCol = i
        i = i + 1
        .Columns(i).Caption = "计价方法"
        SetColumnWidth sGrdWidth, .Columns(i), 1000
        ModeNameCol = i
        i = i + 1
        .Columns(i).Caption = "产地"
        SetColumnWidth sGrdWidth, .Columns(i), 1200
        AreaCol = i
        
        For j = i + 1 To i + 2      'FPriceMode, FMaster
            .Columns(j).Visible = False
            .Columns(j).AllowSizing = False
            SetColumnWidth sGrdWidth, .Columns(j), 0
        Next
        ModeCol = i + 1
        FLagCol = i + 2
    End With
    
    SetOkCheck
End Sub

Private Sub cmdAddList_Click()
    With grdList
        .SetFocus
        If .AddNewMode = dbgNoAddNew Then
            If m_DatListRs.RecordCount > 0 Then
                .Bookmark = m_DatListRs.RecordCount
            End If
            SendKeys "{Down}"
            SendKeys "{Home}"
        End If
    End With
End Sub

Private Sub cmdDelList_Click()
    If m_DatListRs.EOF Or m_DatListRs.BOF Or grdList.AddNewMode <> dbgNoAddNew Then
        Exit Sub
    End If
    
    Dim sTempSql As String, nRet As Integer
    
    sTempSql = "Select Top 1 * From Balance Where FWaresCode = '" & grdList.Columns(CodeCol).Text & "'"
    If Not RsIsEmpty(sTempSql) Then
        MsgBox "该商品已有库存帐，不能删除！", vbInformation + vbOKOnly, "提示："
    Else
        nRet = MsgBox("您真的要删除当前商品信息吗？", vbQuestion + vbYesNo + vbDefaultButton2, "提示：")
        If nRet = vbYes Then
            m_DatListRs.Delete adAffectCurrent
            
            SetOkCheck
        End If
    End If
End Sub

Private Sub grdList_AfterColUpdate(ByVal ColIndex As Integer)
    With grdList
        If ColIndex = ThisCodeCol Then
            .Columns(CodeCol).Text = GetTypeCode(trvType.SelectedItem.Key) & .Columns(ThisCodeCol).Text
            .Col = CodeCol
        End If
    End With
End Sub

Private Sub grdList_BeforeColEdit(ByVal ColIndex As Integer, ByVal KeyAscii As Integer, Cancel As Integer)
    If ColIndex = ModeNameCol Then
        grdList.Columns(ColIndex).Locked = True
        Cancel = True
        grdList_ButtonClick (ColIndex)
        grdList.Columns(ColIndex).Locked = False
    End If
End Sub

Private Sub grdList_BeforeColUpdate(ByVal ColIndex As Integer, OldValue As Variant, Cancel As Integer)
    Dim sCode As String, sTempSql As String
    With grdList
        If ColIndex = ThisCodeCol Then
            If Not IsNumeric(.Text) Or Len(.Text) <> GetNextSeriesLength(m_sParentCode) Then 'lz
                Cancel = True
                
            ElseIf .Text <> OldValue Then     '代码改变, 检查代码合法性
                sCode = GetTypeCode(trvType.SelectedItem.Key)
                If FieldIsRepeat(m_DatListRs.Clone, "FWaresCode = '" & sCode & .Text & "'") Then
                    MsgBox "商品代码重复，请修改！", vbInformation + vbOKOnly, "提示："
                    Cancel = True
                    Me.SetFocus
                    
                ElseIf Not UpdateWaresCode(sCode & OldValue, sCode & .Text) Then    '连锁更新商品代码
                    MsgBox "商品代码更新不成功，请重新修改！", vbInformation + vbOKOnly, "提示："
                    Cancel = True
                    Me.SetFocus
                    
                End If
            End If
            
        ElseIf ColIndex = NameCol Then
            If Trim(.Text) = "" Then
                Cancel = True
            End If
            
        End If
    End With
End Sub

Private Sub grdList_BeforeUpdate(Cancel As Integer)
    With grdList
        If .AddNewMode = dbgAddNewPending Then
            If .Columns(ThisCodeCol).Text = "" Or .Columns(NameCol).Text = "" Then
                .DataChanged = False
                Cancel = True
            Else
                .Columns(ModeCol).Text = FIFO_MODE      '默认先进先出方式
                .Columns(FLagCol).Text = False
                
                SetOkCheck
            End If
        End If
    End With
End Sub

Private Sub grdList_ButtonClick(ByVal ColIndex As Integer)
    If ColIndex = ModeNameCol Then
        With grdList
            If .Columns(ThisCodeCol).Text = "" Or .Columns(NameCol).Text = "" Then
                Exit Sub
            End If
            
            Dim sTempSql As String
            sTempSql = "Select Top 1 * From Ledger Where FWaresCode = '" & grdList.Columns(CodeCol).Text & "' And FYear = " & m_gnYear & " And FMonth = " & m_gbyMonth
            If Not RsIsEmpty(sTempSql) Then
                MsgBox "该商品已有库存帐，不能改变计价方法！", vbInformation + vbOKOnly, "提示："
                Exit Sub
            End If
            
            lstMode.Top = FrameList.Top + .Top + .RowTop(.Row) + .RowHeight
            If lstMode.Top + lstMode.Height > Me.Height Then
                lstMode.Top = lstMode.Top - lstMode.Height - .RowHeight
            End If
            lstMode.Left = FrameList.Left + .Left + .Columns(ColIndex).Left
            lstMode.Width = .Columns(ColIndex).Width
            lstMode.Visible = True
            lstMode.SetFocus
            lstMode.BoundText = 0
        End With
    End If
End Sub

Private Sub grdList_Error(ByVal DataError As Integer, Response As Integer)
    Response = 0
End Sub

Private Sub grdList_LostFocus()
    If TypeOf Me.ActiveControl Is DataList Then Exit Sub
    On Error GoTo Error_Handler
    
    If Not grdList.AddNewMode = dbgAddNewCurrent Then
        m_DatListRs.Update
    End If

    If Not grdList.AddNewMode = dbgNoAddNew Then
        m_DatListRs.MoveLast
    End If

Error_Handler:
End Sub

Private Sub grdList_RowResize(Cancel As Integer)
    If grdList.RowHeight < 200 Then
        grdList.RowHeight = 200
    ElseIf grdList.RowHeight > grdList.Height / 2 Then
        grdList.RowHeight = grdList.Height / 2
    End If
    
    SavePrivateSetting Me.Caption, "GrdHeight", grdList.RowHeight
End Sub

Private Sub grdList_ColResize(ByVal ColIndex As Integer, Cancel As Integer)
    If grdList.VisibleCols = 0 Then
        Cancel = True
    Else
        SaveGridColWidth Me.Caption, grdList
    End If
End Sub

'///////////////////////////////////////////////
'//
Private Sub lstMode_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    lstMode_KeyPress (13)
End Sub

Private Sub lstMode_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        With grdList
'            .Col = ModeCol
'            .Text = lstMode.BoundText
            .Columns(ModeCol).Text = lstMode.BoundText
            On Error Resume Next
            m_DatListRs.Update
            .SetFocus
        End With
    End If
End Sub

Private Sub lstMode_LostFocus()
    lstMode.Visible = False
End Sub

'///////////////////////////////////////////////
'//
Private Function UpdateWaresCode(sOldCode As Variant, sNewCode As String) As Boolean
    UpdateWaresCode = True
    If sOldCode = "" Then Exit Function
    
    Dim arTable(0 To 6) As String, i As Integer
    arTable(0) = "Balance"
    arTable(1) = "Ledger"
    arTable(2) = "StockUpDetail"
    arTable(3) = "SellDetail"
    arTable(4) = "InDetail"
    arTable(5) = "OutDetail"
    arTable(6) = "TranDetail"
    
    On Error GoTo Error_Handler
    m_gDBCnn.BeginTrans
    
    For i = 0 To UBound(arTable)
        m_gDBCnn.Execute "Update " & arTable(i) & " Set FWaresCode = '" & sNewCode & "' Where FWaresCode = '" & sOldCode & "'"
    Next
    
    m_gDBCnn.CommitTrans
    Exit Function
    
Error_Handler:
    m_gDBCnn.RollbackTrans
    UpdateWaresCode = False
End Function

'////////////////////////////////////////////////
'//
Private Sub cmdPrintList_Click()
    Let frmPrint.Initial(Me.Caption, Me.GrdColumns) = Me
    frmPrint.Show vbModal
End Sub

Property Get GrdColumns() As Object
    Set GrdColumns = grdList.Columns
End Property

Property Get DataType() As String
    DataType = "Grid"
End Property

Property Get PrintCaption() As String
    PrintCaption = lblTitle(0).Caption
End Property

Public Sub PrintMe(ByRef PrintObj As Object, Optional sRangeInfo As String)
    If sRangeInfo = "" Then
        PrintTable grdList, m_DatListRs, Me, True, PrintObj, False
    Else
        Dim nFromPage As Integer, nEndPage As Integer
        Do While Len(sRangeInfo) > 0
            GetFromToEndPageNo sRangeInfo, nFromPage, nEndPage  '三个参数均传址调用
            PrintTable grdList, m_DatListRs, Me, False, PrintObj, False, nFromPage, nEndPage
        Loop
    End If
End Sub

Public Sub PrintHeader(PrintObj As Object, LMargin As Integer, T_PWidth As Integer)
    Dim sTemp As String

    sTemp = GetFullTypeName(trvType.SelectedItem)
    If sTemp <> "" Then
        PrintObj.Print
        PrintObj.CurrentX = LMargin
        PrintObj.Print "商品类别名称: " & sTemp;
    End If
End Sub

Public Sub PrintTail(PrintObj As Object, LMargin As Integer, T_PWidth As Integer, T_PHeight As Integer, Row_Height As Integer, nCurPage As Integer, nTotalPage As Integer)
    Dim sTailText As String
    
    PrintObj.Print
    sTailText = "<高特软件>"
    PrintObj.CurrentX = LMargin + 5
    PrintObj.Print sTailText;
    sTailText = Format(m_gLoginDate, "打印日期：YYYY年MM月DD日") & "  第" & nCurPage & "/" & nTotalPage & "页"
    PrintObj.CurrentX = LMargin + T_PWidth - PrintObj.TextWidth(sTailText) - 5
    PrintObj.Print sTailText
End Sub

Property Get RowTailCount() As Integer
    RowTailCount = 2
End Property