frmadaptcard.frm

金算盘软件代码

            With msgItem
            For i = 1 To .Rows - 1
                If .TextMatrix(i, 1) = "√" Then
                    iSelNum = iSelNum + 1
                    If iSelNum = 1 Then strCon1 = .TextMatrix(i, 2)
                    strID = strID & "," & .TextMatrix(i, 0)
                    strCon = Trim(strCon) & " " & StringOut(.TextMatrix(i, 2))
                End If
            Next i
            strID = Mid(strID, 2)
            If iSelNum = 0 Then
                strCon = ""
            ElseIf iSelNum = 1 Then
                strCon = "商品/" & strCon1 & "/" & strID
            Else
                strCon = "商品/" & strCon & "/" & strID
            End If
            If mclsGrid.ListSet.ListID < 1 Then mclsGrid.ListSet.SaveList
            mclsGrid.ListSet.RefreshWhere
            strWhereOf = Filter.ShowFilter(mclsGrid.ListSet.ListID, 1, , 0, , , blnOK, strCon, "条件选择")
            If Not blnOK Then Exit Sub
            Set recTemplete = GetRecordset(cboItem(0).ItemData(cboItem(0).ListIndex), strWhereOf)
            For i = 1 To .Rows - 1
NextRow:        If recTemplete.EOF Then
                    .TextMatrix(i, 1) = ""
                Else
                    If recTemplete!ID = .TextMatrix(i, 0) Then
                        .TextMatrix(i, 1) = "√"
                        recTemplete.MoveNext
                    ElseIf recTemplete!ID < .TextMatrix(i, 0) Then
                        .TextMatrix(i, 1) = ""
                        recTemplete.MoveNext
                        GoTo NextRow
                    Else
                        .TextMatrix(i, 1) = ""
                    End If
                End If
            Next
            End With
            recTemplete.Close
            RefreshGrid
            Filter.DelSelectedCond mclsGrid.ListSet.ListID, 1
        Case 4  '全部取消
            If msgItem.Rows = 1 Then Exit Sub
            For i = 1 To msgItem.Rows - 1
                msgItem.TextMatrix(i, 1) = ""
            Next i
            mintSelCount = 0
            SetButton
        Case 5  '复制单价
            Set frmCopyPrice.FlexGrid = msgItem
            frmCopyPrice.colNo = GetColNO
            frmCopyPrice.Dec = mbytDec
            frmCopyPrice.Show vbModal
            Set frmCopyPrice = Nothing
        Case 6 '固定单价
            Set frmFixPrice.FlexGrid = msgItem
            frmFixPrice.Dec = mbytDec
            frmFixPrice.colNo = GetColNO
            frmFixPrice.Show vbModal
            Set frmFixPrice = Nothing
        Case 7 '填充单价
            Set frmFillPrice.msgUpdatePrice = msgItem
            frmFillPrice.colNo = GetColNO
            frmFillPrice.ScolNo = GetColNO(True)
            frmFillPrice.Dec = mbytDec
            frmFillPrice.RowNo = mlngRow
            frmFillPrice.Show vbModal
            Set frmFillPrice = Nothing
        Case 8 '栏目设置
            strID = ""
            With msgItem
            For i = 1 To .Rows - 1
                If .TextMatrix(i, 1) = "√" Then strID = strID & " " & .TextMatrix(i, 0)
            Next i
            If mclsGrid.ListSet.ShowListSet(mintViewId) Then
                If mblnIsChanged Then
                    If ShowMsg(Me.hwnd, "您要保存调整的价格吗?", vbYesNo + vbQuestion, Caption) = vbYes Then
                        SaveCard
                    End If
                End If
                InitGrid cboItem(1).ListIndex = 0
            End If
            For i = 1 To .Rows - 1
                If InStr(1, strID, .TextMatrix(i, 0)) <> 0 Then .TextMatrix(i, 1) = "√"
            Next i
            End With
            SetCboItem
    End Select
End Sub

Private Sub SetColWidth()
    Dim b As Byte, strColWidth As String
    
    strColWidth = GetSetting(App.Path, "Adjust", "ColWidth", "")
    If strColWidth = "" Then
        For b = 2 To msgItem.Cols - 1
            msgItem.ColWidth(b) = 1120
        Next b
    Else
        For b = 2 To msgItem.Cols - 1
            msgItem.ColWidth(b) = TxtToDouble(StringOut(strColWidth, ","))
        Next b
    End If
End Sub

Private Sub SaveColWidth()
    Dim b As Byte, strColWidth As String
    
    strColWidth = msgItem.ColWidth(2)
    For b = 3 To msgItem.Cols - 1
        strColWidth = strColWidth & "," & msgItem.ColWidth(b)
    Next b
    SaveSetting App.Path, "Adjust", "ColWidth", strColWidth
End Sub

Private Sub Form_Activate()
    Static blnX As Boolean
    
    If Not blnX Then
        SetHelpID 11001
        InitGrid True
        blnX = True
    End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        BKKEY Me.ActiveControl.hwnd, vbKeyTab
    End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn And Shift = 2 Then
        cmdOK(0).Value = True
    End If
End Sub

Private Sub Form_Load()
    Dim recBusiness As rdoResultset, recItemType As rdoResultset, strSql As String
    Dim edtErrReturn As ErrDealType
    
    On Error GoTo ErrHandle
'    SetHelpID hwnd, 11001

    Utility.LoadFormResPicture Me
    Set mclsGrid = New Grid
    Set mclsGrid.Grid = msgItem
    mclsGrid.ListSet.ViewId = mintViewId
    frmItemList.IsShowCard(2) = True
    
    dtePrice.Value = gclsBase.BaseDate
    mblnIsInit = True
    mblnIsChanged = False
    mblnIsAdjust = False
    mintSelCount = 0
    SetCboItem
    
    strSql = "SELECT * FROM Business"
    Set recBusiness = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recBusiness.EOF Then mbytDec = recBusiness!bytPriceDec
    recBusiness.Close
    
    strSql = "SELECT lngItemTypeID AS ID,strItemTypeCode AS Code,strItemTypeName" _
        & " AS Name FROM ItemType WHERE blnIsInActive=0"
    Set recItemType = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With recItemType
    Do Until .EOF
        cboItem(0).AddItem !Code & "  " & !Name
        cboItem(0).ItemData(cboItem(0).NewIndex) = !ID
        .MoveNext
    Loop
    End With
    mintCol = 6
    cboItem(0).ListIndex = 0
    mlngcboID(0) = 0
    mlngcboID(1) = 0
    SetColWidth
    mblnIsInit = False
    Exit Sub
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload Me
    End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim intResponse As Integer
    
    If mblnIsChanged And UnloadMode = vbFormControlMenu Then
        intResponse = ShowMsg(hwnd, "当前商品价格已被修改，是否保存？", vbYesNoCancel + vbQuestion, Caption)
        If intResponse = vbYes Then
            Cancel = Not SaveCard()
        ElseIf intResponse = vbCancel Then
            Cancel = True
        End If
    End If
End Sub

Private Sub Form_Resize()
    Dim i As Integer

    If Me.WindowState = vbMinimized Then
        Exit Sub
    End If
    For i = 0 To 8
        cmdOK(i).Left = Me.ScaleWidth - cmdOK(0).width - 80
    Next i
    msgItem.width = Me.ScaleWidth - cmdOK(0).width - 280
    msgItem.Height = Me.ScaleHeight - cboItem(0).Height - 300
'    cboItem(1).Left = msgItem.Left + msgItem.width - cboItem(1).width
'    lblItem(1).Left = cboItem(1).Left - lblItem(1).width - 10
End Sub

Private Function GetColNO(Optional ByVal blnIsFillS As Boolean = False) As Integer
    Dim i As Integer, strColName As String
    
    Select Case mstrArr(cboItem(1).ListIndex)
    Case "Plan": strColName = "Item.dblPlanPrice"
    Case "Purchase": strColName = "Item.dblPurchasePrice1"
    Case "Sale": strColName = "Item.dblSalePrice1"
    Case "Retain": strColName = "Item.dblRetainPrice"
    End Select
    For i = 1 To mclsGrid.ListSet.Columns
        If blnIsFillS Then
            If mclsGrid.ListSet.ColumnFieldName(i - 1) = strColName Then Exit For
        Else
            If mclsGrid.ListSet.ColumnFieldName(i - 1) = "' '" Then Exit For
        End If
    Next i
    GetColNO = i
End Function

Private Sub RefreshGrid()
    Dim iRow As Integer, iCol As Integer
    
    With msgItem
    For iRow = 1 To .Rows - 1
        For iCol = 1 To mclsGrid.ListSet.Columns
            If InStr(1, mclsGrid.ListSet.ColumnFieldName(iCol), "dbl") > 0 Then
                .TextMatrix(iRow, iCol + 1) = IIf(.TextMatrix(iRow, iCol + 1) = "0", "", FormatShow(.TextMatrix(iRow, iCol + 1), mbytDec))
            End If
        Next iCol
    Next iRow
    End With
End Sub

Private Sub InitGrid(blnIsSale As Boolean)
    Dim i As Integer, iCol As Integer, strSql As String
    
    msgItem.Cols = 0
    Set datAdjust.Resultset = GetRecordset(cboItem(0).ItemData(cboItem(0).ListIndex))
    If Not datAdjust.Resultset.EOF Then
        mlngRow = 1
        datAdjust.Resultset.MoveLast
        For i = 2 To 4
            cmdOK(i).Enabled = True
        Next i
    Else
        mlngRow = 0
        For i = 2 To 7
            cmdOK(i).Enabled = False
        Next i
    End If
    mclsGrid.SetupStyle
    mclsGrid.ColOfs = 2
    For i = 1 To msgItem.Cols - 1
        msgItem.FixedAlignment(i) = flexAlignCenterCenter
        If InStr(1, msgItem.TextMatrix(0, i), "新") > 0 Then iCol = i
'        If i > 1 And i < msgItem.Cols - 1 Then msgItem.ColWidth(i) = 1120
'        #If conVersionType = 8 Then
'            If Trim(msgItem.TextMatrix(0, i)) = "计划价" Then msgItem.ColWidth(i) = 0
'        #ElseIf conVersionType = 16 Then
'            If Trim(msgItem.TextMatrix(0, i)) = "成本价" Then msgItem.ColWidth(i) = 0
'            If Trim(msgItem.TextMatrix(0, i)) = "计划价" Then msgItem.ColWidth(i) = 0
'            If Trim(msgItem.TextMatrix(0, i)) = "零售价" Then msgItem.ColWidth(i) = 0
'        #End If
    Next i
    msgItem.TextMatrix(0, iCol) = "新" & cboItem(1).list(cboItem(1).ListIndex)
    
    strSql = "UPDATE ViewField SET strViewFieldDesc='" _
        & msgItem.TextMatrix(0, iCol) & "' WHERE lngViewFieldID=12089"
    gclsBase.ExecSQL strSql
    strSql = "UPDATE ListField SET strListFieldDesc='" _
        & msgItem.TextMatrix(0, iCol) & "' WHERE lngViewFieldID=12089"
    gclsBase.ExecSQL strSql
    
    mclsGrid.SetWriteCol msgItem.Cols - 1
    msgItem.ColAlignment(msgItem.Cols - 1) = flexAlignRightCenter
    msgItem.FixedCols = 1
    msgItem.ColWidth(0) = 0
    msgItem.ColWidth(1) = 450
    datAdjust.Resultset.Close
    msgItem.Refresh
    RefreshGrid
    SetButton
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    frmItemList.IsShowCard(2) = False
    Utility.UnLoadFormResPicture Me
    SaveColWidth
    mblnIsChanged = False
    Set mclsGrid = Nothing
End Sub

Private Sub mclsGrid_AfterColChange(lngSourCol As Long, lngDestCol As Long)
    mclsGrid.ListSet.SaveList
    mclsGrid.ListSet.ViewId = mintViewId
End Sub

Private Sub msgItem_DblClick()
    If msgItem.Row = 0 Then Exit Sub
    If InStr(1, msgItem.TextMatrix(0, msgItem.col), "新") > 0 Then EditGrid vbKeySpace
End Sub

Private Sub msgItem_EnterCell()
    With msgItem
    If .Row = 0 Then Exit Sub
    mlngRow = .Row
    End With
End Sub

Private Sub msgItem_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then