frmbanreport.frm

金算盘软件代码

    Set ABook = New ReportBook
    ABook.SetWin PicPaper.hwnd
    
    ABook.Version = Report.VersionInfo
    mblnLockHead = True
    ABook.FCLocked = True
    mblnRefresh = True
    ABook.FCRows = 4
       
    ABook.TabLocked = mclsReportSet.OnlyData
    
    If ABook.IsInitSuccessed = 0 Then
        Unload MsgForm
        mblnLoad = True
        Utility.ShowMsg Me.hwnd, "请先设置打印机!", vbInformation + vbOKOnly, App.title
        Screen.MousePointer = vbDefault
        Unload Me
        Exit Sub
    End If
    
    '格式设置初始化
    Set mclsFset = New ClsFormatset
    mclsFset.InitPropertyByDataBase 9, mclsReportSet.ReportID, mclsReportSet.PaperID
    GetDefaultSet
    
    Select Case mclsReportSet.ViewId
      Case 632, 636, 680, 662
        Me.HelpContextID = 70002
      Case 638, 639
        Me.HelpContextID = 70003
    End Select
    
    If mclsReportSet.ViewId = 680 Then
       cmdMiss.Visible = True
    Else
       cmdMiss.Visible = False
    End If
    
    GetCondition AccountID, CustomerID
    Caption = mclsReportSet.ReportName
    PitchToAccount BookType, AccountID
    PitchToAccount BookType, CustomerID, "单位"
    mblnLoad = True
    RefreshData GetOtherCond
    Form_Resize
    Screen.MousePointer = vbDefault
    InitScrollbar
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    Utility.LoadFormSetting Me
    Unload MsgForm
    mblnFirstLoad = False
    Me.Show
    Exit Sub
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Screen.MousePointer = vbDefault
         Unload MsgForm
         Unload Me
    End If
End Sub

Private Sub PitchToAccount(Optional ByVal BookType As Integer = -1, Optional ByVal AccountID As Long = 0, Optional CodeType As String = "科目")
  Dim intCount As Integer
    If BookType <> -1 Then
        If AccountID <> 0 Then
            For intCount = 1 To cmbHead.Count - 1
                  If GetNoXString(lblHead(intCount).Caption, 1, "(") = CodeType Then
                       cmbHead(intCount).SeekId AccountID
                  End If
            Next intCount
        End If
    End If
End Sub

'取筛选条件
Private Function GetCondition(Optional ByVal AccountID As Long = 0, Optional ByVal CustomerID As Long = 0)
  Dim strTemp As String
  Dim intRecord As Integer
    
    mclsFilterCond.GetCond mstrCond, "日期"
    mstrWhere = mclsFilterCond.GetCond(, "日期", , , , , , 64)
    
    '取凭证类型条件
    mstrVoucherType = "VoucherType.lngVoucherTypeID"
    ModifyCondPer mstrWhere, mstrVoucherType
    
    If UCase(mstrVoucherType) = UCase("VoucherType.lngVoucherTypeID") Then
        mstrVoucherType = ""
    End If
    
    mstrLevel = "Account.intLevel"
    ModifyCondPer mstrWhere, mstrLevel
    If mstrLevel = "Account.intLevel" Then   '科目层次条件为空
       mstrLevel = ""
    End If
    
    strTemp = "Account.blnIsDetail"
    ModifyCondPer mstrWhere, strTemp
    If InStr(1, UCase(strTemp), "TRUE") > 0 Then
       mblnDetail = True
    Else
       mblnDetail = False
    End If
    
    mbytData = 0
    
    strTemp = "JZ"
    Filter.ModifyCondPer mstrWhere, strTemp
    If UCase(strTemp) = "JZ" Then
        intRecord = 0
    Else
        If InStr(1, UCase(strTemp), "1") > 0 Then
           intRecord = 1
           mbytData = 2
        Else
           intRecord = 2
           mbytData = 1
        End If
    End If
    
    If mclsReportSet.ViewId = 638 Or mclsReportSet.ViewId = 639 Then
        strTemp = "lngPostID"
        Filter.ModifyCondPer mstrWhere, strTemp
        If UCase(strTemp) <> UCase("lngPostID") Then
           mbytData = 1
        End If
        
        strTemp = "lngVoucherID"
        Filter.ModifyCondPer mstrWhere, strTemp
        If UCase(strTemp) <> UCase("lngVoucherID") Then
           mbytData = 2
        End If
    End If
        
    If intRecord = 0 Or intRecord = 1 Then
       mvtVerify = vtAll              '所有(包含未记帐)
    End If
    
    If intRecord = 2 Then
       mvtVerify = vtRecorded         '已记帐
    End If
    
    GetHeadCond mstrCond, AccountID, CustomerID
End Function

'取日期等用户可选择条件,同时计算期初余额
Private Function GetOtherCond() As String
  Dim intCount As Integer, intControls As Integer
  Dim strDateCond As String, strCond As String, strHeadName As String
  Dim strBegin As String, strCode As String
  Dim D1 As Date, D2 As Date
    
    If Not mblnLoad Then
        Exit Function
    End If
    
    intControls = 1
    For intCount = 1 To mclsReportSet.HeadFields
        strHeadName = mclsReportSet.HeadFieldName(intCount)
        If strHeadName <> "日期" Then
            strCode = Trim(GetNoXString(cmbHead(intControls).Text, 1, " "))
            If strCode <> "所有币种" And strCode <> "本位币" And strCode <> "所有" And strCode <> "" Then
                If GetOtherCond = "" Then
                     GetOtherCond = "(Upper(" & lblHead(intControls).Tag & ")=Upper('" & strCode & "') Or " & _
                                    lblHead(intControls).Tag & " Like '" & strCode & "-%')"
                Else
                     GetOtherCond = GetOtherCond & " And (Upper(" & lblHead(intControls).Tag & ")=Upper('" & strCode & "') Or " & _
                                    lblHead(intControls).Tag & " Like '" & strCode & "-%')"
                End If
                If strCond = "" Then
                     strCond = "(Upper(" & lblHead(intControls).Tag & ")=Upper('" & strCode & "') Or " & _
                               lblHead(intControls).Tag & " Like '" & strCode & "-%')"
                Else
                     strCond = strCond & " And (Upper(" & lblHead(intControls).Tag & ")=Upper('" & strCode & "') Or " & _
                               lblHead(intControls).Tag & " Like '" & strCode & "-%')"
                End If
            End If
            intControls = intControls + 1
        End If
    Next intCount
    If detBegin.Text = "" Then
       strBegin = DateAdd("D", -1, gclsBase.BeginDate)
    Else
       If CDate(detBegin.Text) < CDate(gclsBase.BeginDate) Then
          strBegin = DateAdd("D", -1, gclsBase.BeginDate)
       Else
          strBegin = DateAdd("D", -1, detBegin.Text)
       End If
    End If
    If GetOtherCond <> "" Then
        GetOtherCond = "(" & GetOtherCond & ")"
    End If
End Function

Private Function GetVisibleRow()
  Dim intRow As Integer
   On Error GoTo ErrHandle
   With grdAcntBook
        intRow = .TopRow
        Do While .RowIsVisible(intRow)
           GetVisibleRow = GetVisibleRow + 1
           intRow = intRow + 1
           If intRow > .Rows - 1 Then
              Exit Do
           End If
        Loop
   End With
ErrHandle:
End Function

'涮新数据
Private Sub RefreshData(Optional OtherCond As String = "")
  Dim strSql As String, strOrder As String, strSelect As String, strGroup As String, arrGroupCol() As Integer
  Dim strCond As String, strFixCond As String, strUnionSel As String, strUnionSel2 As String
  Dim rstData As rdoResultset
  Dim rstTemp As rdoResultset
  Dim strGroupSel As String
  Dim strDateCond As String
  Dim strWhere As String, strVoucherNo As String, blnHaveVTHead As Boolean, intCount As Integer

    If Not mblnLoad Then
        Exit Sub
    End If

    mblnLoad = False
    ABook.ClearCell
    mintNowPage = 1
    
    grdAcntBook.FixedCols = 0
    strSelect = mclsReportSet.GetSelect(strGroup, arrGroupCol, mlngCondType, strGroupSel)
    strFixCond = GetFixCond
    
    blnHaveVTHead = False
    
    For intCount = 1 To mclsReportSet.HeadFields
       If mclsReportSet.HeadFieldName(intCount) = "凭证类型" Then
          blnHaveVTHead = True
       End If
    Next intCount
    
    If mstrVoucherType <> "" And Not blnHaveVTHead Then
       If OtherCond = "" Then
          OtherCond = mstrVoucherType
       Else
          OtherCond = OtherCond & " And " & mstrVoucherType
       End If
    End If
    
    If OtherCond = "" Then
        If strFixCond <> "" Then
            strSql = "Select  " & strSelect & ",max(Account.blnIsDetail),max(Account.intLevel),Max(Account.lngAccountTypeID)" & mclsReportSet.FromOfSql & _
                     IIf(mstrWhere <> "", " Where " & mstrWhere & " And ", " Where") & strFixCond & " Group By " & strGroup
        Else
            strSql = "Select  " & strSelect & ",max(Account.blnIsDetail),max(Account.intLevel),Max(Account.lngAccountTypeID)" & mclsReportSet.FromOfSql & _
                     IIf(mstrWhere <> "", " Where " & mstrWhere, "") & " Group By " & strGroup
        End If
    Else
        If strFixCond <> "" Then
            strSql = "Select  " & strSelect & ",max(Account.blnIsDetail),max(Account.intLevel),Max(Account.lngAccountTypeID)" & mclsReportSet.FromOfSql & _
                     IIf(mstrWhere <> "", " Where " & mstrWhere & _
                     " And " & OtherCond, " Where " & OtherCond) & " And " & strFixCond & " Group By " & strGroup
        Else
            strSql = "Select  " & strSelect & ",max(Account.blnIsDetail),max(Account.intLevel),Max(Account.lngAccountTypeID)" & mclsReportSet.FromOfSql & _
                     IIf(mstrWhere <> "", " Where " & mstrWhere & _
                     " And " & OtherCond, " Where " & OtherCond) & " Group By " & strGroup
        End If
    End If
    
    strSql = ReplaceDate(strSql)
    
    If (mclsReportSet.ViewId = 638 Or mclsReportSet.ViewId = 639) And Not gclsBase.ControlAccount Then
       Select Case mbytData
       Case 0
       Case 1
          strSql = strReplace(strSql, "UnVoucher", "Posted")
       Case 2
          strSql = strReplace(strSql, "dblUnVoucherDebit", "(dblUnPostedDebit+dblPostedDebit)")
          strSql = strReplace(strSql, "dblUnVoucherCredit", "(dblUnPostedCredit+dblPostedCredit)")
       End Select
    End If
    
    Set rstData = gclsBase.BaseDB.OpenResultset(strSql & strOrder, rdOpenStatic)
    Set Data1.Resultset = rstData
    
    InitGridTitle
    If Not mblnDetail Then
       LevelSum
    End If
    
    AddTotal
    
    If mclsReportSet.ViewId <> 638 And mclsReportSet.ViewId <> 639 Then
       AddTypeTotal
    End If
    
    If mclsReportSet.ViewId = 662 Then
       OneDirect
    End If
    
    Erase marrTotalRow
    Set mcolDirect = Nothing
    Set mcolTypeDirect = Nothing
    Erase marrAccountType

    mintMastDealRow = 0
    mblnIsOver = False
    
    mblnLoad = True
    GetPages
    SetData
    
    If mclsReportSet.ViewId = 680 Then
       strDateCond = "To_Date(Voucher.strDate,'yyyy-mm-dd')>=To_Date('" & Format(detBegin.Text, "yyyy-MM-dd") & "','yyyy-mm-dd') And To_Date(Voucher.strDate,'yyyy-mm-dd')<=To_Date('" & Format(detEnd.Text, "yyyy-MM-dd") & "','yyyy-mm-dd')"
    
       If strFixCond <> "" Then
          strWhere = strFixCond
       End If
      
       If mstrWhere <> "" Then
          strWhere = strWhere & " And (" & mstrWhere & ")"
       End If
      
       If OtherCond <> "" Then
          strWhere = strWhere & " And (" & OtherCond & ")"
       End If
      
       If strDateCond <> "" Then
          strWhere = strWhere & " And (" & strDateCond & ")"
       End If
       
       If mstrVoucherType <> "" Then
          strWhere = strWhere & " And (" & mstrVoucherType & ")"
       End If
       
       strVoucherNo = GetVoucherNo(strWhere, Format(detBegin.Text, "yyyy-MM-dd"), Format(detEnd.Text, "yyyy-MM-dd"), CanValNo(strWhere))
       mstrVoucherNo = strVoucherNo
          
       SetFreeCell mclsReportSet.HeadFields + 2, "本次查询凭证张数：", strVoucherNo, , , 30, 20, , False, 1
    End If
    
    ABook.Refresh
    
    mblnAlign = True
    SetAlign
    mblnAlign = False