frmquotabook.frm

金算盘软件代码

Private Sub ABook_HFMouseUp(Button As Integer, Shift As Integer, x As Single, y As Single, pos As Integer)
Dim blnAddCell As Boolean

    If Button = vbRightButton Then
         If Not frmMain.ActiveForm Is Me Then Exit Sub
         StandardReport.CallReportPopMenu                      '装载窗体弹出菜单资源
         mlngCellTop = y
         mlngCellLeft = x
         mbytCellType = pos
         If pos = 1 Then
            blnAddCell = mclsCell.CanAddHead
         Else
            blnAddCell = False
         End If
         frmMain.mnuListReportMenu(3).Enabled = cmdSave.Enabled
         If ABook.FCLocked = 1 Then
            frmMain.mnuListReportMenu(8).Checked = True
            frmMain.mnuListReportMenu(9).Enabled = False
            frmMain.mnuListReportMenu(10).Enabled = False
         Else
            frmMain.mnuListReportMenu(8).Checked = False
            frmMain.mnuListReportMenu(9).Enabled = True
            frmMain.mnuListReportMenu(10).Enabled = True
         End If
         frmMain.mnuListReportMenu(9).Checked = IIf(ABook.FCPlace = 0, False, True)
         frmMain.mnuListReportMenu(13).Checked = mblnAutoRefresh
         PopupMenu frmMain.mnuListReport
    End If
End Sub

Private Sub ABook_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then
         If Not frmMain.ActiveForm Is Me Then Exit Sub
         StandardReport.CallReportPopMenu                      '装载窗体弹出菜单资源
         frmMain.mnuListReportMenu(3).Enabled = cmdSave.Enabled
         If ABook.FCLocked = 1 Then
            frmMain.mnuListReportMenu(8).Checked = True
            frmMain.mnuListReportMenu(9).Enabled = False
            frmMain.mnuListReportMenu(10).Enabled = False
         Else
            frmMain.mnuListReportMenu(8).Checked = False
            frmMain.mnuListReportMenu(9).Enabled = True
            frmMain.mnuListReportMenu(10).Enabled = True
         End If
         frmMain.mnuListReportMenu(9).Checked = IIf(ABook.FCPlace = 0, False, True)
         frmMain.mnuListReportMenu(13).Checked = mblnAutoRefresh
         PopupMenu frmMain.mnuListReport
    End If
End Sub

Private Sub ABook_RowHeightChange()
    If DispartPage Then                                   '分页
        SetData                                        '填充数据
    End If
End Sub

Private Sub ABook_RowScroll(ByVal Distance As Long)
    Dim lngValue As Long
    lngValue = VScroll.Value + Distance
    If lngValue > VScroll.Max Then
        VScroll.Value = VScroll.Max
    ElseIf lngValue < VScroll.Min Then
        VScroll.Value = VScroll.Min
    Else
        VScroll.Value = lngValue
    End If
End Sub

Private Sub ABook_TableTopChanged(top As Integer)
    mclsQuota.GridTop = top * Screen.TwipsPerPixelY
    If DispartPage Then                                                     '分页
        SetData                                                          '填充数据
    End If
    mblnChanged = True
End Sub

Private Sub cboList_Choose(Index As Integer)
    If mblnAutoRefresh And Not mblnRefresh Then
        GetListCond                                    '得到列表框条件
        RefreshData                                    '刷新记录
    End If
End Sub
Private Sub cboList_ItemNotExist(Index As Integer)
    Utility.ShowMsg Me.hwnd, GetNoXString(LblList(Index).Caption, 1, "(") & "“" & cboList(Index).Text & "”不存在!", vbInformation + vbOKOnly, App.title
    cboList(Index).SetFocus
End Sub

Private Sub cmdAccSet_Click()
Dim blnIsOK As Boolean
Dim intOldLists As Integer, intDiff As Integer
    If Not MyReportExist(mclsQuota.ReportID) Then
        mblnFatalErr = True
        Unload Me
        Exit Sub
    End If
    
    '调用向导
    intOldLists = mclsQuota.ListColumns
    blnIsOK = mclsQuota.ShowWizard(, mclsQuota.ParentId, mclsQuota.Level, mclsFormCond, False)
    If blnIsOK Then
        intDiff = mclsQuota.ListColumns - intOldLists
        If intDiff <> 0 Then
            mclsCell.ReSetCellNo intDiff
        End If
        mclsQuota.SetSQL
        InitHeadList
        RefreshData                                      '刷新纪录
        mblnChanged = True
    End If
End Sub

Private Sub CmdPrint_Click()
    Dim frm As New frmPrint
    Dim i As Long
    Dim oldPage As Long
    Dim lngStartPage, lngEndPage As Long
    Dim intOldFormat As Integer
    
    If Not MyReportExist(mclsQuota.ReportID) Then
        mblnFatalErr = True
        Unload Me
        Exit Sub
    End If
    
    If frm.ShowFrmPrint(1, CInt(mlngPages), mclsFset.PrintSetupID) Then
        mclsFset.InitPropertyByDataBase 10, mclsQuota.ReportID
        GetDefaultSet
        If Not DispartPage Then
            Utility.ShowMsg Me.hwnd, "分页失败,打印取消!", vbOKOnly + vbInformation, App.title
            Exit Sub
        End If
        oldPage = mlngCurPage
        If frm.GIsPrintOnPrinter Then       '打印
            Dim x As Printer
            Dim strDevName As String
            For Each x In Printers
                If x.DeviceName = frm.GDeviceName Then
                    If mblnOrient Then
                        ABook.SelectPrinter x.DeviceName, x.DriverName, x.Port, PaperHeight / 5.67, PaperWidth / 5.67, 1, mclsFset.GPaperTypeIndex
                    Else
                        ABook.SelectPrinter x.DeviceName, x.DriverName, x.Port, PaperWidth / 5.67, PaperHeight / 5.67, 2, mclsFset.GPaperTypeIndex
                    End If
                    GoTo PrintStart
                End If
            Next
            Set frm = Nothing
            Utility.ShowMsg Me.hwnd, "未发现选定打印机(" & frm.GDeviceName & ")!", vbOKOnly + vbInformation, App.title
            Exit Sub
PrintStart:
            ABook.StartPrint mclsQuota.ReportName
            
            intOldFormat = ABook.Negative
            If frm.GIsColorPrint Then               '彩色打印
                ABook.Negative = 1                  '将负数设为红字
            Else
                ABook.Negative = 0
            End If
            
            If frm.GPrintRange = 0 Then         '全部打印
                lngStartPage = 1
                lngEndPage = mlngPages
            Else                                '从 X 页到 Y 页
                lngStartPage = frm.GBeginPagePrint
                lngEndPage = frm.GEndPagePrint
            End If
            
            If frm.GIsPagebyPage Then         '逐份打印
                For i = 1 To frm.GCopiesPrint       '打印份数
                    If Not frm.GIsDoublePrint Then          '单面打印
                        For mlngCurPage = lngStartPage To lngEndPage
                            SetData
                            ABook.PrintDirect
                        Next mlngCurPage
                    Else                                    '双面打印
                        
'********************************     奇数页        ************************************************

                        If frm.GIsPrintByOrderOne Then          '按顺序 1 打印，起始页必须为奇数 (5,3,1)
                            For mlngCurPage = (lngEndPage \ 2) * 2 + IIf(lngEndPage Mod 2 = 0, -1, 1) To lngStartPage Step -2 '5,3,1
                            SetData
                            ABook.PrintDirect
                            Next mlngCurPage
                        Else                                    '不按顺序 1 打印，起始页必须为奇数 (1,3,5)
                            For mlngCurPage = lngStartPage + IIf(lngStartPage Mod 2 = 0, 1, 0) To lngEndPage Step 2  '1,3,5
                            SetData
                            ABook.PrintDirect
                            Next mlngCurPage
                        End If
                                
'*******************************    偶数页          **************************************************

                        If frm.GIsPrintbyPrderTwo Then          '按顺序 2 打印，起始页必须为偶数 (6,4,2)
                            For mlngCurPage = lngEndPage + IIf(lngEndPage Mod 2 = 0, 0, -1) To lngStartPage Step -2  '6,4,2
                            SetData
                            ABook.PrintDirect
                            Next mlngCurPage
                        Else                                    '当前页必须为偶数 (2,4,6)
                            For mlngCurPage = lngStartPage + IIf(lngStartPage Mod 2 = 0, 0, 1) To lngEndPage Step 2 '2,4,6
                            SetData
                            ABook.PrintDirect
                            Next mlngCurPage
                        End If
                        
                    End If '单面打印
                Next i '打印份数
                
            Else '逐页打印
            
                If Not frm.GIsDoublePrint Then          '单面打印
                    For mlngCurPage = lngStartPage To lngEndPage
                        For i = 1 To frm.GCopiesPrint '打印份数
                            SetData
                            ABook.PrintDirect
                        Next i
                    Next mlngCurPage
                Else                                    '双面打印
                    If frm.GIsPrintByOrderOne Then          '按顺序 1 打印，起始页必须为奇数 (5,3,1)
                        For mlngCurPage = lngEndPage + IIf(lngEndPage Mod 2 = 0, -1, 0) To lngStartPage Step -2  '5,3,1
                            For i = 1 To frm.GCopiesPrint
                            SetData
                            ABook.PrintDirect
                            Next i
                        Next mlngCurPage
                    Else                    '不按顺序 1 打印，起始页必须为奇数 (1,3,5)
                        For mlngCurPage = lngStartPage + IIf(lngStartPage Mod 2 = 0, 1, 0) To lngEndPage Step 2 '1,3,5
                            For i = 1 To frm.GCopiesPrint
                            SetData
                            ABook.PrintDirect
                            Next i
                        Next mlngCurPage
                    End If
                        
                    If frm.GIsPrintbyPrderTwo Then          '按顺序 2 打印，起始页必须为偶数 (6,4,2)
                        For mlngCurPage = lngEndPage + IIf(lngEndPage Mod 2 = 0, 0, -1) To lngStartPage Step -2 '6,4,2
                            For i = 1 To frm.GCopiesPrint
                            SetData
                            ABook.PrintDirect
                            Next i
                        Next mlngCurPage
                    Else                                '按顺序 2 打印，起始页必须为偶数 (2,4,6)
                        For mlngCurPage = lngStartPage + IIf(lngStartPage Mod 2 = 0, 0, 1) To lngEndPage Step 2 '2,4,6
                            For i = 1 To frm.GCopiesPrint
                            SetData
                            ABook.PrintDirect
                            Next i
                        Next mlngCurPage
                    End If
                    
                End If '单面打印
            End If '逐份打印
        
            ABook.EndPrint
            mlngCurPage = oldPage
            ABook.Negative = intOldFormat
            SetData
        Else                '输出到文件
            Dim clsFileSever As New FileSeverClass
            If frm.GintFileType = 4 Then
                If Not clsFileSever.SaveAS(frm.GStrFileName, 4, , , msgAccount, , mclsQuota.ReportName, frm.GintFileIndex) Then
                    Utility.ShowMsg Me.hwnd, "文件保存不成功!", vbOKOnly + vbInformation, App.title
                End If
            ElseIf frm.GintFileType = 5 Then   '打印到ET文件
                Dim clsEtPrint As New clsReport2ET
                Set clsEtPrint.msgGrid = msgAccount
                SetEtFormatSet clsEtPrint              '设置ET格式（HB）
                SetEtColTitle clsEtPrint               '设置ET列标题
                SetEtFreeCell clsEtPrint               '设置ET自由单元
                clsEtPrint.SaveAS frm.GStrFileName, msgAccount
            Else
                If Not clsFileSever.SaveAS(frm.GStrFileName, frm.GintFileType, , , msgAccount, , mclsQuota.ReportName) Then
                    Utility.ShowMsg Me.hwnd, "文件保存不成功!", vbOKOnly + vbInformation, App.title
                End If
            End If
            Set clsFileSever = Nothing
        End If
    Else
        If DispartPage Then
            SetData
        End If
    End If
    Set frm = Nothing
    
    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 And mclsQuota.ReportPrep > 0 Then Exit Sub
    mblnSaving = True
    If Not MyReportExist(mclsQuota.ReportID) Then
        mblnFatalErr = True
        mblnSaving = False
        Unload Me
        Exit Sub
    End If
    
    If mclsQuota.ReportPrep = 0 Then
        mblnSaving = False
        cmdSaveAs_Click
        mblnSaving = False
        Exit Sub
    End If
    '是否有同名报表
    strName = mclsQuota.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, mclsQuota.ParentId, mclsQuota.ReportID)
    Do While blnIsSameName
       blnIsOK = frm.ShowInputBox("已有同名报表了,请输入新的报表名!", strName, , True)
       If blnIsOK Then
            blnIsSameName = Report.ReportExist(strName, mclsQuota.ParentId, mclsQuota.ReportID)
       Else
            mblnSaving = False
            Exit Sub
       End If
    Loop
    Set frm = Nothing
    '保存
    MsgForm.PleaseWait "正在保存数据，请稍候．．．"