frmcontractreport.frm

金算盘软件代码

       detEnd.Visible = True
       lblJob.Visible = True
       lstJob.Visible = True
       lblPay.Visible = True
       lstPay.Visible = True
       
       lblDate.Left = conLeft
       detEnd.Left = lblDate.Left + lblDate.width + conCtlComp
       detEnd.top = cmbFind.top + cmbFind.Height + conRowComp
       lblDate.top = detEnd.top + (detEnd.Height - lblDate.Height) / 2
       
       lstPay.Left = Me.width - conRight - lstPay.width
       lblPay.Left = lstPay.Left - lblPay.width - conCtlComp
       lstPay.top = detEnd.top
       lblPay.top = lblDate.top
       
       lblJob.Left = lblContent.Left
       lstJob.Left = lblJob.Left + lblJob.width + conCtlComp
       lstJob.width = lblPay.Left - lstJob.Left - conRowComp
       lblJob.top = lblDate.top
       lstJob.top = detEnd.top
       
       picBook.Left = conLeft
       picBook.width = Me.width - conLeft - conRight
       picBook.top = detEnd.top + detEnd.Height + conRowComp
       picBook.Height = cmdFilter.top - picBook.top - conRowComp
    Case rtPayPlan           '合同付款计划明细表
       lblCon.Visible = True
       lstContract.Visible = True
       lblJob.Visible = True
       lstJob.Visible = True
       
       lstContract.Left = Me.width - conRight - lstContract.width
       lblCon.Left = lstContract.Left - lblCon.width - conCtlComp
       lstContract.top = cmbFind.top + cmbFind.Height + conRowComp
       lblCon.top = lstContract.top + (lstContract.Height - lblCon.Height) / 2
       
       lblJob.Left = conLeft
       lstJob.Left = lblJob.Left + lblJob.width + conCtlComp
       lstJob.width = lblCon.Left - lstJob.Left - conRowComp
       lblJob.top = lblCon.top
       lstJob.top = lstContract.top
       
       picBook.Left = conLeft
       picBook.width = Me.width - conLeft - conRight
       picBook.top = detEnd.top + detEnd.Height + conRowComp
       picBook.Height = cmdFilter.top - picBook.top - conRowComp
  End Select
  Exit Sub
ErrHandle:
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Dim objTemp As Object
  Dim strHwnd As String
  
   If glngContract = Me.hwnd Then
      glngContract = 0
   End If
   
   Erase mstrPay
   gclsSys.MainControls.Remove Me
   strHwnd = CStr(Me.hwnd)
   
   Set lstReport.Recordset = Nothing
   
   Set mclsMainControl = Nothing
   Set mGrid = Nothing
   Set mrstData = Nothing
   Set mclsListSet = Nothing

   Set objTemp = gcolContract.Item(strHwnd)
   Set objTemp = Nothing
   gcolContract.Remove strHwnd
End Sub

Private Sub lstContract_Choose()
  RefreshData
End Sub

Private Sub lstjob_Choose()
  RefreshData
End Sub

Private Sub lstPay_Choose()
   RefreshData
End Sub

Private Sub lstReport_Choose()
   If lstReport.ReferRow = 0 Then
       cmdSave.Enabled = True
       cmdDel.Enabled = False
       cmdFilter.Enabled = True
       cmdColset.Enabled = True
       detEnd.Enabled = True
       detUse.Enabled = True
   Else
       cmdSave.Enabled = False
       cmdDel.Enabled = True
       cmdFilter.Enabled = False
       cmdColset.Enabled = False
       detEnd.Enabled = False
       detUse.Enabled = False
   End If
   
   If Not mblnChoose Then
      Exit Sub
   End If
   
   If detEnd.Text = "" Then
      detEnd.Text = Format(gclsBase.BaseDate, "yyyy-MM-dd")
   End If
   
   If detUse.Text = "" Then
      detUse.Text = Format(gclsBase.BaseDate, "yyyy-MM-dd")
   End If
   
   If mlngRatifyID <> 0 And lstReport.ID = 0 Then
       Set mclsListSet = New ListSet
       mclsListSet.ViewId = 1226
   End If
   
   mlngRatifyID = lstReport.ID
   mintCount = Val(lstReport.TextMatrix(lstReport.ReferRow, 3))
   mintPayLoc = Val(lstReport.TextMatrix(lstReport.ReferRow, 4))
   mintPayCount = Val(lstReport.TextMatrix(lstReport.ReferRow, 5))
   If lstReport.ReferRow > 0 Then
      detEnd.Text = lstReport.TextMatrix(lstReport.ReferRow, 6)
      detUse.Text = lstReport.TextMatrix(lstReport.ReferRow, 7)
   End If
   RefreshData
End Sub

Private Sub mclsMainControl_EditColumn()
   cmdColset_Click
End Sub

Private Sub mclsMainControl_EditFilter()
   cmdFilter_Click
End Sub

Private Sub mclsMainControl_FilePrint()
    CmdPrint_Click
End Sub

Private Sub mclsMainControl_ListReportMenu(ByVal intIndex As Integer)
   Select Case intIndex
     Case 0
        cmdFilter_Click
     Case 1
        cmdColset_Click
     Case 2
        CmdGoto_Click
     Case 3
        CmdPrint_Click
   End Select
End Sub

Private Sub mclsMainControl_ToolRefresh()
   RefreshData
End Sub

Private Sub mGrid_AfterRowChange(ByVal Row As Long)
  Dim intFindCol As Integer
  Dim intStart As Integer, intLen As Integer
    intFindCol = cmbFind.ListIndex
    mblnNotFind = True
    intStart = txtContent.SelStart
    intLen = txtContent.SelLength
    If mGrid.Rows > 1 And mGrid.Row > 0 Then
        txtContent.Text = IIf(IsNull(mGrid.CellValue(mGrid.Row, intFindCol)), "", mGrid.CellValue(mGrid.Row, intFindCol))
        On Error Resume Next
        txtContent.SelStart = intStart
        txtContent.SelLength = Len(txtContent.Text) - intStart
    Else
        txtContent.Text = ""
    End If
    mlngLastPosition = mGrid.Row
    mblnNotFind = False
End Sub

Private Sub mGrid_BeforeChange(Val As String, Cancel As Long)
  Dim strSql As String, lngDetailID As Long
   With mGrid
    If Trim(Val) <> "" And Not IsNumeric(Val) Then
       Cancel = True
       Exit Sub
    End If
    If Trim(Val) <> "" Then
        If IsNumeric(.CellValue(.Row, mintRequire)) Then
            .CellFormula(.Row, .Cols - 6) = .CellValue(.Row, mintRequire) + Val
        Else
            .CellFormula(.Row, .Cols - 6) = Val
        End If
    Else
        If IsNumeric(.CellValue(.Row, mintRequire)) Then
            .CellFormula(.Row, .Cols - 6) = .CellValue(.Row, mintRequire)
        Else
            .CellFormula(.Row, .Cols - 6) = 0
        End If
    End If
    If IsNumeric(Val) Then
        lngDetailID = .CellValue(.Row, .Cols - 2)
        strSql = "Update RatifyDetail Set dblData20=" & Val & " Where lngRatifyID=" & mlngRatifyID & " And lngRatifyDetailID=" & lngDetailID
        gclsBase.BaseDB.Execute strSql
    End If
   End With
End Sub

Private Sub mGrid_BeforeEdit(ByVal Row As Long, ByVal col As Integer, Cancel As Long)
    If mrtBook <> rtDudgetDetail Then
       Cancel = True
       Exit Sub
    End If
    
    If lstReport.ReferRow = 0 Then
       Cancel = True
       Exit Sub
    End If
    
    '不是增减变动列
    If Not (Row >= 2 And col = mGrid.Cols - 7) Then
       Cancel = True
       Exit Sub
    End If
    '非末级
    If mGrid.CellValue(Row, mGrid.Cols - 4) <> 1 Then
       Cancel = True
       Exit Sub
    End If
End Sub

Private Sub picBook_DblClick()
  Dim intCol As Integer, lngRow As Long, lngPayID As Long
  Dim frmReport As frmContractReport
  Dim strPay As String, rstPay As rdoResultset, strSql As String, strTitle As String
  
   On Error GoTo ErrHandle
   mGrid.MouseCell lngRow, intCol
   If intCol > mGrid.Cols - 1 Then
      If mrtBook = rtDudgetDetail Then
         intCol = mGrid.Cols - 6
      Else
         intCol = mGrid.Cols - 4
      End If
   End If
   If lngRow > mGrid.Rows - 1 Then
      lngRow = mGrid.Rows - 1
   End If
   
   If mGrid.Rows <= 2 Or lngRow <= 1 Then
      If lngRow <= 1 Then
            If intCol = mintOldCol Then
                cmbFind_Click
            Else
                If mintPayCount > 0 And intCol + 1 >= mintPayLoc And intCol + 1 <= mintPayLoc + mintPayCount - 1 Then
                   strTitle = mGrid.CellFormula(1, intCol)
                Else
                   strTitle = mGrid.CellFormula(0, intCol)
                End If
                cmbFind.Text = strTitle
            End If
      End If
      Exit Sub
   End If
   
   Select Case mrtBook
     Case rtDudgetDetail     '工程预算批复明细表
          If mGrid.CellValue(0, intCol) = "合同金额" Then
             Set frmReport = New frmContractReport
             Load frmReport
             frmReport.ShowReport detEnd.Text, detUse.Text, mGrid.CellValue(lngRow, mGrid.Cols - 3), mGrid.CellValue(lngRow, mGrid.Cols - 2), mGrid.CellValue(lngRow, mGrid.Cols - 1), rtContract
          End If
          If mGrid.CellValue(0, intCol) = "批复金额" Then
             Set frmReport = New frmContractReport
             Load frmReport
             frmReport.ShowReport detEnd.Text, detUse.Text, mGrid.CellValue(lngRow, mGrid.Cols - 3), mGrid.CellValue(lngRow, mGrid.Cols - 2), mGrid.CellValue(lngRow, mGrid.Cols - 1), rtRatifyDetail
          End If
          If mintPayCount > 0 And intCol >= mintPayLoc - 1 And intCol <= mintPayLoc + mintPayCount - 2 Then
              strPay = mGrid.CellValue(1, intCol)
              If strPay <> "合计" Then
                 strSql = "Select * From PayCustomer Where strPayCustomerName='" & strPay & "'"
                 Set rstPay = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                 If rstPay.EOF Then
                    rstPay.Close
                    Set rstPay = Nothing
                    Exit Sub
                 End If
                 lngPayID = rstPay!lngPayCustomerID
                 rstPay.Close
                 Set rstPay = Nothing
              Else
                 lngPayID = 0
              End If
              Set frmReport = New frmContractReport
              Load frmReport
              frmReport.ShowReport detEnd.Text, detUse.Text, mGrid.CellValue(lngRow, mGrid.Cols - 3), mGrid.CellValue(lngRow, mGrid.Cols - 2), lngPayID, rtPayDetail
          End If
     Case rtContract        '合同汇总表
          Set frmReport = New frmContractReport
          Load frmReport
          frmReport.ShowReport detEnd.Text, detUse.Text, mGrid.CellValue(lngRow, mGrid.Cols - 3), mGrid.CellValue(lngRow, mGrid.Cols - 2), mGrid.CellValue(lngRow, mGrid.Cols - 1), rtPayPlan
   End Select
   Exit Sub
ErrHandle:
End Sub

'装载弹出菜单
Private Sub InitMenu(Optional EditObject As String = "")
  Dim intCount As Integer
  Dim intMenus As Integer
  
    With frmMain
        intMenus = .mnuListReportMenu.Count - 1
        For intCount = intMenus To 1 Step -1
            Unload .mnuListReportMenu(intCount)
        Next
        For intCount = 1 To 3
           Load .mnuListReportMenu(intCount)
        Next intCount
        
        .mnuEditFilter.Enabled = True
        .mnuEditColumn.Enabled = True
        .mnuFilePrint.Enabled = True
        
        .mnuListReportMenu(0).Caption = "筛选(&F)"
        .mnuListReportMenu(0).Enabled = True
        .mnuListReportMenu(0).Visible = True
        
        .mnuListReportMenu(1).Caption = "栏目设置(&M)"
        .mnuListReportMenu(1).Enabled = True
        .mnuListReportMenu(1).Visible = True
        
        .mnuListReportMenu(2).Caption = "关联(&L)"
        .mnuListReportMenu(2).Enabled = CmdGoto.Enabled
        .mnuListReportMenu(2).Visible = False
        
        .mnuListReportMenu(3).Caption = "打印(&P)"
        .mnuListReportMenu(3).Enabled = True
        .mnuListReportMenu(3).Visible = True
        
   End With
End Sub

Private Sub picBook_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  If Button = vbRightButton Then
     InitMenu
     PopupMenu frmMain.mnuListReport
  End If
End Sub

Private Sub txtContent_Change()
   If No