⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmselectbill.frm

📁 金算盘软件代码
💻 FRM
📖 第 1 页 / 共 3 页
字号:
    & "Position.strPositionCode||' '||Position.strPositionName as strPosition,Item.lngPositionID," _
    & "Custom0.strCustomCode||' '||Custom0.strCustomName AS strCustom0," _
    & "Custom1.strCustomCode||' '||Custom1.strCustomName AS strCustom1," _
    & "Custom2.strCustomCode||' '||Custom2.strCustomName AS strCustom2," _
    & "Custom3.strCustomCode||' '||Custom3.strCustomName AS strCustom3," _
    & "Custom4.strCustomCode||' '||Custom4.strCustomName AS strCustom4," _
    & "Custom5.strCustomCode||' '||Custom5.strCustomName AS strCustom5,"
        strSql = strSql _
    & "SaleOrderDetail.lngItemID AS lngItemID, SaleOrderDetail.lngUnitID AS lngUnitID," _
    & "ItemUnit.dblFactor AS dblFactor, SaleOrderDetail.dblPrice AS dblPrice,SaleOrderDetail.dblPriceTax AS dblPriceTax, " _
    & "SaleOrderDetail.dblDiscountRate AS dblDiscountRate, SaleOrderDetail.lngTaxID AS lngTaxID, " _
    & "Tax.dblPurchaseTaxRate/100 AS dblTax," _
    & "SaleOrderDetail.lngJobID,SaleOrderDetail.lngCustomID0,SaleOrderDetail.lngCustomID1," _
    & "SaleOrderDetail.lngCustomID2,SaleOrderDetail.lngCustomID3,SaleOrderDetail.lngCustomID4," _
    & "SaleOrderDetail.lngCustomID5,Item.intValidDay "
        strSql = strSql & "FROM SaleOrderDetail,SaleOrder,Item,ItemUnit,Position,Tax,Job," _
    & "Custom0,Custom1,Custom2,Custom3,Custom4,Custom5 "
        strSql = strSql _
    & "WHERE SaleOrderDetail.lngSaleOrderID=SaleOrder.lngSaleOrderID " _
    & "AND SaleOrderDetail.lngItemID = Item.lngItemID(+) " _
    & "AND SaleOrderDetail.lngUnitID = ItemUnit.lngUnitID(+) " _
    & "AND Item.lngPositionID=Position.lngPositionID(+) " _
    & "AND SaleOrderDetail.lngTaxID = Tax.lngTaxID(+) " _
    & "AND SaleOrderDetail.lngJobID = Job.lngJobID(+) " _
    & "AND SaleOrderDetail.lngCustomID0 = Custom0.lngCustomID(+) " _
    & "AND SaleOrderDetail.lngCustomID1 = Custom1.lngCustomID(+) " _
    & "AND SaleOrderDetail.lngCustomID2 = Custom2.lngCustomID(+) " _
    & "AND SaleOrderDetail.lngCustomID3 = Custom3.lngCustomID(+) " _
    & "AND SaleOrderDetail.lngCustomID4 = Custom4.lngCustomID(+) " _
    & "AND SaleOrderDetail.lngCustomID5 = Custom5.lngCustomID(+) " _
    & "AND SaleOrderDetail.lngSaleOrderDetailID = " & GrdCol.RowData(lngRowno)

    Case Else
        strSql = "SELECT Item.strItemCode||' '||Item.strItemName||' '||Item.strItemStyle AS strItem, " _
    & "ItemActivity.strDate AS StrDate,Ltrim(ItemActivity.strReceiptNO||LPAD(ItemActivity.lngReceiptNO,4,'0')) AS ReceiptNO," _
    & "ItemUnit.strUnitName AS strUnit, Tax.strTaxName AS strTax,Job.strJobCode||' '||Job.strJobName AS strJob," _
    & "Position.strPositionCode||' '||Position.strPositionName as strPosition,ItemActivityDetail.lngPositionID," _
    & "Custom0.strCustomCode||' '||Custom0.strCustomName AS strCustom0," _
    & "Custom1.strCustomCode||' '||Custom1.strCustomName AS strCustom1," _
    & "Custom2.strCustomCode||' '||Custom2.strCustomName AS strCustom2," _
    & "Custom3.strCustomCode||' '||Custom3.strCustomName AS strCustom3," _
    & "Custom4.strCustomCode||' '||Custom4.strCustomName AS strCustom4," _
    & "Custom5.strCustomCode||' '||Custom5.strCustomName AS strCustom5,"
        strSql = strSql _
    & "ItemActivityDetail.strProduceNum,ItemActivityDetail.strProduceDate," _
    & "ItemActivityDetail.strValidDate,ItemActivityDetail.intValidDay,"
        strSql = strSql _
    & "ItemActivityDetail.lngItemID AS lngItemID, ItemActivityDetail.lngUnitID AS lngUnitID," _
    & "ItemUnit.dblFactor AS dblFactor, ItemActivityDetail.dblCurrPrice AS dblPrice,ItemActivityDetail.dblCurrPriceTax AS dblPriceTax, " _
    & "ItemActivityDetail.dblDiscountRate AS dblDiscountRate, ItemActivityDetail.lngTaxID AS lngTaxID, " _
    & "Tax.dblPurchaseTaxRate/100 AS dblTax," _
    & "ItemActivityDetail.lngJobID,ItemActivityDetail.lngCustomID0,ItemActivityDetail.lngCustomID1," _
    & "ItemActivityDetail.lngCustomID2,ItemActivityDetail.lngCustomID3,ItemActivityDetail.lngCustomID4," _
    & "ItemActivityDetail.lngCustomID5 "
        strSql = strSql & "FROM ItemActivityDetail,ItemActivity,Item,ItemUnit,Position,Tax,Job," _
    & "Custom0,Custom1,Custom2,Custom3,Custom4,Custom5 "
        strSql = strSql _
    & "WHERE ItemActivityDetail.lngActivityID=ItemActivity.lngActivityID " _
    & "AND ItemActivityDetail.lngItemID = Item.lngItemID(+) " _
    & "AND ItemActivityDetail.lngUnitID = ItemUnit.lngUnitID(+) " _
    & "AND ItemActivityDetail.lngPositionID=Position.lngPositionID(+) " _
    & "AND ItemActivityDetail.lngTaxID = Tax.lngTaxID(+) " _
    & "AND ItemActivityDetail.lngJobID = Job.lngJobID(+) " _
    & "AND ItemActivityDetail.lngCustomID0 = Custom0.lngCustomID(+) " _
    & "AND ItemActivityDetail.lngCustomID1 = Custom1.lngCustomID(+) " _
    & "AND ItemActivityDetail.lngCustomID2 = Custom2.lngCustomID(+) " _
    & "AND ItemActivityDetail.lngCustomID3 = Custom3.lngCustomID(+) " _
    & "AND ItemActivityDetail.lngCustomID4 = Custom4.lngCustomID(+) " _
    & "AND ItemActivityDetail.lngCustomID5 = Custom5.lngCustomID(+) " _
    & "AND ItemActivityDetail.lngActivityDetailID = " & GrdCol.RowData(lngRowno)
    
    End Select
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    If recTmp.BOF And recTmp.EOF Then
        recTmp.Close
        Set recTmp = Nothing
        Exit Sub
    End If
    
    With frmName.GrdCol
        frmName.TextOfGrid(lngWriteRowNO, 1) = recTmp!strItem
        frmName.TextOfGrid(lngWriteRowNO, 2) = strAccountYearPeriodOfDate(recTmp!strDate) & "-" & recTmp!ReceiptNo
        If lngReceiptTypeID > 24 Then
            frmName.TextOfGrid(lngWriteRowNO, 3) = IIf(IsNull(recTmp!strUnit), "", recTmp!strUnit)
            If blnSetInfo Then
                frmName.TextOfGrid(lngWriteRowNO, 4) = IIf(IsNull(recTmp!strTax), "", recTmp!strTax)
                frmName.TextOfGrid(lngWriteRowNO, 22) = IIf(IsNull(recTmp!strJob), "", recTmp!strJob)
                frmName.TextOfGrid(lngWriteRowNO, 23) = IIf(IsNull(recTmp!strCustom0), "", recTmp!strCustom0)
                frmName.TextOfGrid(lngWriteRowNO, 24) = IIf(IsNull(recTmp!strCustom1), "", recTmp!strCustom1)
                frmName.TextOfGrid(lngWriteRowNO, 25) = IIf(IsNull(recTmp!strCustom2), "", recTmp!strCustom2)
                frmName.TextOfGrid(lngWriteRowNO, 26) = IIf(IsNull(recTmp!strCustom3), "", recTmp!strCustom3)
                frmName.TextOfGrid(lngWriteRowNO, 27) = IIf(IsNull(recTmp!strCustom4), "", recTmp!strCustom4)
                frmName.TextOfGrid(lngWriteRowNO, 28) = IIf(IsNull(recTmp!strCustom5), "", recTmp!strCustom5)
                frmName.TextOfGrid(lngWriteRowNO, 29) = recTmp!lngItemID
                frmName.TextOfGrid(lngWriteRowNO, 30) = GrdCol.RowData(lngRowno)
            End If
        Else
            frmName.TextOfGrid(lngWriteRowNO, 4) = IIf(IsNull(recTmp!strUnit), "", recTmp!strUnit)
            If blnSetInfo Then
                Select Case lngReceiptTypeID
                Case 2, 3, 4, 13, 15, 18
                    If C2lng(frmName.TextOfGrid(lngWriteRowNO, 30)) = 0 Then
                        frmName.TextOfGrid(lngWriteRowNO, 3) = IIf(IsNull(recTmp!strPosition), "", recTmp!strPosition)
                    End If
                Case 5, 16, 19, 8, 20
                    frmName.TextOfGrid(lngWriteRowNO, 3) = ""
                Case Else
                    frmName.TextOfGrid(lngWriteRowNO, 3) = IIf(IsNull(recTmp!strPosition), "", recTmp!strPosition)
                End Select
                If lngReceiptTypeID <> 8 And lngReceiptTypeID <> 20 Then
                    frmName.TextOfGrid(lngWriteRowNO, 8) = Format(recTmp!dblDiscountRate, "0.00")
                Else
                    frmName.TextOfGrid(lngWriteRowNO, 8) = "100.00"
                End If
                frmName.TextOfGrid(lngWriteRowNO, 11) = IIf(IsNull(recTmp!strTax), "", recTmp!strTax)
                Select Case lngReceiptTypeID
                Case 2, 3, 4, 13, 15, 18
                    frmName.TextOfGrid(lngWriteRowNO, 20) = IIf(recTmp!intValidDay = 0, "", recTmp!intValidDay)
                Case Else
                    frmName.TextOfGrid(lngWriteRowNO, 17) = recTmp!strProduceNum
                    frmName.TextOfGrid(lngWriteRowNO, 18) = recTmp!strProduceDate
                    frmName.TextOfGrid(lngWriteRowNO, 19) = recTmp!strValidDate
                    frmName.TextOfGrid(lngWriteRowNO, 20) = IIf(recTmp!intValidDay = 0, "", recTmp!intValidDay)
                End Select
                frmName.TextOfGrid(lngWriteRowNO, 21) = IIf(IsNull(recTmp!strJob), "", recTmp!strJob)
                frmName.TextOfGrid(lngWriteRowNO, 22) = IIf(IsNull(recTmp!strCustom0), "", recTmp!strCustom0)
                frmName.TextOfGrid(lngWriteRowNO, 23) = IIf(IsNull(recTmp!strCustom1), "", recTmp!strCustom1)
                frmName.TextOfGrid(lngWriteRowNO, 24) = IIf(IsNull(recTmp!strCustom2), "", recTmp!strCustom2)
                frmName.TextOfGrid(lngWriteRowNO, 25) = IIf(IsNull(recTmp!strCustom3), "", recTmp!strCustom3)
                frmName.TextOfGrid(lngWriteRowNO, 26) = IIf(IsNull(recTmp!strCustom4), "", recTmp!strCustom4)
                frmName.TextOfGrid(lngWriteRowNO, 27) = IIf(IsNull(recTmp!strCustom5), "", recTmp!strCustom5)
                frmName.TextOfGrid(lngWriteRowNO, 28) = recTmp!lngItemID
                frmName.TextOfGrid(lngWriteRowNO, 29) = GrdCol.RowData(lngRowno)
                Select Case lngReceiptTypeID
                Case 2, 3, 4, 13, 15, 18
                    If C2lng(frmName.TextOfGrid(lngWriteRowNO, 30)) = 0 Then
                        frmName.TextOfGrid(lngWriteRowNO, 30) = recTmp!lngPositionID
                    End If
                Case 5, 16, 19, 8, 20
                    frmName.TextOfGrid(lngWriteRowNO, 30) = ""
                Case Else
                    frmName.TextOfGrid(lngWriteRowNO, 30) = recTmp!lngPositionID
                End Select
            End If
        End If
        frmName.TextOfGrid(lngWriteRowNO, 31) = recTmp!lngUnitID
        If blnSetInfo Then
            frmName.TextOfGrid(lngWriteRowNO, 32) = recTmp!lngTaxID
            frmName.TextOfGrid(lngWriteRowNO, 33) = recTmp!lngJobID
            frmName.TextOfGrid(lngWriteRowNO, 34) = recTmp!lngCustomID0
            frmName.TextOfGrid(lngWriteRowNO, 35) = recTmp!lngCustomID1
            frmName.TextOfGrid(lngWriteRowNO, 36) = recTmp!lngCustomID2
            frmName.TextOfGrid(lngWriteRowNO, 37) = recTmp!lngCustomID3
            frmName.TextOfGrid(lngWriteRowNO, 38) = recTmp!lngCustomID4
            frmName.TextOfGrid(lngWriteRowNO, 39) = recTmp!lngCustomID5
        End If
        frmName.TextOfGrid(lngWriteRowNO, 40) = recTmp!dblFactor
        
        If lngReceiptTypeID = 16 Or lngReceiptTypeID = 19 Then
            frmName.TextOfGrid(lngWriteRowNO, 45) = frmName.TextOfGrid(lngWriteRowNO, 8)
        End If
        
        Select Case lngReceiptTypeID
        Case 2, 3, 4, 13, 15, 18
            frmName.WriteGrd GrdCol.TextMatrix(lngRowno, xlngColNo(6)), lngWriteRowNO, 5
            frmName.TextOfGrid(lngWriteRowNO, 41) = NumberConvert(GrdCol.TextMatrix(lngRowno, xlngColNo(6)), IIf(IsNull(recTmp!dblFactor), 1, recTmp!dblFactor))
            If blnSetInfo Then
                frmName.WriteGrd recTmp!dblPrice * IIf(IsNull(recTmp!dblFactor), 1, recTmp!dblFactor), lngWriteRowNO, 6
                frmName.WriteGrd recTmp!dblPriceTax * IIf(IsNull(recTmp!dblFactor), 1, recTmp!dblFactor), lngWriteRowNO, 7
                frmName.WriteGrd GrdCol.TextMatrix(lngRowno, xlngColNo(7)), lngWriteRowNO, 14
            End If
            frmName.setItemproperty lngWriteRowNO
            If blnSetInfo Then
               If lngReceiptTypeID = 13 Then
                  frmName.Calculate lngWriteRowNO, 14, True, , , True
               Else
                  frmName.Calculate lngWriteRowNO, 14, True
               End If
            Else
                If lngReceiptTypeID > 12 Then
                    If C2lng(frmName.TextOfGrid(lngWriteRowNO, 42)) > 0 Then
                        If UCase(Trim(frmName.TextOfGrid(lngWriteRowNO, 43))) <> "ALL" Then
                            frmName.TextOfGrid(lngWriteRowNO, 3) = ""
                            frmName.TextOfGrid(lngWriteRowNO, 30) = ""
                        End If
                    End If
                End If
                frmName.Calculate lngWriteRowNO, 5, True
            End If
        Case 26
            frmName.WriteGrd GrdCol.TextMatrix(lngRowno, xlngColNo(7)), lngWriteRowNO, 5
            frmName.TextOfGrid(lngWriteRowNO, 42) = NumberConvert(GrdCol.TextMatrix(lngRowno, xlngColNo(7)), IIf(IsNull(recTmp!dblFactor), 1, recTmp!dblFactor))
            If blnSetInfo Then
                frmName.WriteGrd Format(recTmp!dblPrice * (recTmp!dblDiscountRate / 100) * IIf(IsNull(recTmp!dblFactor), 1, recTmp!dblFactor), _
                    FormatString(gclsBase.PriceDec)), lngWriteRowNO, 6
                frmName.WriteGrd Format(recTmp!dblPriceTax * (recTmp!dblDiscountRate / 100) * IIf(IsNull(recTmp!dblFactor), 1, recTmp!dblFactor), _
                    FormatString(gclsBase.PriceDec)), lngWriteRowNO, 7
                frmName.WriteGrd Format(recTmp!dblPrice * (recTmp!dblDiscountRate / 100) * IIf(IsNull(recTmp!dblFactor), 1, recTmp!dblFactor), _
                    FormatString(gclsBase.PriceDec)), lngWriteRowNO, 14
                frmName.WriteGrd Format(recTmp!dblPriceTax * (recTmp!dblDiscountRate / 100) * IIf(IsNull(recTmp!dblFactor), 1, recTmp!dblFactor), _
                    FormatString(gclsBase.PriceDec)), lngWriteRowNO, 15
            End If
            frmName.setItemproperty lngWriteRowNO
            frmName.Calculate lngWriteRowNO, 5
        Case 14
            frmName.WriteGrd GrdCol.TextMatrix(lngRowno, xlngColNo(7)), lngWriteRowNO, 5
            frmName.TextOfGrid(lngWriteRowNO, 41) = NumberConvert(GrdCol.TextMatrix(lngRowno, xlngColNo(7)), IIf(IsNull(recTmp!dblFactor), 1, recTmp!dblFactor))
            If blnSetInfo Then
                Dim ItemPropertyTmp As ItemProperty
                GetItemProperty recTmp!lngItemID, ItemPropertyTmp, C2lng(frmName.lblHead(0).Tag)
                frmName.WriteGrd IIf(ItemPropertyTmp.dblRecenetSalePrice <> 0, ItemPropertyTmp.dblRecenetSalePrice, ItemPropertyTmp.dblSalePrice) * IIf(IsNull(recTmp!dblFactor), 1, recTmp!dblFactor), lngWriteRowNO, 6
            End If
            frmName.setItemproperty lngWriteRowNO
            If blnSetInfo Then
                frmName.Calculate lngWriteRowNO, 6, True
            Else
                frmName.Calculate lngWriteRowNO, 5, True
            End If
        Case Else
            frmName.WriteGrd GrdCol.TextMatrix(lngRowno, xlngColNo(7)), lngWriteRowNO, 5
            frmName.TextOfGrid(lngWriteRowNO, 41) = NumberConvert(GrdCol.TextMatrix(lngRowno, xlngColNo(7)), IIf(IsNull(recTmp!dblFactor), 1, recTmp!dblFactor))
            If blnSetInfo Then
                frmName.WriteGrd recTmp!dblPrice * IIf(IsNull(recTmp!dblFactor), 1, recTmp!dblFactor), lngWriteRowNO, 6
                frmName.WriteGrd recTmp!dblPriceTax * IIf(IsNull(recTmp!dblFactor), 1, recTmp!dblFactor), lngWriteRowNO, 7
                frmName.WriteGrd GrdCol.TextMatrix(lngRowno, xlngColNo(8)), lngWriteRowNO, 14
            End If
            frmName.setItemproperty lngWriteRowNO
            If blnSetInfo Then
                frmName.Calculate lngWriteRowNO, 14, True
            Else
                frmName.Calculate lngWriteRowNO, 5, True
            End If
        End Select
    End With
    
    recTmp.Close
    Set recTmp = Nothing
End Sub

Private Function strAccountYearPeriodOfDate(ByVal strDate As String) As String
    If Not IsDate(strDate) Then
        strAccountYearPeriodOfDate = CStr(gclsBase.AccountYear) & Format((gclsBase.Period), "00")
        Exit Function
    End If
    
    Dim intYear As Integer
    Dim bytPeriod As Byte
    
    strDate = Format(C2Date(strDate), "yyyy-mm-dd")
    intYear = gclsBase.FYearOfDate(C2Date(strDate))
    bytPeriod = gclsBase.PeriodOfDate(C2Date(strDate))
    If intYear = 0 Then
        intYear = Format(C2Date(strDate), "yyyy")
    End If
    If bytPeriod = 0 Then
        intYear = C2lng(Format(C2Date(strDate), "yyyy"))
        bytPeriod = C2lng(Format(C2Date(strDate), "mm"))
    End If
    strAccountYearPeriodOfDate = CStr(intYear) & Format(bytPeriod, "00")
End Function

'Private Sub mclsGrid_AfterColChange(lngSourCol As Long, lngDestCol As Long)
'    Dim lngTmp As Long
'    Dim i As Integer
'
'    lngTmp = xlngColNo(lngSourCol)
'    If lngSourCol < lngDestCol Then
'        For i = lngSourCol To lngDestCol - 1
'            xlngColNo(i) = xlngColNo(i + 1)
'        Next
'    Else
'        For i = lngDestCol + 1 To lngSourCol Step -1
'            xlngColNo(i) = xlngColNo(i - 1)
'        Next
'    End If
'    xlngColNo(lngDestCol) = lngTmp
'End Sub
Private Function ColName(ByVal lngCol As Long) As String
    Dim strTmp As String
    
    strTmp = GrdCol.TextMatrix(0, lngCol)
    
    If InStr(strTmp, "↑") <> 0 Or InStr(strTmp, "↓") <> 0 Then
        strTmp = Left(strTmp, Len(strTmp) - 1)
    End If
    ColName = strTmp
End Function

Private Sub GetLngColNO()
    Dim i As Integer
    Dim j As Integer
    
    For i = 2 To GrdCol.Cols - 1
        For j = 2 To GrdCol.Cols - 1
            If strColName(i) = ColName(j) Then
                xlngColNo(i) = j
                Exit For
            End If
        Next
    Next
End Sub

Private Function lngSelectedRow(ByVal lngRowno As Long) As Long
    Dim i As Long
    Dim lngTmp As Long
    
    lngSelectedRow = 0
    
    lngTmp = GrdCol.RowData(lngRowno)
    For i = 1 To UBound(lngSelected)
        If lngSelected(i) = lngTmp Then
            Exit For
        End If
    Next
    
    If i <> UBound(lngSelected) + 1 Then
        lngSelectedRow = i
    End If
End Function

Private Sub DeleteRows(ByRef blnDelete() As Boolean)
    Dim i As Long
    
    For i = UBound(blnDelete) To 1 Step -1
        If blnDelete(i) Then
            If frmName.GrdCol.Rows = 2 And i = 1 Then
                'frmName.grdCol.Rows = 1
                frmName.SetGridRows 1
                frmName.InsertARow
            Else
                'frmName.grdCol.RemoveItem i
                frmName.blnDeleteARow i
            End If
        End If
    Next
End Sub


⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -