frmreportsumbook.frm

金算盘软件代码

    End If
    
    Select Case mclsSum.ViewId
    Case 595    '工资报表
        If Val(mclsSum.SalaryID) = 0 Then
            Unload MsgForm
            Utility.ShowMsg Me.hWnd, "请原谅:还没有发放工资,不能打开报表!", vbInformation + vbOKOnly, App.title
            Unload Me
            Exit Sub
        End If
        #If conHos = 0 Then
        Salary.UpdateSalary_lngPersonTaxID
        #End If
    Case 666, 667, 755, 773, 756, 758, 759, 760, 1193, 1246, 1247 '固定资产
    Case Else
        Utility.InitDate cmbDate
        GetDateName str, strCap
        lblD.Tag = str
        lblD.Caption = strCap
    End Select
    
    Set mclsCell = New FreeCellSet
    mclsCell.ReportID = lngReportID
    mclsCell.ReportName = mclsSum.ReportName
    mclsCell.DateCellInitNo = mclsSum.ListColumns + 2
    mclsCell.LoadFreeCell
    
    Set mclsFset = New ClsFormatset
    mclsFset.InitPropertyByDataBase 8, mclsSum.ReportID
    GetDefaultSet
    
    '设置GRID的TOP
    If mclsSum.GridTop = 0 Then
        SetGridTop 90
    Else
        SetGridTop mclsSum.GridTop / Screen.TwipsPerPixelY
    End If
    mlngCurPage = 1
    InitHeadList
    mclsSum.SetSQL
    mblnAutoRefresh = True
    RefreshData                                                                  '涮新数据
    mstrOldDate = detBegin.Text & "$" & detEnd.Text
    
    If mblnFatalErr Then
        Unload MsgForm
        Exit Sub
    End If
    ABook.FCLocked = 1
    mblnRefresh = True
    mblnLoaded = True
    
    StandardReport.AddHelpID Me, mclsSum.GroupNo          '加帮助ID
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    Utility.LoadFormSetting Me
    Me.Show
        Exit Sub
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload MsgForm
         Unload Me
    End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                          *          控件事件处理              *
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''



Private Sub ABook_ColumnResize(col As Integer, ByVal width As Integer, bCancel As Integer)
'返回给类与GRID
    Dim intStart As Integer, intCol As Integer, intCount As Integer
    Dim lngFixedWidth As Long, lngWidth As Long
    If col = -1 Then
    Else
        If width >= ABook.ColCount Then
            Utility.ShowMsg Me.hWnd, "列太宽!", vbOKOnly + vbInformation, App.title
            bCancel = 1
            Exit Sub
        End If
        If col < mclsSum.FixedCol Then
            '取固定列宽度
            lngFixedWidth = 0
            For intCol = 1 To msgTitle.FixedCols
                lngFixedWidth = lngFixedWidth + msgTitle.ColWidth(intCol) / Screen.TwipsPerPixelX
            Next intCol
            intStart = 0
            '改变后列宽度
            lngFixedWidth = lngFixedWidth - msgTitle.ColWidth(intStart + col + 1) / Screen.TwipsPerPixelX + width
            If lngFixedWidth > mlngPageWidth Then
                Utility.ShowMsg Me.hWnd, "固定列太宽!", vbOKOnly + vbInformation, App.title
                bCancel = 1
                Exit Sub
            End If
        ElseIf col = mclsSum.FixedCol Then
            '取固定列宽度
            lngFixedWidth = 0
            For intCol = 1 To msgTitle.FixedCols - 1
                lngFixedWidth = lngFixedWidth + msgTitle.ColWidth(intCol) / Screen.TwipsPerPixelX
            Next intCol
            intStart = 0
            '改变后列宽度
            lngFixedWidth = lngFixedWidth + width
            If lngFixedWidth > mlngPageWidth Then
                Utility.ShowMsg Me.hWnd, "列太宽!", vbOKOnly + vbInformation, App.title
                bCancel = 1
                Exit Sub
            End If
        Else
            intStart = mlngColStart(mlngCurPage - 1)
        End If
        lngWidth = IIf(width > 0, width * Screen.TwipsPerPixelX, 0)
        intStart = intStart + col
        If mintPayLoc >= 0 Then
            If intStart < mintPayLoc Then
                msgTitle.ColWidth(intStart + 1) = lngWidth
                mclsSum.ColumnWidth(mclsSum.ChoosedLoc(intStart)) = lngWidth
            ElseIf intStart >= mintPayLoc + mintPayCount Then
                msgTitle.ColWidth(intStart + 1) = lngWidth
                mclsSum.ColumnWidth(mclsSum.ChoosedLoc(intStart - mintPayCount + 1)) = lngWidth
            Else
                For intCount = 0 To mintPayCount - 1
                    msgTitle.ColWidth(mintPayLoc + intCount + 1) = lngWidth
                Next intCount
                mclsSum.ColumnWidth(mclsSum.ChoosedLoc(intStart - mintPayCount + 1)) = lngWidth
            End If
        Else
            msgTitle.ColWidth(intStart + 1) = lngWidth
            mclsSum.ColumnWidth(mclsSum.ChoosedLoc(intStart)) = lngWidth
        End If
        bCancel = 0
    End If
    
    If DispartPage Then                                   '分页
        SetData                                        '填充数据
    End If
    mblnChanged = True
End Sub

Private Sub ABook_FCMouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
Dim blnHead As Boolean
    
    If Button = vbRightButton Then
        mintFCIndex = Index
        If ABook.IsMultiSel Then       '如果表头栏目多选
            Report.FreeCellFatSet
        Else
            blnHead = ABook.Postion(Index) - 1
            If Index <= mclsSum.ListColumns + 1 Or mclsCell.IsDateCell(mintFCIndex) Then
            Else
                StandardReport.CallFreeCellMenu blnHead
                PopupMenu frmMain.mnuListActivity
            End If
        End If
    End If
End Sub


Private Sub ABook_FreeCellChanged(Index As Integer)
Dim intLoc As Integer, intAlign As Integer

    If ABook.FCPlace = 1 Then
        intAlign = ABook.FCAlignment(Index)
    Else
        intAlign = 255
    End If
    With mclsSum
        If Index = 0 Then
            .TitleHeight = ABook.FCHeight(Index) * Screen.TwipsPerPixelX
            .TitleWidth = ABook.FCWidth(Index) * Screen.TwipsPerPixelX
            .TitleLeft = ABook.FCLeft(Index) * Screen.TwipsPerPixelX
            .TitleTop = ABook.FCTop(Index) * Screen.TwipsPerPixelX
            .TitleAlign = intAlign
        ElseIf Index = 1 Then
            .CondHeight = ABook.FCHeight(Index) * Screen.TwipsPerPixelX
            .CondWidth = ABook.FCWidth(Index) * Screen.TwipsPerPixelX
            .CondLeft = ABook.FCLeft(Index) * Screen.TwipsPerPixelX
            .CondTop = ABook.FCTop(Index) * Screen.TwipsPerPixelX
            .CondAlign = intAlign
        ElseIf Index < .ListColumns + 2 Then
            '表头列表框栏目
            intLoc = .ColumnListLoc(Index - 2)
            .ColumnHeight(intLoc) = ABook.FCHeight(Index) * Screen.TwipsPerPixelX
            .ColumnWidth(intLoc) = ABook.FCWidth(Index) * Screen.TwipsPerPixelX
            .ColumnLeft(intLoc) = ABook.FCLeft(Index) * Screen.TwipsPerPixelX
            .ColumnTop(intLoc) = ABook.FCTop(Index) * Screen.TwipsPerPixelX
            .ColumnAlign(intLoc) = intAlign
        Else
        '处理报表标题
            mclsCell.FindLoc Index, intLoc
            mclsCell.CellHeight(intLoc) = ABook.FCHeight(Index) * Screen.TwipsPerPixelX
            mclsCell.CellWidth(intLoc) = ABook.FCWidth(Index) * Screen.TwipsPerPixelX
            mclsCell.CellLeft(intLoc) = ABook.FCLeft(Index) * Screen.TwipsPerPixelX
            mclsCell.CellTop(intLoc) = ABook.FCTop(Index) * Screen.TwipsPerPixelX
            mclsCell.CellAlign(intLoc) = intAlign
        End If
    End With
    mblnChanged = True
End Sub

Private Sub ReGetCellChanged()
Dim Index As Integer
    For Index = 0 To mclsCell.FreeCells + mclsSum.ListColumns + 1
       ABook_FreeCellChanged Index
    Next Index
End Sub

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
    Else
    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)
    mclsSum.GridTop = top * Screen.TwipsPerPixelY
    If DispartPage Then                                   '分页
        SetData                                        '填充数据
    End If
    mblnChanged = True
End Sub

Private Sub cboList_Choose(Index As Integer)
    If mblnRefresh And mblnAutoRefresh 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 cboMonth_Choose()
    If Not cboMonth.Visible Then Exit Sub
    If mblnRefresh And mblnAutoRefresh Then
        GetDateCond                                    '得到列表框条件
        RefreshData                                    '刷新记录
    End If
End Sub

Private Sub cmbDate_Choose()
    Dim D1 As Date
    Dim D2 As Date
    If cmbDate.Visible = False Then Exit Sub
    If cmbDate.Text = "所有" Then
        mstrOldDate = "$" & detEnd.Text
        detBegin.Text = ""
        mstrOldDate = "$"
        detEnd.Text = ""
    Else
        If cmbDate.Text = "自定义" Then
'            detBegin.SetFocus
            Exit Sub
        Else
            gclsBase.GetBeginAndEndDate cmbDate.Text, Format(gclsBase.BaseDate, "YYYY-MM-DD"), D1, D2
            mstrOldDate = Format(D1, "YYYY-MM-DD") & "$" & detEnd.Text
            detBegin.Value = Format(D1, "YYYY-MM-DD")
            mstrOldDate = detBegin.Text & "$" & Format(D2, "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
    mstrOldDate = detBegin.Text & "$" & detEnd.Text
    If mblnRefresh And mblnAutoRefresh Then
        GetDateCond                                    '得到列表框条件
        RefreshData                                    '刷新记录
    End If
End Sub