frmreportsumbook.frm

金算盘软件代码

Private Sub cmbDate_LostFocus()
    If Not cmbDate.Visible Then Exit Sub
   If Not (Me.ActiveControl Is detBegin Or Me.ActiveControl Is detEnd) Then
     If Format(detBegin.Value, "YYYY-MM-DD") > Format(detEnd.Value, "YYYY-MM-DD") Then
         Utility.ShowMsg Me.hWnd, "开始时间不能大于终止时间!", vbOKOnly + vbInformation, App.title
         detBegin.SetFocus
     End If
   End If
End Sub


Private Sub detBegin_Change()
    If detBegin.Visible = False Then Exit Sub
    If mstrOldDate <> detBegin.Text & "$" & detEnd.Text And cmbDate.Text <> "自定义" And mblnRefresh Then
        cmbDate.Text = "自定义"
    End If
End Sub

Private Sub detBegin_KeyDown(KeyCode As Integer, Shift As Integer, bCancel As Long)
  Dim blnChange As Boolean
    If detBegin.Visible = False Then Exit Sub
    blnChange = True
    Select Case KeyCode
       Case vbKeyDelete
       Case vbKey0, vbKey1, vbKey2, vbKey3, vbKey4, vbKey5, vbKey6, vbKey7, vbKey8, vbKey9
       Case vbKeyNumpad0, vbKeyNumpad1, vbKeyNumpad2, vbKeyNumpad3, vbKeyNumpad4, vbKeyNumpad5
       Case vbKeyNumpad6, vbKeyNumpad7, vbKeyNumpad8, vbKeyNumpad9, vbKeySubtract, 189
       Case vbKeyReturn
            If detEnd.Visible Then
                detEnd.SetFocus
            Else
                detBegin_LostFocus
            End If
            Exit Sub
       Case Else
          blnChange = False
    End Select
    If blnChange Then
       If mstrOldDate <> detBegin.Text & "$" & detEnd.Text And cmbDate.Text <> "自定义" Then
          cmbDate.Text = "自定义"
       End If
    End If
End Sub

Private Sub detBegin_LostFocus()
  If Not detBegin.Visible Then
'        RefreshData                                    '刷新记录
        Exit Sub
  End If
  If Not (Me.ActiveControl Is detEnd Or Me.ActiveControl Is cmbDate) Then
     
     If Format(detBegin.Value, "YYYY-MM-DD") > Format(detEnd.Value, "YYYY-MM-DD") Then
         Utility.ShowMsg Me.hWnd, "开始时间不能大于终止时间!", vbOKOnly + vbInformation, App.title
         If Trim(detEnd.Text) <> "" Then
            detBegin.Value = Format(detEnd.Value, "YYYY-MM-DD")
         Else
            detEnd.Value = Format(detBegin.Value, "YYYY-MM-DD")
         End If
         detBegin.SetFocus
     Else
         If mblnRefresh And mblnAutoRefresh And mstrOldDate <> detBegin.Text & "$" & detEnd.Text Then
            GetDateCond                                    '得到日期条件
            RefreshData                                    '刷新记录
         End If
         mstrOldDate = detBegin.Text & "$" & detEnd.Text
     End If
  End If
End Sub

Private Sub detCash_LostFocus()
    If detCash.Visible = False Then Exit Sub
    If Not Me.ActiveControl Is detStop Then
        If detCash.Value < detStop.Value Then
            detCash.Text = detStop.Text
            Utility.ShowMsg Me.hWnd, "预计用款日期不能小于截止日期!", vbInformation + vbOKOnly, App.title
            detCash.SetFocus
        Else
            If mblnRefresh And mblnAutoRefresh Then
               GetDateCond                                    '得到日期条件
               RefreshData                                    '刷新记录
            End If
        End If
    End If
End Sub

Private Sub detEnd_Change()
    If Not detEnd.Visible Then Exit Sub
    If mstrOldDate <> detBegin.Text & "$" & detEnd.Text And cmbDate.Text <> "自定义" And mblnRefresh Then
        cmbDate.Text = "自定义"
    End If
End Sub


Private Sub detEnd_KeyDown(KeyCode As Integer, Shift As Integer, bCancel As Long)
Dim blnChange As Boolean
    If detEnd.Visible = False Then Exit Sub
    blnChange = True
    Select Case KeyCode
       Case vbKeyDelete  ',vbKeyBack
       Case vbKey0, vbKey1, vbKey2, vbKey3, vbKey4, vbKey5, vbKey6, vbKey7, vbKey8, vbKey9
       Case vbKeyNumpad0, vbKeyNumpad1, vbKeyNumpad2, vbKeyNumpad3, vbKeyNumpad4, vbKeyNumpad5
       Case vbKeyNumpad6, vbKeyNumpad7, vbKeyNumpad8, vbKeyNumpad9, vbKeySubtract, 189
       Case vbKeyReturn
            detEnd_LostFocus
            Exit Sub
       Case Else
          blnChange = False
    End Select
    If blnChange Then
       If mstrOldDate <> detBegin.Text & "$" & detEnd.Text And cmbDate.Text <> "自定义" Then
          cmbDate.Text = "自定义"
       End If
    End If
End Sub

Private Sub detEnd_LostFocus()
  If Not detEnd.Visible Then Exit Sub
  If Not (Me.ActiveControl Is detBegin Or Me.ActiveControl Is cmbDate) Then

     If Format(detBegin.Value, "YYYY-MM-DD") > Format(detEnd.Value, "YYYY-MM-DD") Then
         Utility.ShowMsg Me.hWnd, "开始时间不能大于终止时间!", vbOKOnly + vbInformation, App.title
         If Trim(detEnd.Text) <> "" Then
            detBegin.Value = Format(detEnd.Value, "YYYY-MM-DD")
         Else
            detEnd.Value = Format(detBegin.Value, "YYYY-MM-DD")
         End If
         detBegin.SetFocus
     Else
         If mblnRefresh And mblnAutoRefresh And mstrOldDate <> detBegin.Text & "$" & detEnd.Text Then
            GetDateCond                                    '得到日期条件
            RefreshData                                    '刷新记录
         End If
     End If
     mstrOldDate = detBegin.Text & "$" & detEnd.Text
  End If
End Sub

Private Sub detStop_GotFocus()
    mstrPreStop = detStop.Text
End Sub

Private Sub detStop_KeyDown(KeyCode As Integer, Shift As Integer, bCancel As Long)
    If detStop.Visible = False Then Exit Sub
    If KeyCode = vbKeyReturn Then
       If detCash.Visible = False Then
            detStop_LostFocus
       Else
            detCash.SetFocus
       End If
    End If
End Sub
Private Sub detStop_LostFocus()
    If Not detStop.Visible Then
          Exit Sub
    End If
    If detCash.Visible = True Then
        If Not Me.ActiveControl Is detCash Then
            If detCash.Value < detStop.Value Then
                detCash.Text = detStop.Text
                Utility.ShowMsg Me.hWnd, "预计用款日期不能小于截止日期!", vbOKOnly + vbInformation, App.title
                detCash.SetFocus
            Else
                If mblnRefresh And mblnAutoRefresh Then
                    GetDateCond                                    '得到日期条件
                    RefreshData                                    '刷新记录
                End If
            End If
        End If
    Else
        If mblnRefresh And mblnAutoRefresh And mstrPreStop <> detStop.Text Then
            GetDateCond                                    '得到日期条件
            RefreshData                                    '刷新记录
        End If
    End If
End Sub

Private Sub cmdAccSet_Click()
Dim blnIsOK As Boolean
Dim intOldLists As Integer, intDiff As Integer

    If Not MyReportExist(mclsSum.ReportID) Then
        mblnFatalErr = True
        Unload Me
        Exit Sub
    End If
    
    '调用向导
    intOldLists = mclsSum.ListColumns
    blnIsOK = mclsSum.ShowWizard(, mclsSum.ParentId, mclsSum.Level, mclsFormCond, mclsFormFilt, False)
    If blnIsOK Then
         mblnRefresh = False
         intDiff = mclsSum.ListColumns - intOldLists
         If intDiff <> 0 Then
            mclsCell.ReSetCellNo intDiff
            mclsCell.ReSetDateCellLoc
         End If
         InitHeadList
         mclsSum.SetSQL
         RefreshData blnIsOK                                       '刷新纪录
         mblnRefresh = True
         mblnChanged = True
         If blnIsOK = False And mblnFatalErr = False Then
            Utility.ShowMsg Me.hWnd, "固定列太多而超宽，程序将关闭窗体！", vbOKOnly + vbInformation, App.title
            Unload Me
         End If
    End If
End Sub

Private Sub CmdPrint_Click()
    If Not MyReportExist(mclsSum.ReportID) Then
        mblnFatalErr = True
        Unload Me
        Exit Sub
    End If
    
    ReportPrint
    frmMain.ZOrder 0
End Sub
Private Sub cmdSave_Click()
Dim frm As New frmReportSameName
Dim blnIsSameName As Boolean, blnIsOK As Boolean, blnErr As Boolean
Dim strName As String, strErr As String, strOLdName As String
    
    If mblnSaving Then Exit Sub
    If mblnChanged = False Then Exit Sub
    mblnSaving = True
    If Not MyReportExist(mclsSum.ReportID) Then
        mblnFatalErr = True
        mblnSaving = False
        Unload Me
        Exit Sub
    End If
    
    '是否有同名报表
    strName = mclsSum.ReportName
    strOLdName = strName
    blnErr = Report.NameIsErr(strName, strErr)
    If blnErr Then
        blnIsOK = frm.ShowInputBox("报表不能有非法字符:'" & strErr & "',请输入新的报表名!", strName, , True)
        If Not blnIsOK Then
            mblnSaving = False
            Exit Sub
        End If
    End If
    blnIsSameName = Report.ReportExist(strName, mclsSum.ParentId, mclsSum.ReportID)
    Do While blnIsSameName
       blnIsOK = frm.ShowInputBox("已有同名报表了,请输入新的报表名!", strName, , True)
       If blnIsOK Then
            blnIsSameName = Report.ReportExist(strName, mclsSum.ParentId, mclsSum.ReportID)
       Else
            mblnSaving = False
            Exit Sub
       End If
    Loop
    Set frm = Nothing
    '保存
    MsgForm.PleaseWait "正在保存数据，请稍候．．．"
    mclsSum.ReportName = strName
    blnIsOK = mclsSum.SaveStandard                             '保存报表属性
    If blnIsOK = False Then GoTo ExitHandle
    mclsFormCond.KeyID = mclsSum.ReportID
    mclsFormCond.UpdateCond                                    '保存报表条件
    mclsFormFilt.KeyID = mclsSum.ReportID
    mclsFormFilt.UpdateCond                                    '保存报表条件
    Caption = mclsSum.ReportName                               '窗体标题
    mclsCell.ReportID = mclsSum.ReportID
    mclsCell.SaveFreeCell
    ReSetTitle
    ABook.Refresh
    gclsSys.SendMessage Me.hWnd, msgReport
    Unload MsgForm
    mblnChanged = False
    mblnSaving = False
    Exit Sub
ExitHandle:
    mblnSaving = False
    Unload MsgForm
    mclsSum.ReportName = strOLdName
    Utility.ShowMsg Me.hWnd, "保存报表失败,请稍后重新保存!", vbCritical + vbOKOnly, App.title
End Sub
Private Sub cmdSaveAs_Click()
Dim frm As New frmReportSameName
Dim blnIsSameName As Boolean, blnIsOK As Boolean
Dim strName As String, strOLdName As String
    
    If mblnSaving Then Exit Sub
    mblnSaving = True
    If Not MyReportExist(mclsSum.ReportID) Then
        mblnFatalErr = True
        mblnSaving = False
        Unload Me
        Exit Sub
    End If
    
    strName = mclsSum.ReportName
    strOLdName = strName
    '是否有同名报表
    blnIsSameName = Report.ReportExist(strName, mclsSum.ParentId, mclsSum.ReportID, False)
    Do While blnIsSameName
       blnIsOK = frm.ShowInputBox("已有同名报表了,请输入新的报表名!", strName, , True)
       If blnIsOK Then
            blnIsSameName = Report.ReportExist(strName, mclsSum.ParentId, mclsSum.ReportID, False)
       Else
            mblnSaving = False
            Exit Sub
       End If
    Loop
    Set frm = Nothing
    '保存
    MsgForm.PleaseWait "正在保存数据，请稍候．．．"
    mclsSum.ReportName = strName
    blnIsOK = mclsSum.SaveStandard(True)                                      '保存报表属性
    If blnIsOK = False Then GoTo ExitHandle
    
    mclsFormCond.KeyID = mclsSum.ReportID
    mclsFormCond.UpdateCond                                         '保存报表条件
    mclsFormFilt.KeyID = mclsSum.ReportID
    mclsFormFilt.UpdateCond                                         '保存报表条件
    mclsCell.ReportID = mclsSum.ReportID
    mclsCell.SaveFreeCell
    Caption = mclsSum.ReportName         '窗体标题
    ReSetTitle
    ABook.Refresh
    gclsSys.SendMessage Me.hWnd, msgReport
    Unload MsgForm
    mblnChanged = False
    mblnSaving = False
    Exit Sub
ExitHandle:
    mblnSaving = False
    Unload MsgForm
    mclsSum.ReportName = strOLdName
    Utility.ShowMsg Me.hWnd, "保存报表失败,请稍后重新保存!", vbCritical + vbOKOnly, App.title
End Sub


Private Sub Form_Activate()
    gclsSys.CurrFormName = Me.hWnd
    Utility.SetHelpID Me.HelpContextID
    Report.SetReportTlb
End Sub