frmdlselectpurchasereceipt.frm

金算盘软件代码

    ytextRow = 1
    While ytextRow < msgGrid.Rows
        If Trim(msgGrid.TextMatrix(ytextRow, n)) <> "√" Then
'            If getnumber(ytextRow, 3) = 0 Then
               msgGrid.TextMatrix(ytextRow, 1) = ""       '取消打√(核销)情况
'            Else
'               msgGrid.TextMatrix(ytextRow, 1) = "√"
'            End If
'            hlb(i).Caption = CStr(CDbl(hlb(i).Caption) + getnumber(ytextRow, 3) - getnumber(ytextRow, i))
'            msgGrid.TextMatrix(ytextRow, k) = msgGrid.TextMatrix(ytextRow, 2)
'            msgGrid.TextMatrix(ytextRow, i) = msgGrid.TextMatrix(ytextRow, 3)
        End If
          ytextRow = ytextRow + 1
    Wend
End Sub


'响应按钮动作
Private Sub Cmdall_Click(Index As Integer)
'响应窗体按钮动作
'If msgGrid.Rows > 1 Then
  Select Case Index
    Case 7                                    '确定存盘
         blnIsCancel = True
         If msgGrid.Rows > 1 Then
            SaveData (1)
         Else
           ExitGrid
         End If
    Case 1                                    '取消
         blnIsCancel = True
         ExitGrid
    Case 2                                    '筛选
         FilterData
    Case 3                                    '栏目设置
         setColumn
'    Case 4
'         ExitGrid
'         mfrmToFormname.ShowAOldBill DetailID
    Case 5                                   '全部选择
         If msgGrid.Rows > 1 Then
            BalenceAll
         End If
    Case 6
         If msgGrid.Rows > 1 Then
           AbolishAll                         '全部取消
         End If
  End Select
 'Else
'    ExitGrid
' End If
End Sub
'不存盘返回
Private Sub ExitGrid()
    Unload Me
End Sub
'从对应视图取SQL语句并打开、初始化之
Private Sub GetList()
    Dim sqlselect As String, strSql As String, strSelect As String, str As String
    Dim strWhere As String, pbsql As String, strFrom As String
    Dim recRecordset As rdoResultset, intCount As Integer
    Dim q2 As QueryDef
    On Error GoTo Err
    mclsGrid.ListSet.ViewId = intViewID
    With msgGrid
        .Redraw = False
        .FixedCols = 0
    End With
    strWhere = ""
    str = ""
    strSql = ""
    strFrom = ""
    pbsql = ""
    With mclsGrid.ListSet
        strFrom = .FromOfSql
        pbsql = .SelectOfSql
        strWhere = .WhereOfSql
    End With
    str = " WHERE (((PurchaseOrderDetail.blnIsClose)=False) AND " & IIf(blnIsPurchase = True, "item.blnisBorrow=True", "blnisBorrow=False") & " AND ((PurchaseOrder.lngCustomerID)=[CustomerID]) AND ((PurchaseOrder.lngCurrencyID)=[CurrencyID]) AND ((PurchaseOrderDetail.dblQuantity)>[PurchaseOrderDetail].[dblReceiveQuantity]))"
    If Len(Trim(strWhere)) >= 1 Then str = str & "AND" & " ( " & strWhere & ")"
    If Len(Trim(strWorkID)) > 4 Then
       str = str & " OR ( PurchaseOrderDetail.lngPurchaseOrderDetailID IN " & strWorkID & ")"
    End If
    strSql = strFrom & str
    sqlselect = " Select PurchaseOrderDetail.lngPurchaseOrderDetailID As 业务ID, iif(dblReceiveQuantity<>0,'','') As 选择, " _
              & " Trim(Str(Int([dblReceiveQuantity]/[dblFactor])))+'.'+String(Len(Trim(Str([dblFactor])))-Len(Trim(Str([dblReceiveQuantity] Mod " _
              & " [dblFactor]))),'0')+Trim(Str([dblReceiveQuantity] Mod [dblFactor])) AS 原采购数量, dblCurrAmount+dblCurrTaxAmount AS 原采购金额, " _
              & " Trim(Str(Int(([dblQuantity]-[dblReceiveQuantity])/[dblFactor])))+'.'+String(Len(Trim(Str([dblFactor])))-Len(Trim(Str(([dblQuantity]-" _
              & " [dblReceiveQuantity]) Mod [dblFactor]))),'0')+Trim(Str(([dblQuantity]-[dblReceiveQuantity]) Mod [dblFactor])) AS 原未到数量, " _
              & " (format((dblCurrAmount+dblCurrTaxAmount-[dblReceiveQuantity]*[dblPrice]*[dblFactor]*(1+iif(isnull(Tax.dblPurchaseTaxRate),0,Tax.dblPurchaseTaxRate/100))),'###.00')) AS 原未到金额, (PurchaseOrder.strReceiptNO & PurchaseOrder.lngReceiptNO) AS 原采购单号," _
              & " lngClassID1 As 7,lngClassID2 As 8,PurchaseOrderDetail.lngItemID As 9,PurchaseOrderDetail.lngUnitID  As 10,dblDiscountRate As 11,dblPrice*dblFactor As 12,PurchaseOrderDetail.lngTaxID As 13," _
              & " PurchaseOrderDetail.lngJobID As 14,PurchaseOrderDetail.lngCustomID0,PurchaseOrderDetail.lngCustomID1,PurchaseOrderDetail.lngCustomID2,PurchaseOrderDetail.lngCustomID3," _
              & " PurchaseOrderDetail.lngCustomID4,PurchaseOrderDetail.lngCustomID5,strReceiptNO & ' ' As 21,strReceiptNO & ' ' & Format(lngReceiptNO, '0000') As 22,dblFactor As 23," _
              & " (strItemCode & ' ' & strItemName & ' ' & strItemStyle) As 24,strUnitName As 25,strTaxName As 26,Item.lngPositionID As 27,strPositionName As 28," _
              & " strJobName As 29,Custom0.strCustomName As 30,Custom1.strCustomName As 31,Custom2.strCustomName As 32,Custom3.strCustomName As 33,Custom4.strCustomName As 34," _
              & " Custom5.strCustomName As 35, " & pbsql
'备份    sqlselect = " Select PurchaseOrderDetail.lngPurchaseOrderDetailID As 业务ID, iif(dblReceiveQuantity<>0,'','') As 选择, " _
              & " Trim(Str(Int([dblReceiveQuantity]/[dblFactor])))+'.'+String(Len(Trim(Str([dblFactor])))-Len(Trim(Str([dblReceiveQuantity] Mod " _
              & " [dblFactor]))),'0')+Trim(Str([dblReceiveQuantity] Mod [dblFactor])) AS 原采购数量, dblCurrAmount+dblCurrTaxAmount AS 原采购金额, " _
              & " Trim(Str(Int(([dblQuantity]-[dblReceiveQuantity])/[dblFactor])))+'.'+String(Len(Trim(Str([dblFactor])))-Len(Trim(Str(([dblQuantity]-" _
              & " [dblReceiveQuantity]) Mod [dblFactor]))),'0')+Trim(Str(([dblQuantity]-[dblReceiveQuantity]) Mod [dblFactor])) AS 原未到数量, " _
              & " (format((dblCurrAmount+dblCurrTaxAmount-[dblReceiveQuantity]*[dblPrice]*[dblFactor]*(1+iif(isnull(Tax.dblPurchaseTaxRate),0,Tax.dblPurchaseTaxRate/100))),'###.00')) AS 原未到金额, (PurchaseOrder.strReceiptNO & PurchaseOrder.lngReceiptNO) AS 原采购单号," _
              & " lngClassID1 As 7,lngClassID2 As 8,PurchaseOrderDetail.lngItemID As 9,PurchaseOrderDetail.lngUnitID  As 10,dblDiscountRate As 11,dblPrice*dblFactor As 12,PurchaseOrderDetail.lngTaxID As 13," _
              & " PurchaseOrderDetail.lngJobID As 14,PurchaseOrderDetail.lngCustomID0,PurchaseOrderDetail.lngCustomID1,PurchaseOrderDetail.lngCustomID2,PurchaseOrderDetail.lngCustomID3," _
              & " PurchaseOrderDetail.lngCustomID4,PurchaseOrderDetail.lngCustomID5,strReceiptNO & ' ' As 21,strReceiptNO & ' ' & Format(lngReceiptNO, '0000') As 22,dblFactor As 23," _
              & " (strItemCode & ' ' & strItemName & ' ' & strItemStyle) As 24,strUnitName As 25,strTaxName As 26,Item.lngPositionID As 27,strPositionName As 28," _
              & " strJobName As 29,Custom0.strCustomName As 30,Custom1.strCustomName As 31,Custom2.strCustomName As 32,Custom3.strCustomName As 33,Custom4.strCustomName As 34," _
              & " Custom5.strCustomName As 35, " & pbsql

    strSql = sqlselect & strSql
    
    '& "Order by 选择"
    Set q2 = gclsBase.BaseDB.CreateQueryDef("", strSql)
    q2.Parameters("CustomerID") = CustomerID
    q2.Parameters("CurrencyID") = CurrencyID
    Set recRecordset = q2.OpenRecordset(dbOpenSnapshot)

    If (recRecordset.EOF And recRecordset.BOF) Then
'        ShowMsg me.hwnd, "该采购订单无对应采购资料！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, msgcaption
        isinit = False
    Else
        recRecordset.MoveLast
    End If
    Set Datadl.Recordset = recRecordset
'    '列表是否为空
    msgGrid.HighLight = flexHighlightAlways
    If isinit = True Then
       Set mlhls = recRecordset
       isinit = False
       inittext
'       msgGrid.col = 1
'       msgGrid.ColSel = 1
'       msgGrid.Row = 1
'       msgGrid.RowSel = 1
    End If
    recRecordset.Close
    
    With msgGrid
        .SelectionMode = flexSelectionByRow
        .FocusRect = flexFocusNone
        .ColWidth(0) = 0
        .ColWidth(1) = 488
        intCount = 2
        While intCount <= 35
           .ColWidth(intCount) = 0
           intCount = intCount + 1
        Wend
        .Redraw = True
   
    End With
Exit Sub
Err:
    ShowMsg Me.hwnd, "选择采购订单程序初始化失败", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "选择采购订单"
End Sub
'初始化各text框中数据
Private Sub inittext()
Dim intCount As Integer, dx As Double, dy As Double, dz As Double
Dim cgje As Double, l As Integer, wdje As Double, n As Integer
    Dim recRecordset As rdoResultset
    dx = 0
    dz = 0
    Set Datadl.Recordset = mlhls
    mlhls.MoveFirst
    For intCount = 1 To mlhls.RowCount
          cgje = C2Dbl(IIf(IsNull(mlhls.rdoColumns("采购金额")), 0, mlhls.rdoColumns("采购金额")))
          wdje = C2Dbl(IIf(IsNull(mlhls.rdoColumns("未到金额")), 0, mlhls.rdoColumns("未到金额")))
          dx = dx + cgje
          dz = dz + wdje
          mlhls.MoveNext
     Next intCount
     l = intfixl
     n = l
     While (msgGrid.TextMatrix(0, l) <> "采购金额")
            l = l + 1
     Wend
     While (msgGrid.TextMatrix(0, n) <> "未到金额")
            n = n + 1
     Wend
     hLb(l).Caption = CStr(dx)
     hLb(n).Caption = CStr(dz)
     hLb(l).Refresh
     hLb(n).Refresh
End Sub

'结算内容筛选
Private Sub FilterData()
Dim i As Integer
'If msgGrid.Rows > 1 Then
    i = 1
    strWorkID = ""
    Do While i < msgGrid.Rows
       If msgGrid.TextMatrix(i, 1) = "√" Then
          If Len(strWorkID) > 0 Then
              strWorkID = strWorkID & "," & CStr(getnumber(i, 0))
          Else
              strWorkID = CStr(getnumber(i, 0))
          End If
       End If
       i = i + 1
    Loop
    strWorkID = "( " & strWorkID & " )"
    If msgGrid.Rows > 1 Then
       If ShowMsg(Me.hwnd, "筛选操作后，你刚刚做的选择将被取消，需要先存盘吗", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "选择采购订单") = IDYES Then
          SaveData (0)
       End If
    End If
    If mclsGrid.ListSet.ListID < 1 Then
       mclsGrid.ListSet.SaveList
    End If
    Filter.ShowFilter mclsGrid.ListSet.ListID, 1
    mclsGrid.ListSet.SaveList
    mclsGrid.ColOfs = intfixl
    isinit = True
    GetList
    mclsGrid.SetupStyle
'End If
End Sub
'存盘
Private Sub SaveData(kkk As Integer)         '存盘
Dim i As Integer, j As Integer, temp As Double, strSql As String
Dim l  As Integer, n As Integer, slh As String, m As Integer, intCount As Integer, k As Integer
Dim blnColse As Boolean
'On Error GoTo Err
'i = 1
'MousePointer = vbHourglass
l = intfixl
n = intfixl
m = intfixl
    While (msgGrid.TextMatrix(0, m) <> "关闭")
           m = m + 1
    Wend

    While (msgGrid.TextMatrix(0, l) <> "未到金额")
           l = l + 1
    Wend
    While (msgGrid.TextMatrix(0, n) <> "未到数量")
           n = n + 1
    Wend
    
    intCount = mfrmToFormname.grdCol.Rows
    If mfrmToFormname.grdCol.Rows < 2 Then
       mfrmToFormname.InsertARow
       'False
       intCount = intCount + 1
    End If
'    j = 1
'    Do While j < mfrmToFormname.grdCol.Rows       '=0为未覆盖标志
'       mfrmToFormname.grdCol.TextMatrix(j, 41) = "0"
'       j = j + 1
'    Loop
    j = 1
    While j < msgGrid.Rows
        If (msgGrid.TextMatrix(j, 1) = "√") Then    '前后有否变化
        ' Or msgGrid.TextMatrix(j, m) = "√"
            k = 1
            Do While k < intCount                '判断商品在对方GRID上是否已存在
                  If msgGrid.TextMatrix(j, 0) = mfrmToFormname.grdCol.TextMatrix(k, 29) Then
                     Exit Do
                  End If
                  k = k + 1
            Loop
            If k >= intCount Then         '该订单商品是否为添加
'               If msgGrid.TextMatrix(j, m) <> "√" Then
                '需要添加一行吗
                 If C2Lng(mfrmToFormname.grdCol.TextMatrix(mfrmToFormname.grdCol.Rows - 1, 28)) <> 0 Then
                    mfrmToFormname.InsertARow
                    'False
                 End If                 '需要添加一行吗
                 i = mfrmToFormname.grdCol.Rows - 1                                      '记住对方GRID行号
                 mfrmToFormname.grdCol.TextMatrix(i, 1) = msgGrid.TextMatrix(j, 24)      '商品名称
                 mfrmToFormname.grdCol.TextMatrix(i, 28) = msgGrid.TextMatrix(j, 9)      '商品ID
                 mfrmToFormname.grdCol.TextMatrix(i, 2) = msgGrid.TextMatrix(j, 22)      '订单号
                 mfrmToFormname.grdCol.TextMatrix(i, 29) = msgGrid.TextMatrix(j, 0)      '订单ID
                 mfrmToFormname.grdCol.TextMatrix(i, 3) = msgGrid.TextMatrix(j, 28)      '货位
                 mfrmToFormname.grdCol.TextMatrix(i, 30) = msgGrid.TextMatrix(j, 27)     '货位ID
                 mfrmToFormname.grdCol.TextMatrix(i, 4) = msgGrid.TextMatrix(j, 25)      '计量单位
                 mfrmToFormname.grdCol.TextMatrix(i, 31) = msgGrid.TextMatrix(j, 10)     '计量单位ID
                 mfrmToFormname.grdCol.TextMatrix(i, 5) = msgGrid.TextMatrix(j, n)       '到货数量
                 mfrmToFormname.grdCol.TextMatrix(i, 6) = msgGrid.TextMatrix(j, 12)      '单价
                 mfrmToFormname.grdCol.TextMatrix(i, 14) = msgGrid.TextMatrix(j, l)      '原币含税金额
                 mfrmToFormname.grdCol.TextMatrix(i, 8) = msgGrid.TextMatrix(j, 11)      '扣率
                 mfrmToFormname.grdCol.TextMatrix(i, 11) = msgGrid.TextMatrix(j, 26)     '税率
                 mfrmToFormname.grdCol.TextMatrix(i, 32) = msgGrid.TextMatrix(j, 13)     '税率ID
                 mfrmToFormname.grdCol.TextMatrix(i, 21) = msgGrid.TextMatrix(j, 29)     '工程
                 mfrmToFormname.grdCol.TextMatrix(i, 33) = msgGrid.TextMatrix(j, 14)     '工程ID
                 mfrmToFormname.grdCol.TextMatrix(i, 22) = msgGrid.TextMatrix(j, 30)     '自定义项目一
                 mfrmToFormname.grdCol.TextMatrix(i, 23) = msgGrid.TextMatrix(j, 31)     '自定义项目二
                 mfrmToFormname.grdCol.TextMatrix(i, 24) = msgGrid.TextMatrix(j, 32)     '自定义项目三
                 mfrmToFormname.grdCol.TextMatrix(i, 25) = msgGrid.TextMatrix(j, 33)     '自定义项目四
                 mfrmToFormname.grdCol.TextMatrix(i, 26) = msgGrid.TextMatrix(j, 34)     '自定义项目五
                 mfrmToFormname.grdCol.TextMatrix(i, 27) = msgGrid.TextMatrix(j, 35)     '自定义项目六
                 mfrmToFormname.grdCol.TextMatrix(i, 34) = msgGrid.TextMatrix(j, 15)     '自定义项目一ID
                 mfrmToFormname.grdCol.TextMatrix(i, 35) = msgGrid.TextMatrix(j, 16)     '自定义项目二ID
                 mfrmToFormname.grdCol.TextMatrix(i, 36) = msgGrid.TextMatrix(j, 17)     '自定义项目三ID
                 mfrmToFormname.grdCol.TextMatrix(i, 37) = msgGrid.TextMatrix(j, 18)     '自定义项目四ID
                 mfrmToFormname.grdCol.TextMatrix(i, 38) = msgGrid.TextMatrix(j, 19)     '自定义项目五ID
                 mfrmToFormname.grdCol.TextMatrix(i, 39) = msgGrid.TextMatrix(j, 20)     '自定义项目六ID
                 mfrmToFormname.grdCol.TextMatrix(i, 40) = msgGrid.TextMatrix(j, 23)     '计量单位折算因子
                 mfrmToFormname.grdCol.TextMatrix(i, 41) = msgGrid.TextMatrix(j, n)      '订购数量
'                End If
             Else
                 '以下注释同上！
                 mfrmToFormname.grdCol.TextMatrix(k, 1) = msgGrid.TextMatrix(j, 24)
                 mfrmToFormname.grdCol.TextMatrix(k, 28) = msgGrid.TextMatrix(j, 9)