frmcontractreport.frm

金算盘软件代码

        strWhere = mclsListSet.GetWhereInFrom & " And " & strWhere
     End If
   Else
      strWhere = mclsListSet.GetWhereInFrom
   End If
   
   If Not mrstData Is Nothing Then
      On Error Resume Next
      mGrid.RDORecordset = Nothing
      mrstData.Close
      On Error GoTo 0
   End If
      
   mGrid.Clear
   
   If IsDate(detEnd.Text) Then
      strEnd = detEnd.Text
   Else
      strEnd = gclsBase.BaseDate
   End If
   If IsDate(detUse.Text) Then
      strUse = detUse.Text
   Else
      strUse = gclsBase.BaseDate
   End If
   
   strEnd = Format(strEnd, "yyyy-MM-dd")
   strUse = Format(strUse, "yyyy-MM-dd")
   
   Select Case mrtBook
     Case rtDudgetDetail     '工程预算批复明细表
        If mlngRatifyID = 0 Then
            strID = ",Max(Project.lngProjectID) As ID1,0 As ID2,0 As ID3"
            strID = ",Max(Project.strProjectCode),Max(Project.blnIsDetail)" & strID
            strSql = "Select " & mclsListSet.SelectOfSql & strID & mclsListSet.FromOfSql & " Where " & strWhere
            GetProjectQuery strTemp, strsub, 1193
            strSql = strReplace(strSql, "$RPROJECT$", strTemp)
            strSql = strReplace(strSql, "$RPROJECTPAY$", strsub)
            strSql = strReplace(strSql, "JZRQ", strEnd)
            strSql = strReplace(strSql, "YKRQ", strUse)
            strGroup = " Group by " & mclsListSet.GroupOfSql
        Else
            GetSaveData strSelect
            strID = ",Project.lngProjectID As ID1,RatifyDetail.lngRatifyDetailID As ID2,0 As ID3"
            strID = ",Project.strProjectCode,Project.blnIsDetail" & strID
            strSql = "Select " & strSelect & strID & " From RatifyDetail,Project Where RatifyDetail.lngProjectID=Project.lngProjectID And RatifyDetail.lngRatifyID=" & mlngRatifyID
        End If
     
     Case rtContract        '合同汇总表
        strID = ",Max(Project.lngProjectID) As ID1,Max(ProjectOrder.lngOrderID) As ID2,0 As ID3"
        strSql = "Select " & mclsListSet.SelectOfSql & strID & mclsListSet.FromOfSql & " Where " & strWhere
        strGroup = " Group by " & mclsListSet.GroupOfSql
     Case rtRatifyDetail     '批复明细表
        strID = ",Project.lngProjectID As ID1,ProjectOrder.lngOrderID As ID2,0 As ID3"
        strSql = "Select " & mclsListSet.SelectOfSql & strID & mclsListSet.FromOfSql & " Where " & strWhere
     Case rtPayDetail        '合同付款明细表
        strID = ",Project.lngProjectID As ID1,ProjectOrder.lngOrderID As ID2,PayCustomer.lngPayCustomerID As ID3"
        strSql = "Select " & mclsListSet.SelectOfSql & strID & mclsListSet.FromOfSql & " Where " & strWhere
     Case rtPayPlan          '合同付款计划明细表
        strID = ",Project.lngProjectID As ID1,ProjectOrder.lngOrderID As ID2,0 As ID3"
        strSql = "Select " & mclsListSet.SelectOfSql & strID & mclsListSet.FromOfSql & " Where " & strWhere
   End Select
   
   If IsAddFind Then
      AddFind
   End If
   
   If mintPayCount > 0 Then
        If cmbFind.ListIndex + 1 >= mintPayLoc And cmbFind.ListIndex + 1 <= mintPayLoc + mintPayCount - 1 Then
              strOrder = " Order by To_Number(Decode(" & cmbFind.Text & ",Null,0," & cmbFind.Text & "))" & mstrOrder
        Else
           If cmbFind.ListIndex + 1 < mintPayLoc Then
               If UCase(mclsListSet.ColumnFieldType(cmbFind.ListIndex + 1)) = "INTEGER" Or UCase(mclsListSet.ColumnFieldType(cmbFind.ListIndex + 1)) = "LONG" Or UCase(mclsListSet.ColumnFieldType(cmbFind.ListIndex + 1)) = "DOUBLE" Then
                  strOrder = " Order by To_Number(Decode(" & cmbFind.Text & ",Null,0," & cmbFind.Text & "))" & mstrOrder
               Else
                  strOrder = " Order by " & cmbFind.Text & mstrOrder
               End If
           Else
               If UCase(mclsListSet.ColumnFieldType(cmbFind.ListIndex + 1 - (mintPayCount - 1))) = "INTEGER" Or UCase(mclsListSet.ColumnFieldType(cmbFind.ListIndex + 1 - (mintPayCount - 1))) = "LONG" Or UCase(mclsListSet.ColumnFieldType(cmbFind.ListIndex + 1 - (mintPayCount - 1))) = "DOUBLE" Then
                  strOrder = " Order by To_Number(Decode(" & cmbFind.Text & ",Null,0," & cmbFind.Text & "))" & mstrOrder
               Else
                  strOrder = " Order by " & cmbFind.Text & mstrOrder
               End If
           End If
        End If
   Else
        If UCase(mclsListSet.ColumnFieldType(cmbFind.ListIndex + 1)) = "INTEGER" Or UCase(mclsListSet.ColumnFieldType(cmbFind.ListIndex + 1)) = "LONG" Or UCase(mclsListSet.ColumnFieldType(cmbFind.ListIndex + 1)) = "DOUBLE" Then
           strOrder = " Order by To_Number(Decode(" & cmbFind.Text & ",Null,0," & cmbFind.Text & "))" & mstrOrder
        Else
           strOrder = " Order by " & cmbFind.Text & mstrOrder
        End If
   End If
   
   strHeadCond = GetHeadCond
   If mclsListSet.GroupOfSql = "" Then
      strGroup = ""
   End If
   strSql = strSql & " And " & strHeadCond & strGroup & strOrder
   Set mrstData = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
   If mrtBook = rtDudgetDetail And lstReport.ReferRow = 0 Then
      If mrstData.RowCount = 0 Then
         cmdSave.Enabled = False
      Else
         cmdSave.Enabled = True
      End If
   End If
   mGrid.Rows = mrstData.RowCount + 2
   mGrid.Cols = mrstData.rdoColumns.Count
   mGrid.RDORecordset = mrstData
   AddColTitle
   RefreshTotal
   mGrid.Refresh
   mintOldCol = cmbFind.ListIndex
   mblnChoose = True
   Exit Sub
ErrHandle:
End Sub

'级次汇总
Private Function RefreshTotal()
  Dim colCode As Collection
  Dim lngRow As Long, lngAddRow As Long
  Dim strKeyn As String
  Dim strKey As String
    With mGrid
      If .Rows <= 2 Or mintMoneyCol = -1 Or (cmbFind.Text <> "工程项目编号" And cmbFind.Text <> "在建工程编号") Or mrtBook <> rtDudgetDetail Then
         Exit Function
      End If
      Set colCode = New Collection
      If mbytOrder = 1 Then
            For lngRow = 2 To .Rows - 1
                If .CellValue(lngRow, .Cols - 4) = 1 Then
                    strKey = DelStringTail(.CellValue(lngRow, .Cols - 5))
                    Do While strKey <> ""
                       lngAddRow = colCode.Item(strKey)
                       If IsNumeric(.CellValue(lngRow, mintMoneyCol)) Then
                          If IsNumeric(.CellValue(lngAddRow, mintMoneyCol)) Then
                              .CellFormula(lngAddRow, mintMoneyCol) = .CellValue(lngAddRow, mintMoneyCol) + .CellValue(lngRow, mintMoneyCol)
                          Else
                              .CellFormula(lngAddRow, mintMoneyCol) = .CellValue(lngRow, mintMoneyCol)
                          End If
                       End If
                       strKey = DelStringTail(strKey)
                    Loop
                Else
                    colCode.Add CStr(lngRow), Trim(CStr(.CellValue(lngRow, .Cols - 5)))
                End If
            Next lngRow
      Else
            For lngRow = .Rows - 1 To 2 Step -1
                If .CellValue(lngRow, .Cols - 4) = 1 Then
                    strKey = DelStringTail(.CellValue(lngRow, .Cols - 5))
                    Do While strKey <> ""
                       lngAddRow = colCode.Item(strKey)
                       If IsNumeric(.CellValue(lngRow, mintMoneyCol)) Then
                          If IsNumeric(.CellValue(lngAddRow, mintMoneyCol)) Then
                              .CellFormula(lngAddRow, mintMoneyCol) = .CellValue(lngAddRow, mintMoneyCol) + .CellValue(lngRow, mintMoneyCol)
                          Else
                              .CellFormula(lngAddRow, mintMoneyCol) = .CellValue(lngRow, mintMoneyCol)
                          End If
                       End If
                       strKey = DelStringTail(strKey)
                    Loop
                Else
                    colCode.Add CStr(lngRow), Trim(CStr(.CellValue(lngRow, .Cols - 5)))
                End If
            Next lngRow
      End If
    End With
    
End Function

Public Function ShowReport(Optional ByVal EndDate As String = "", Optional ByVal UseDate As String = "", _
                            Optional ByVal lngJobID As Long = 0, Optional ByVal lngOrderID As Long = 0, _
                            Optional lngPayID As Long = 0, Optional rt As ReportType = rtContract)
   
   mblnChoose = False
   mrtBook = rt
   mlngOrderID = lngOrderID
   mlngJobID = lngJobID
   mlngPayID = lngPayID
   mblnDel = False
   mintMoneyCol = -1
   
   Set mclsListSet = New ListSet
   Set mGrid = New WINCTRLLib.DBGridCtrl
   mGrid.hwnd = picBook.hwnd
   mGrid.SelectionMode = 1
   Form_Resize
   CmdGoto.Enabled = True
   mclsListSet.FormatNum = False
   cmdSave.Visible = False
   cmdDel.Visible = False
   
   Select Case mrtBook
     Case rtDudgetDetail
        cmdSave.Visible = True
        cmdDel.Visible = True
        glngContract = Me.hwnd
        mclsListSet.ViewId = 1226
        'mclsListSet.ViewId = 1193
        Me.Caption = "工程预算批复明细表"
        If IsDate(EndDate) Then
           detEnd.Text = EndDate
        End If
        If IsDate(UseDate) Then
           detUse.Text = UseDate
        End If
        AddReport
     Case rtContract
        mclsListSet.ViewId = 1194
        Me.Caption = "合同汇总表"
        If IsDate(EndDate) Then
           detEnd.Text = EndDate
        End If
        AddJob
     Case rtRatifyDetail
        CmdGoto.Enabled = False
        If IsDate(EndDate) Then
           detEnd.Text = EndDate
        End If
        If IsDate(UseDate) Then
           detUse.Text = UseDate
        End If
        mclsListSet.ViewId = 1203
        Me.Caption = "批复明细表"
        AddJob
     Case rtPayDetail
        CmdGoto.Enabled = False
        mclsListSet.ViewId = 1204
        Me.Caption = "合同付款明细表"
        If IsDate(EndDate) Then
           detEnd.Text = EndDate
        End If
        AddJob
        AddPay

     Case rtPayPlan          '合同付款计划明细表
        CmdGoto.Enabled = False
        mclsListSet.ViewId = 1192
        Me.Caption = "合同付款计划明细表"
        AddJob
        AddContract
   End Select
   mblnChoose = True
   If mrtBook = rtDudgetDetail And lstReport.ID <> 0 Then
      AddFind
      lstReport_Choose
   Else
      RefreshData False, True
   End If
   Me.Show
End Function

Private Sub cmbFind_Click()
   If mintOldCol = -1 Then
      Exit Sub
   End If
   If cmbFind.ListIndex = mintOldCol Then
      If mstrOrder = "" Then
         mstrOrder = " Desc"
      Else
         mstrOrder = ""
      End If
   Else
      mstrOrder = ""
   End If
   RefreshData
   mGrid_AfterRowChange mGrid.Row
End Sub

Private Sub cmdAgain_Click()
   FindText txtContent.Text, True
End Sub

Private Sub cmdColset_Click()
   If mclsListSet.ShowListSet(mclsListSet.ViewId, False) Then
       RefreshData , True
   End If
End Sub

Private Sub cmdDel_Click()
  Dim strSql As String
    On Error GoTo ErrHandle
    If ShowMsg(Me.hwnd, "你确定要删除" & """" & lstReport.Text & """" & "吗?", vbQuestion + vbOKCancel, App.title) = vbOK Then
       gclsBase.BaseDB.BeginTrans
       
       strSql = "Delete RatifyField Where lngRatifyID=" & mlngRatifyID
       gclsBase.BaseDB.Execute strSql
       
       strSql = "Delete RatifyDetail Where lngRatifyID=" & mlngRatifyID
       gclsBase.BaseDB.Execute strSql
       
       strSql = "Delete Ratify Where lngRatifyID=" & mlngRatifyID
       gclsBase.BaseDB.Execute strSql
       
       gclsBase.BaseDB.CommitTrans
       AddReport
    End If
    Exit Sub
ErrHandle:
    gclsBase.BaseDB.RollBacktrans
End Sub

Private Sub cmdFilter_Click()
  Dim blnOK As Boolean
    If mclsListSet.ListID < 1 Then
         mclsListSet.SaveList
    End If
    Filter.ShowFilter mclsListSet.ListID, 1, , , , , blnOK
    If blnOK Then
       RefreshData
    End If
End Sub

Private Sub CmdGoto_Click()
   picBook_DblClick
End Sub

Private Sub CmdPrint_Click()
  Dim clsPrint As PrintClass
  Dim strHead As String
  
    Select Case mrtBook
        Case rtDudgetDetail     '工程预算批复明细表
            strHead = "截止日期：" & detEnd.Text & Chr(2) & "预计用款日期：" & detUse.Text
        Case rtContract         '合同汇总表
            strHead = "截止日期：" & detEnd.Text & Chr(2) & "工程项目：" & lstJob.Text
        Case rtRatifyDetail     '批复明细表
            strHead = "截止日期：" & detEnd.Text & Chr(2) & "工程项目：" & lstJob.Text
        Case rtPayDetail        '合同付款明细表
            strHead = "截止日期：" & detEnd.Text & Chr(2) & "工程项目：" & lstJob.Text & Chr(2) & "付款方：" & lstPay.Text
        Case rtPayPlan          '合同付款计划明细表
            strHead = "工程项目：" & lstJob.Text & Chr(2) & "合同号：" & lstContract.Text
    End Select
    
    Set clsPrint = New PrintClass
    clsPrint.PrintNewList gclsBase.BaseDB, mrstData, mGrid.TableHandle, 77, Me.Caption & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName & Chr(1) & strHead
    Set clsPrint = Nothing
End Sub

Private Sub cmdSave_Click()
  Dim strName As String
  Dim lngRatifyID As Long, lngRatifyDetailID As Long, lngFieldID As Long
  Dim strSql As String
  Dim rstReport As rdoResultset
  Dim lngRow As Long, intCol As Integer
  Dim strField As String, strValue As String
    
    If Not frmReportSameName.ShowInputBox("请输入预算批复表名称", strName, , True) Then
       Exit Sub
    End If
   
    strSql = "Select * from Ratify Where lngRatifyID=0"
    Set rstReport = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)