clsstriprigout.cls

金算盘软件代码

        Dim i As Integer
        i = 1
        '将组件最小单位的数量转换为当前组件商品的单位的数量
        dblNewFactorOfC = ConvertFactor(!lngCombinationUnitID, ItemID)
        Quantity = NumberConvert(Quantity, dblNewFactorOfC, False)
        
        Do While Not .EOF
            
            dblFactorOfCombinUnit = ConvertFactor(!lngPartUnitID, !lngpartitemid)
            dblFactor = ConvertFactor(!lngStockUnitID, !lngpartitemid)
            
            For i = 1 To frmName.GrdCol.Rows - 1
                If C2lng(frmName.GrdCol.TextMatrix(i, ColOrder.coItemID)) = !lngpartitemid Then
                    blnFinded = True
                    GoTo FindOK
                End If
            Next i
            '原GRD上未有本商品
            InsertARow False
            blnFinded = False
            i = frmName.GrdCol.Rows - 1
FindOK:
            If (Not blnOnlyQuantity) Or blnFinded = False Then
                frmName.GrdCol.TextMatrix(i, ColOrder.coItemNameAndStyle) = IDtoName(!lngpartitemid, "Item")
                frmName.GrdCol.TextMatrix(i, ColOrder.coItemID) = !lngpartitemid
                frmName.GrdCol.TextMatrix(i, ColOrder.coItemUnit) = IDtoName(!lngStockUnitID, "ItemUnit")
                frmName.GrdCol.TextMatrix(i, ColOrder.coItemUnitID) = !lngStockUnitID
                frmName.GrdCol.TextMatrix(i, ColOrder.coValidDay) = IIf(!intValidDay <> 0, !intValidDay, "")
                '给出默认货位
                If C2lng(frmName.GrdCol.TextMatrix(i, ColOrder.coItemPosition)) = 0 Then
                    frmName.GrdCol.TextMatrix(i, ColOrder.coItemPosition) = IIf(!lngPositionID = 0, "", !strPositionCode & " " & !strPositionName)
                    frmName.GrdCol.TextMatrix(i, ColOrder.coItemPositionID) = !lngPositionID
                End If
                frmName.GrdCol.TextMatrix(i, ColOrder.coDblFactor) = dblFactor
                
'                Dim lngPositionID As Long, strPositionName As String
'                GetPositionInfo !lngPartItemID, lngPositionID, strPositionName
                'frmName.grdCol.TextMatrix(i, ColOrder.coDblFactor) = ConvertFactor( _
                '                                                          lngStockUnitID, _
                '                                                            !lngPartItemID)
            End If
            
            dblTmp = Quantity * !intQuantity
            strTmp = dblTmp
'            strTmp = DisplayData(frmName.hwnd, strTmp, dblFactorOfCombinUnit)  '部件数量规范
'            strTmp = NumberConvert(strTmp, dblFactorOfCombinUnit, True) '部件MIN UNIT数量
            strTmp = NumberConvert(strTmp, dblFactor, False)  '部件赏用单位数量
            frmName.GrdCol.TextMatrix(i, ColOrder.coItemQuantity) = strTmp
'            If blnIsMultiply Then
'                frmName.grdCol.TextMatrix(i, ColOrder.coItemQuantity) = NumberConvert(Quantity * !intQuantity _
'                    , frmName.grdCol.TextMatrix(i, ColOrder.coDblFactor), False)
'            Else
'                frmName.grdCol.TextMatrix(i, ColOrder.coItemQuantity) = NumberConvert(Quantity * !intQuantity /dblfactor _ ' C2Dbl(frmName.grdCol.TextMatrix(1, ColOrder.coDblFactor)) _
'                    , frmName.grdCol.TextMatrix(i, ColOrder.coDblFactor), False)'
'                frmName.grdCol.TextMatrix(i, ColOrder.coItemQuantity) = NumberConvert(Quantity * !intQuantity / dblFactor _
'                    , frmName.grdCol.TextMatrix(i, ColOrder.coDblFactor), False)'
'            End If
             .MoveNext
        Loop
    End With
    setAllItemproperty
    setAllItemproperty False
EndProc:
    If Not rst Is Nothing Then rst.Close
End Sub

Private Sub DisplayUnit(ByVal ItemID As Long)
    Dim rst As rdoResultset
    Dim strSql As String
    Dim strUnitName As String
    
    strSql = "SELECT  ItemUnit.strUnitName ,ItemUnit.lngUnitID  FROM ItemCombination  " _
            & ",ItemUnit " _
            & "WHERE ItemCombination.lngCombinationItemID=ItemUnit.lngItemID AND ItemCombination.lngCombinationUnitID=ItemUnit.lngUnitID AND ItemCombination.lngCombinationItemID=" & ItemID
    Set rst = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With rst
        If Not .EOF Then
            .MoveFirst
            frmName.grdCol1.TextMatrix(1, ColOrder.coItemUnitID) = !lngUnitID
            frmName.grdCol1.TextMatrix(1, ColOrder.coItemUnit) = !strUnitName
        End If
    End With
    
    strSql = "SELECT Item.lngPositionID,Position.strPositionCode,Position.strPositionName  FROM Item " _
        & ",Position " _
        & " WHERE Item.lngPositionID=Position.lngPositionID AND Item.lngItemID=" & ItemID
    Set rst = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With rst
        If Not .EOF Then
            .MoveFirst
            frmName.grdCol1.TextMatrix(1, ColOrder.coItemPositionID) = !lngPositionID
            frmName.grdCol1.TextMatrix(1, ColOrder.coItemPosition) = !strPositionCode & " " & !strPositionName
        End If
    End With
    If Not rst Is Nothing Then
        rst.Close
        Set rst = Nothing
    End If
End Sub

Public Property Get DropButtonWidth() As Integer
     DropButtonWidth = intButtonWidth
End Property

Private Sub GetPositionInfo(ByVal ItemID As Long, lngPositionID As Long, strPositionName As String)
    Dim strSql As String
    Dim rst As rdoResultset
    
    strSql = "SELECT Item.lngPositionID,Position.strPositionCode,Position.strPositionName " _
        & " FROM Item INNER JOIN Position ON Item.lngPositionID=Position.lngPositionID " _
        & " WHERE Item.lngItemID=" & ItemID
    Set rst = gclsBase.BaseDB.OpenResultset(strSql)
    With rst
        If Not .EOF Then
            lngPositionID = !lngPositionID
            strPositionName = !strPositionCode & " " & !strPositionName
        Else
            lngPositionID = 0
            strPositionName = ""
        End If
    End With
    If Not rst Is Nothing Then
        rst.Close
        Set rst = Nothing
    End If
    
End Sub

Private Function IDtoName(ByVal ItemID As String, ByVal strTable As String) As String
    Dim strSql As String
    Dim rst As rdoResultset
        
    Select Case strTable
    Case "Item"
        strSql = "SELECT strItemCode,strItemStyle,strItemName FROM  Item WHERE lngItemID=" & ItemID
    Case "ItemUnit"
        strSql = "SELECT strUnitName FROM ItemUnit WHERE lngUnitID=" & ItemID
    End Select
    Set rst = gclsBase.BaseDB.OpenResultset(strSql)
    If Not rst.EOF Then
        With rst
            Select Case strTable
                Case "Item"
                    IDtoName = Trim(!strItemCode) & "  " & Trim(!strItemName) & "  " & Trim(!strItemStyle)
                Case "ItemUnit"
                    IDtoName = IIf(IsNull(!strUnitName), "", Trim(!strUnitName))
            End Select
        End With
    End If
    If Not rst Is Nothing Then
        rst.Close
        Set rst = Nothing
    End If
End Function

Private Function NodataInGrid(ByVal objGrid As MSFlexGrid) As Boolean
    NodataInGrid = False
    If objGrid.Rows = 1 Then
        NodataInGrid = True
        Exit Function
    End If
    With objGrid
        If Len(Trim(.TextMatrix(1, 1))) = 0 Then '商品
            NodataInGrid = True
            Exit Function
        End If
        If Len(Trim(.TextMatrix(1, 2))) = 0 Then '单位
            NodataInGrid = True
            Exit Function
        End If
        If Len(Trim(.TextMatrix(1, 3))) = 0 Then '货位
            NodataInGrid = True
            Exit Function
        End If
        If Len(Trim(.TextMatrix(1, 4))) = 0 Then '数量
            NodataInGrid = True
            Exit Function
        End If
    End With
End Function

'单据类型属性
Public Property Let ReceiptTypeID(ByVal vData As Integer)
   Let intReceiptTypeID = vData
End Property

Public Property Get ReceiptTypeID() As Integer
     ReceiptTypeID = intReceiptTypeID
End Property
'是否绑定控件属性
Public Property Let blnCtrlBinding(ByVal vData As Boolean)
   Let My.blnCtrlBinding = vData
End Property
Public Property Get blnCtrlBinding() As Boolean
     blnCtrlBinding = My.blnCtrlBinding
End Property
'当前单据ID 属性
Public Property Let lngNowID(ByVal vData As Long)
   Let My.lngNowID = vData
End Property
Public Property Get lngNowID() As Long
     lngNowID = My.lngNowID
End Property
'当前输入区域属性
Public Property Let bytRegion(ByVal vData As Byte)
   Let My.bytRegion = vData
End Property
Public Property Get bytRegion() As Byte
     bytRegion = My.bytRegion
End Property
'当前输入区域序号属性
Public Property Let bytIndex(ByVal vData As Byte)
   Let My.bytIndex = vData
End Property

Public Property Get bytIndex() As Byte
     bytIndex = My.bytIndex
End Property

'数据是否改变属性
Public Property Let blnIsChanged(ByVal vData As Boolean)
   Let My.blnIsChanged = vData
End Property
Public Property Get blnIsChanged() As Boolean
     blnIsChanged = My.blnIsChanged
End Property
'窗体是否刷新属性
Public Property Let blnRefresh(ByVal vData As Boolean)
   Let My.blnRefresh = vData
End Property
Public Property Get blnRefresh() As Boolean
    blnRefresh = My.blnRefresh
End Property
'是否可行粘贴属性
Public Property Let blnPasteRec(ByVal vData As Boolean)
   Let My.blnPasteRec = vData
End Property
Public Property Get blnPasteRec() As Boolean
    blnPasteRec = My.blnPasteRec
End Property
'是否可删除属性
Public Property Let blnMayDelete(ByVal vData As Boolean)
   Let My.blnMayDelete = vData
   Let My.blnMayChange = vData
End Property
Public Property Get blnMayDelete() As Boolean
    blnMayDelete = My.blnMayDelete
End Property
'是否触发CHANGE事件属性
Public Property Let blnChangeEvent(ByVal vData As Boolean)
   Let My.blnChangeEvent = vData
End Property
Public Property Get blnChangeEvent() As Boolean
    blnChangeEvent = My.blnChangeEvent
End Property
    
'会计年度属性
Public Property Let intAccountYear(ByVal vData As Integer)
   Let My.intAccountYear = vData
End Property
Public Property Get intAccountYear() As Integer
    intAccountYear = My.intAccountYear
End Property
'会计期间属性
Public Property Let bytAccountPeriod(ByVal vData As Byte)
   Let My.bytAccountPeriod = vData
End Property
Public Property Get bytAccountPeriod() As Byte
    bytAccountPeriod = My.bytAccountPeriod
End Property
'GRD原列号属性
Public Property Let lngOldCol(ByVal vData As Long)
   Let My.lngOldCol = vData
End Property
Public Property Get lngOldCol() As Long
    lngOldCol = My.lngOldCol
End Property
'GRD原行号属性
Public Property Let lngOldRow(ByVal vData As Long)
   Let My.lngOldRow = vData
End Property
Public Property Get lngOldRow() As Long
    lngOldRow = My.lngOldRow
End Property
    
Public Property Get grdBorderWidth() As Integer
'当检索属性值时在参数右边使用。
'Syntax: Debug.Print X.grdBorderWidth
    grdBorderWidth = intGrdBorderWidth
End Property
Public Property Set Form(ByVal vData As Form)
'当把对象赋值给属性时在 Set 语句左边使用。
'Syntax: Set x.GridName = Form1
    Set frmName = vData
    NewQ.SetWin frmName.picInput.hWnd
    
    My.blnIsChanged = False
    My.bytRegion = FcmdButton
    My.bytIndex = 0
    
    '设置窗体颜色
    SetFormColor fccolor
    SeparateLineColor = fccolor.lngGridLineColor
    ApplyFormColor frmName, fccolor
    
    Set clsRecord = New RecordClass
    '给GRDCOL设HOOK
    Set mclsSubClass = New SubClass32.SubClass
    mclsSubClass.hWnd = frmName.GrdCol.hWnd
    mclsSubClass.Messages(WM_PAINT) = True
    mclsSubClass.Messages(WM_LBUTTONDOWN) = True
    mclsSubClass.Messages(WM_LBUTTONUP) = True
    
    '给GRDCOL设HOOK
    Set mclsSubClass1 = New SubClass32.SubClass
    mclsSubClass1.hWnd = frmName.grdCol1.hWnd
    mclsSubClass1.Messages(WM_PAINT) = True
    mclsSubClass1.Messages(WM_LBUTTONDOWN) = True
    mclsSubClass1.Messages(WM_LBUTTONUP) = True

    Set mclsHook = New SubClass32.SubClass
    mclsHook.hWnd = frmName.hWnd
    mclsHook.Messages(WM_PAINT) = True
    mclsHook.Messages(WM_KEYUP) = True
    mclsHook.Messages(WM_GETMINMAXINFO) = True
    Set HookHe = New Hook
    HookHe.SetHookAll frmName.hWnd
    If gclsBase Is Nothing Then GoTo InvalidExit
    My.intAccountYear = gclsBase.FYearOfDate(gclsBase.BaseDate)    '会计年度
    My.bytAccountPeriod = gclsBase.PeriodOfDate(gclsBase.BaseDate)   '会计期间
    My.blnCtrlBinding = True
    My.blnRefresh = False
    My.blnPasteRec = False