frmdlselectinvoicein.frm

金算盘软件代码

    '本循环找出本次收款及本次折扣所在的列
    While (msgGrid.TextMatrix(0, i) <> "已开票金额")
          i = i + 1
    Wend
    While (msgGrid.TextMatrix(0, k) <> "已开票数量")
          k = k + 1
    Wend
    ytextRow = 1
    '响应完全结算菜单
       While ytextRow <= allrows
               '打√情况
               msgGrid.TextMatrix(ytextRow, 1) = "√"
               xx = getnumber(ytextRow, 4) - getnumber(ytextRow, i)
               msgGrid.TextMatrix(ytextRow, i) = CStr(getnumber(ytextRow, i) + xx)
                              '总结算总折扣金额及数量的更新
               frmdlSelectInvoiceIn.hLb(2).Caption = CStr(CCur(IIf(Len(frmdlSelectInvoiceIn.hLb(2).Caption) = 0, "0", frmdlSelectInvoiceIn.hLb(2).Caption)) + xx)
               xx = getnumber(ytextRow, 5) - getnumber(ytextRow, k)
               'if xx<0 then xx=0
               msgGrid.TextMatrix(ytextRow, k) = CStr(getnumber(ytextRow, 5))
               frmdlSelectInvoiceIn.hLb(3).Caption = CStr(CCur(IIf(Len(frmdlSelectInvoiceIn.hLb(3).Caption) = 0, "0", frmdlSelectInvoiceIn.hLb(3).Caption)) + xx)
               ytextRow = ytextRow + 1
           Wend
 End Sub
'响应完全取消菜单
Private Sub chklist2_Click()
    AbolishAll
End Sub
Private Sub AbolishAll()
'完全取消
Dim k As Integer, i As Integer
        '响应完全取消菜单
    i = intfixl
    k = intfixl
    '本循环找出本次收款及本次折扣所在的列
    While (msgGrid.TextMatrix(0, i) <> "已开票金额")
          i = i + 1
    Wend
    While (msgGrid.TextMatrix(0, k) <> "已开票数量")
          k = k + 1
    Wend
    ytextRow = 1
    While ytextRow <= allrows
          msgGrid.TextMatrix(ytextRow, 1) = ""       '取消打√(结算)情况
          frmdlSelectInvoiceIn.hLb(2).Caption = CStr(CCur(frmdlSelectInvoiceIn.hLb(2).Caption) - getnumber(ytextRow, i))
          frmdlSelectInvoiceIn.hLb(3).Caption = CStr(CCur(frmdlSelectInvoiceIn.hLb(3).Caption) - getnumber(ytextRow, k))
          msgGrid.TextMatrix(ytextRow, k) = ""
          msgGrid.TextMatrix(ytextRow, i) = ""
          ytextRow = ytextRow + 1
    Wend
End Sub



Private Sub Cmdall_Click(Index As Integer)
  Select Case Index
    Case 0
         SaveData
    Case 1
         ExitGrid
    Case 2
         FilterData
    Case 3
         setColumn
    Case 4
         'ExitGrid
    Case 5
         BalenceAll
    Case 6
         AbolishAll
  End Select
           
End Sub
'不存盘返回
Private Sub ExitGrid()
    Unload frmdlSelectInvoiceIn
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 Recordset, intcount As Integer
'    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 (((ItemActivity.lngCustomerID)=" & CustomerID & ") AND ((ItemActivity.lngCurrencyID)=" & CurrencyID & ") AND (ItemActivity.lngActivityTypeID In (1,2,4,6,22,23)) AND (([ItemActivityDetail ].[dblCurrAmount]+[ItemActivityDetail].[dblCurrTaxAmount]-[ItemActivityDetail].[dblCurrInvoiceAmount])<>0))"
    If Len(Trim(strWhere)) >= 1 Then str = str & "AND" & " ( " & strWhere & ")"
    strSQL = strFrom & str
    sqlselect = " Select ItemActivityDetail.lngActivityDetailID As 业务ID, iif(IIf(IsNull(ItemActivityDetail.dblCurrInvoiceAmount),0,ItemActivityDetail.dblCurrInvoiceAmount)<>0,'√','') As √, (ItemActivityDetail.dblCurrInvoiceAmount) AS 原已开票金额, (ItemActivityDetail.dblInvoiceQuantity) AS 原已开票数量, " _
    & " ([ItemActivityDetail].[dblCurrAmount]+[ItemActivityDetail].[dblCurrTaxAmount]-[ItemActivityDetail].[dblCurrInvoiceAmount]+iif(isnull([InvoiceToPurchase].[dblCurrInvoiceAmount]),0,[InvoiceToPurchase].[dblCurrInvoiceAmount])) AS 原未开票金额,([ItemActivityDetail].[dblQuantity]-[ItemActivityDetail].[dblInvoiceQuantity]+iif(isnull([InvoiceToPurchase].[dblInvoiceQuantity]),0,[InvoiceToPurchase].[dblInvoiceQuantity])) AS 原未开票数量,ItemActivity.lngActivityTypeID AS 类型ID, " & pbsql
'     sqlselect = " Select ItemActivityDetail.lngActivityDetailID As 业务ID, " & pbsql
    strSQL = sqlselect & strSQL
    '& "Order by √"
    Set recRecordset = gclsBase.BaseDB.OpenRecordset(strSQL, dbOpenSnapshot)
    If (recRecordset.EOF And recRecordset.BOF) Then
        ShowMsg frmdlSelectInvoiceIn.hWnd, "该选择开票入库结算单无对应选择开票入库资料！", 0, msgcaption
        Unload frmdlSelectInvoiceIn
        recRecordset.Close
        Exit Sub
    End If
    recRecordset.MoveLast
    Set Datadl.Recordset = recRecordset
    '列表是否为空
    If recRecordset.RecordCount = 0 Then
        msgGrid.HighLight = flexHighlightNever
        ShowMsg frmdlSelectInvoiceIn.hWnd, "该选择开票入库结算单无对应选择开票入库资料！", 0, msgcaption
        recRecordset.Close
        Exit Sub
        isHave = False
        frmdlSelectInvoiceIn.Enabled = False
        Unload frmdlSelectInvoiceIn
    Else
        allrows = recRecordset.RecordCount
        msgGrid.HighLight = flexHighlightAlways
        If isinit = True Then
           Set mlhls = recRecordset
           inittext
           isinit = False
        End If
    End If
    recRecordset.Close
    
    With msgGrid
        .SelectionMode = flexSelectionFree
        .FocusRect = flexFocusNone
        .ColWidth(0) = 0
        .ColWidth(1) = 488
        .ColWidth(2) = 0
        .ColWidth(3) = 0
        .ColWidth(4) = 0
        .ColWidth(5) = 0
        .ColWidth(6) = 0
        
        .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 Long, dy As Long, dz As Long, dn As Long
Dim wjje As Long, wjsl As Long, yjje As Long, yjsl As Long
    Dim recRecordset As Recordset
    dx = 0
    dy = 0
    dz = 0
    'dm = 0
    dn = 0
    Set Datadl.Recordset = mlhls
    mlhls.MoveFirst
    For intcount = 1 To mlhls.RecordCount
          wjje = IIf(IsNull(mlhls.Fields("未开票金额")), 0, mlhls.Fields("未开票金额"))
          wjsl = IIf(IsNull(mlhls.Fields("未开票数量")), 0, mlhls.Fields("未开票数量"))
          yjje = IIf(IsNull(mlhls.Fields("已开票金额")), 0, mlhls.Fields("已开票金额"))
          yjsl = IIf(IsNull(mlhls.Fields("已开票数量")), 0, mlhls.Fields("已开票数量"))
          dx = dx + wjje
          dy = dy + wjsl
          dz = dz + yjje
          dn = dn + yjsl
          mlhls.MoveNext
     Next intcount
     frmdlSelectInvoiceIn.hLb(0).Caption = CStr(dx)
     frmdlSelectInvoiceIn.hLb(1).Caption = CStr(dy)
     frmdlSelectInvoiceIn.hLb(2).Caption = CStr(dz)
     frmdlSelectInvoiceIn.hLb(3).Caption = CStr(dn)
     frmdlSelectInvoiceIn.hLb(0).Refresh
     frmdlSelectInvoiceIn.hLb(1).Refresh
     frmdlSelectInvoiceIn.hLb(2).Refresh
     frmdlSelectInvoiceIn.hLb(3).Refresh
End Sub

'结算内容筛选
Private Sub FilterData()
    Filter.ShowFilter mclsGrid.ListSet.ListID, 1
    mclsGrid.ListSet.SaveList
    mclsGrid.ColOfs = intfixl
    isinit = True
    GetList
    mclsGrid.SetupStyle
    mclsGrid.ListSetToGrid
    frmdlSelectInvoiceIn.msgGrid.ColWidth(0) = 0
    frmdlSelectInvoiceIn.msgGrid.ColWidth(1) = 488
    frmdlSelectInvoiceIn.msgGrid.ColWidth(2) = 0
    frmdlSelectInvoiceIn.msgGrid.ColWidth(3) = 0
    frmdlSelectInvoiceIn.msgGrid.ColWidth(4) = 0
    frmdlSelectInvoiceIn.msgGrid.ColWidth(5) = 0
    frmdlSelectInvoiceIn.msgGrid.ColWidth(6) = 0
End Sub
'存盘
Private Sub SaveData()        '存盘
Dim i As Integer, j As Integer, temp As Double, strSQL As String
Dim l  As Integer, n As Integer
On Error GoTo Err
i = 1
l = intfixl
n = intfixl
'本循环找出本次已开票金额及本次折扣所在的列
While (msgGrid.TextMatrix(0, l) <> "已开票金额")
       l = l + 1
Wend
While (msgGrid.TextMatrix(0, n) <> "已开票数量")
       n = n + 1
Wend
While i <= allrows
      If (getnumber(i, 4) + getnumber(i, 5) = 0) And (getnumber(i, l) <> 0 Or getnumber(i, n) <> 0) Then       '新增情况
          strSQL = "Insert Into InvoiceToPurchase (lngBorrowActivityDetailID,dblQuantity,dblAmount) " _
                 & " Values(" & getnumber(i, 0) & "," & getnumber(i, n) & "," & getnumber(i, l) & ")"
          gclsBase.ExecSQL strSQL

           strSQL = "Update ItemActivityDetail Set dblSettlementQuantity=dblSettlementQuantity + " & getnumber(i, n) & " - " & getnumber(i, 10) & ", " _
                  & "dblCurrSettlementAmount = dblCurrSettlementAmount + " & getnumber(i, l) & " - " & getnumber(i, 8) & " Where lngActivityDetailID=" & getnumber(i, 0) & ""
           gclsBase.ExecSQL strSQL
       Else        '更新情况
          strSQL = "Update InvoiceToPurchase Set lngBorrowActivityDetailID=" & getnumber(i, 0) & " ," _
                 & "dblQuantity = " & getnumber(i, n) & ",dblAmount = " & getnumber(i, l) & " Where lngBorrowActivityDetailID =" & getnumber(i, 0) & ""
          gclsBase.ExecSQL strSQL

           strSQL = "Update ItemActivityDetail Set dblSettlementQuantity=dblSettlementQuantity + " & getnumber(i, n) & " - " & getnumber(i, 10) & ", " _
                  & "dblCurrSettlementAmount = dblCurrSettlementAmount + " & getnumber(i, l) & " - " & getnumber(i, 8) & " Where lngActivityDetailID=" & getnumber(i, 0) & ""
           gclsBase.ExecSQL strSQL
      End If
      i = i + 1
Wend
'recc.Close
'reci.Close
Unload frmdlSelectInvoiceIn
Exit Sub
Err:
    ShowMsg Me.hWnd, "系统出错！    ", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "提示信息"
'    recc.CancelUpdate
'    reci.CancelUpdate
End Sub
'关联


'重定窗体中各控件的位置、大小
Private Sub Form_Resize()
    If mblnFormNoRezise Then Exit Sub
    On Error Resume Next
    If Me.Height < intFormHeight Then Me.Height = intFormHeight
    If Me.Width < intFormWidth Then Me.Width = intFormWidth
    RedrawForm
End Sub
Private Sub RedrawForm()
    '重画MS FlexGrid 控件
    Dim leftx As Integer
    With msgGrid
        .Width = Me.ScaleWidth - ListFormLeft - ListFormRight * 4 - frmdlSelectInvoiceIn.cmdall(0).Width
        
        .Height = Me.ScaleHeight - ListUpAreaHeight - ListDownAreaHeight - ListFormBottom + 28
    End With
    
    '重画其余控件
    leftx = Me.ScaleLeft + Me.ScaleWidth - frmdlSelectInvoiceIn.cmdall(0).Width - ListFormRight
    frmdlSelectInvoiceIn.cmdall(0).Left = leftx
    frmdlSelectInvoiceIn.cmdall(1).Left = leftx
    frmdlSelectInvoiceIn.cmdall(2).Left = leftx
    frmdlSelectInvoiceIn.cmdall(3).Left = leftx
    frmdlSelectInvoiceIn.cmdall(4).Left = leftx
    frmdlSelectInvoiceIn.cmdall(5).Left = leftx
    frmdlSelectInvoiceIn.cmdall(6).Left = leftx