frmbanreport.frm

金算盘软件代码

  mstrOldDate = detEnd.Text
End Sub

Private Sub Form_Deactivate()
  frmMain.SetEditUnEnabled
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  Select Case KeyCode
   Case vbKeyEscape
      Unload Me
   Case vbKeyPageUp
      If VScroll.Value = VScroll.Min Then
         If mintNowPage > 1 Then
            mintNowPage = mintNowPage - 1
            SetData mintNowPage
            VScroll.Value = VScroll.Max
         End If
      Else
         VScroll.Value = IIf(VScroll.Value - VScroll.LargeChange > VScroll.Min, VScroll.Value - VScroll.LargeChange, VScroll.Min)
      End If
   Case vbKeyPageDown
      If VScroll.Value = VScroll.Max Then
         If mintNowPage < mintPages Then
            mintNowPage = mintNowPage + 1
            SetData mintNowPage
            VScroll.Value = VScroll.Min
         End If
      Else
         VScroll.Value = IIf(VScroll.Value + VScroll.LargeChange < VScroll.Max, VScroll.Value + VScroll.LargeChange, VScroll.Max)
      End If
    Case vbKeyLeft
         HScroll.Value = IIf(HScroll.Value - HScroll.LargeChange > HScroll.Min, HScroll.Value - HScroll.LargeChange, HScroll.Min)
    Case vbKeyRight
         HScroll.Value = IIf(HScroll.Value + HScroll.LargeChange < HScroll.Max, HScroll.Value + HScroll.LargeChange, HScroll.Max)
  End Select
End Sub

Private Sub HScroll_GotFocus()
   PicPaper.SetFocus
End Sub

Private Sub mclsMainControl_FilePrint()
   ReportPrint
End Sub

Private Sub mclsMainControl_ListActivityMenu(ByVal intIndex As Integer)
    If ABook.IsMultiSel Then
        Select Case intIndex
            Case 0, 1, 2
                ABook.SetFCMultiAlignment intIndex + 1
            Case 4, 5, 6
                ABook.SetFCMultiAlignment intIndex
            Case 8, 9, 10
                ABook.SetFCMultiAlignment intIndex - 1
        End Select
    Else
        mblnAlign = True
        If mintFCIndex > mclsReportSet.HeadFields Then
            Select Case intIndex
                Case 0, 1, 2, 3, 4
                    ABook.FCAlignment(mintFCIndex) = intIndex + 1
                    mclsReportSet.CondAlign = intIndex + 1
                Case 6, 7, 8, 9, 10
                    ABook.FCAlignment(mintFCIndex) = intIndex
                    mclsReportSet.CondAlign = intIndex
                Case 12, 13, 14, 15, 16
                    ABook.FCAlignment(mintFCIndex) = intIndex - 1
                    mclsReportSet.CondAlign = intIndex - 1
            End Select
        Else
            Select Case intIndex
                Case 0, 1, 2, 3, 4
                    ABook.FCAlignment(mintFCIndex) = intIndex + 1
                    mclsReportSet.HeadAlign(mintFCIndex) = intIndex + 1
                Case 6, 7, 8, 9, 10
                    ABook.FCAlignment(mintFCIndex) = intIndex
                    mclsReportSet.HeadAlign(mintFCIndex) = intIndex
                Case 12, 13, 14, 15, 16
                    ABook.FCAlignment(mintFCIndex) = intIndex - 1
                    mclsReportSet.HeadAlign(mintFCIndex) = intIndex - 1
            End Select
        End If
    End If
    ABook_FreeCellChanged mintFCIndex
    mblnAlign = False
End Sub

Private Sub ABook_FreeCellChanged(Index As Integer)
    If Index <= mclsReportSet.HeadFields Then
        mclsReportSet.HeadLeft(Index) = ABook.FCLeft(Index) * Screen.TwipsPerPixelX
        mclsReportSet.HeadTop(Index) = ABook.FCTop(Index) * Screen.TwipsPerPixelY
        mclsReportSet.HeadHeight(Index) = ABook.FCHeight(Index) * Screen.TwipsPerPixelY
        mclsReportSet.HeadWidth(Index) = ABook.FCWidth(Index) * Screen.TwipsPerPixelX
        If Not mblnAlign Then
           If ABook.FCPlace = 1 Then
               mclsReportSet.HeadAlign(Index) = ABook.FCAlignment(Index)
           Else
               mclsReportSet.HeadAlign(Index) = 255
           End If
        End If
    Else
        mclsReportSet.CondLeft = ABook.FCLeft(Index) * Screen.TwipsPerPixelX
        mclsReportSet.CondTop = ABook.FCTop(Index) * Screen.TwipsPerPixelY
        mclsReportSet.CondHeight = ABook.FCHeight(Index) * Screen.TwipsPerPixelY
        mclsReportSet.CondWidth = ABook.FCWidth(Index) * Screen.TwipsPerPixelX
        If ABook.FCCaption(Index) = "查询条件：" And Not mblnAlign Then
           If ABook.FCPlace = 1 Then
               mclsReportSet.CondAlign = ABook.FCAlignment(Index)
           Else
               mclsReportSet.CondAlign = 255
           End If
        End If
    End If
    mblnChanged = True
End Sub

Private Sub ABook_TableTopChanged(top As Integer)
    If ABook.RowCount = 0 Then
       Utility.ShowMsg Me.hwnd, "报表不能移出纸外!", vbInformation + vbOKOnly, App.title
       ABook.GridTop = mclsReportSet.GridTop
       ABook.Refresh
       Exit Sub
    End If

    mclsReportSet.GridTop = ABook.GridTop
    GetPages
    mintNowPage = 1
    SetData
    InitScrollbar
End Sub

Private Sub cmbDate_Choose()
    Dim D1 As Date
    Dim D2 As Date
    
    If cmbDate.Text = "自定义" And Not mblnDateChange Then
         mstrOldDate = detBegin.Text
    End If
    
    mblnDateChange = False
    If cmbDate.Text = "所有" Then
        detBegin.Value = Format(gclsBase.BeginDate, "YYYY-MM-DD")
        detEnd.Value = Format(gclsBase.EndDate, "YYYY-MM-DD")
    Else
        If cmbDate.Text = "自定义" Then
            On Error Resume Next
            detBegin.SetFocus
            Exit Sub
        Else
            gclsBase.GetBeginAndEndDate cmbDate.Text, gclsBase.BaseDate, D1, D2
            detBegin.Value = Format(D1, "YYYY-MM-DD")
            detEnd.Value = Format(D2, "YYYY-MM-DD")
            If D1 < CDate(gclsBase.BeginDate) Then
                detBegin.Value = Format(CDate(gclsBase.BeginDate), "YYYY-MM-DD")
                If Format(detEnd.Value, "YYYY-MM-DD") < Format(CDate(gclsBase.BeginDate), "YYYY-MM-DD") Then
                   detEnd.Value = Format(CDate(gclsBase.BaseDate), "YYYY-MM-DD")
                End If
                cmbDate.Text = "自定义"
            End If
        End If
    End If
    
    If mblnRefresh And mblnLoad And Not mblnFirstLoad Then
       MsgForm.PleaseWait
    End If
    mblnDateChange = True
    ReGetHeadCond
    If mblnRefresh Then
       RefreshData GetOtherCond
    End If
    
    If Not mblnFirstLoad Then
       Unload MsgForm
    End If
End Sub

Private Sub cmbDate_LostFocus()
   If Not (Me.ActiveControl Is detBegin Or Me.ActiveControl Is detEnd) Then
     If detBegin.Value > detEnd.Value And detEnd.Text <> "" Then
         Utility.ShowMsg Me.hwnd, "开始时间不能大于终止时间!", vbInformation + vbOKOnly, App.title
         detBegin.Text = mstrOldDate
         detBegin.SetFocus
     End If
   End If
End Sub

Private Sub cmbHead_Choose(Index As Integer)
   
   'On Error Resume Next
 
   If mblnLoad And Not mblnFirstLoad Then
      MsgForm.PleaseWait
   End If
   If cmbHead(Index).Tag = msgcurrency Then
       If cmbHead(Index).Text = "本位币" Or cmbHead(Index).ID = 1 Then
          mblnNature = True
       Else
          mblnNature = False
       End If
       If cmbHead(Index).ReferRow > 1 Then
          mclsReportSet.GetDataField 3, cmbHead(Index).ID
          mbytCurType = 3
          mstrCurrencyName = GetNoXString(cmbHead(Index).Text, 2, " ")
       Else
          If mclsReportSet.PaperID <> 0 Then
            Select Case mclsReportSet.PaperID
            Case 11, 20
                mclsReportSet.GetDataField 2, cmbHead(Index).ID
                mbytCurType = 2
                mstrCurrencyName = ""
            Case 10
                mclsReportSet.GetDataField 1, cmbHead(Index).ID
                mbytCurType = 1
                mstrCurrencyName = ""
            End Select
          Else
            mclsReportSet.GetDataField cmbHead(Index).ReferRow + 1, cmbHead(Index).ID
            mbytCurType = cmbHead(Index).ReferRow + 1
            mstrCurrencyName = ""
          End If
       End If
   End If
   ReGetHeadCond
   If mblnRefresh Then
      RefreshData GetOtherCond
   End If
   If Not mblnFirstLoad Then
      Unload MsgForm
   End If
End Sub

Private Sub cmdNext_Click()
    If mintNowPage < mintPages Then
         mintNowPage = mintNowPage + 1
         SetData mintNowPage
    End If
End Sub

Private Sub CmdPrev_Click()
    If mintNowPage > 1 Then
         mintNowPage = mintNowPage - 1
         SetData mintNowPage
    End If
End Sub

Private Sub cmdDefine_Click()
  Dim lngOldPaper As Long
  On Error GoTo ErrHandle
  If Not Report.MyReportExist(mclsReportSet.ReportID) Then
        Unload Me
        Exit Sub
  End If
  lngOldPaper = mclsReportSet.PaperID
  If frmBanReportSet.SetReport(mclsReportSet, mclsFilterCond, mblnHeadChange) Then
      MsgForm.PleaseWait
      mblnChanged = True
      mclsReportSet.UserCols = mclsReportSet.Columns
      mclsReportSet.GetDataField
      mblnLoad = False
      GetCondition
      mblnLoad = True
      ABook.TabLocked = mclsReportSet.OnlyData
      If lngOldPaper <> 0 And mclsReportSet.PaperID <> lngOldPaper Then
         mclsFset.InitPropertyByDataBase 1, mclsReportSet.ReportID, mclsReportSet.PaperID
         GetDefaultSet
      End If
      RefreshData GetOtherCond
      Form_Resize
      Unload MsgForm
  End If
  Exit Sub
ErrHandle:
End Sub

Private Sub cmdSave_Click()
  Dim strReportName As String
  Dim strErr As String
  
   On Error GoTo ErrHandle
   If Not Report.MyReportExist(mclsReportSet.ReportID) Then
        Unload Me
        Exit Sub
   End If
   
   strReportName = mclsReportSet.ReportName
   If NameIsErr(strReportName, strErr) Then
        If Utility.ShowMsg(Me.hwnd, "报表名称中包含非法字符“" & strErr & "”,是否另存?", vbQuestion + vbYesNo, App.title) = vbYes Then
            If Not frmReportSameName.ShowInputBox("报表名称", strReportName, "另存为", True) Then
               Exit Sub
            End If
        Else
            Exit Sub
        End If
        mclsReportSet.ReportName = strReportName
   End If
   
   If mclsReportSet.Prep = 0 Or mclsReportSet.Prep = 1 Then
        Do While Report.ReportExist(strReportName, mclsReportSet.ParentId, mclsReportSet.ReportID)
            If Utility.ShowMsg(Me.hwnd, "已存在同名报表“" & strReportName & "”,是否另存?", vbQuestion + vbYesNo, App.title) = vbYes Then
                If Not frmReportSameName.ShowInputBox("报表名称", strReportName, "另存为", True) Then
                   Exit Sub
                End If
            Else
                Exit Sub
            End If
        Loop
        mclsReportSet.ReportName = strReportName
   End If
    
   mclsReportSet.SaveReport
   mblnChanged = False
   mclsFilterCond.KeyID = mclsReportSet.ReportID
   mclsFilterCond.UpdateCond
   gclsSys.SendMessage Me.hwnd, msgReport
   Exit Sub
ErrHandle:
End Sub

'显示报表
Public Sub ShowAcntBook(ByVal lngReportID As Long, ByVal ViewId As Long, Optional clsReportSet As ReportSet = Nothing, Optional clsFormCond As FormCond, Optional ByVal BookType As Integer = -1, Optional ByVal AccountID As Long = 0, _
                        Optional ByVal CustomerID As Long = 0)
  Dim strCond As String
  Dim edtErrReturn As ErrDealType

    #If conDebug = 0 Then
        On Error GoTo ErrHandle
    #End If
    
    mblnFirstLoad = True
    mblnLoad = False
    mblnAlign = False
    mblnHeadChange = False
    MsgForm.PleaseWait
    InitDate cmbDate

    frmMain.ActiveForm.Refresh
    '显示已存盘的报表
    If clsReportSet Is Nothing Then
        Set mclsReportSet = New banreport
        Set mclsFilterCond = New FormCond
        mclsReportSet.GetReportSet lngReportID, ViewId
        mclsFilterCond.InitCondArr lngReportID, ViewId, 2, 255, "日期"
    '显示才由向导生成的报表
    Else
        Set mclsReportSet = clsReportSet
        Set mclsFilterCond = clsFormCond
    End If
    
    Set clsReportSet = Nothing