frmac_bookresult.frm

一个用VB写的财务软件源码

    
End Sub

'联查凭证
Public Sub uVoucherResult()
    Call cllR_mousedclick(m_iCol, m_iRow)
End Sub


'账页格式被改变时触发
Private Sub cboAccountFormat_Click()
    Dim sOldAccountFormat As String     '账页原先格式
    
    If Not m_bFormLoad Then
        sOldAccountFormat = usAccountFormat
        usAccountFormat = cboAccountFormat.List(cboAccountFormat.ListIndex)
        If IsColChange(Me.Cllr, m_iColWidth) = True Then
            If MsgBox(sOldAccountFormat & "账簿格式已经改变，是否保存？", vbQuestion + vbYesNo + vbDefaultButton2) = vbYes Then
                Call SaveColChange(m_iColWidth, usAccountType, sOldAccountFormat)
            End If
        End If
        Select Case usAccountFormat
            Case "金额式"
                m_sDefaultColWidth = COLWIDTH_MONEY
            Case "数量金额式"
                m_sDefaultColWidth = COLWIDTH_AMOUNT
            Case "外币金额式"
                m_sDefaultColWidth = COLWIDTH_FOREIGN
            Case "数量外币式"
                m_sDefaultColWidth = COLWIDTH_AMOUNT_FOREIGN
        End Select
        m_iColWidth = GetColWidth(usAccountType, usAccountFormat, m_sDefaultColWidth)
        m_iColWidthTemp = m_iColWidth
        
        Select Case usAccountFormat
            Case "金额式"
                Call DoRedrawCellHead(m_iColWidth, COL_DEBIT_MONEY, COL_DEBIT_MONEY, _
                        COL_CREDIT_MONEY, COL_CREDIT_MONEY, COL_BALANCE_MONEY, COL_BALANCE_MONEY, _
                        ROW_HEAD1, ROW_HEAD2)
            Case "数量金额式"
                Call DoRedrawCellHead(m_iColWidth, COL_DEBIT_AMOUNT, COL_DEBIT_MONEY, _
                        COL_CREDIT_AMOUNT, COL_CREDIT_MONEY, COL_BALANCE_AMOUNT, COL_BALANCE_MONEY, _
                        ROW_HEAD1, ROW_HEAD1)
            Case "外币金额式"
                Call DoRedrawCellHead(m_iColWidth, COL_DEBIT_FOREIGN, COL_DEBIT_MONEY, _
                        COL_CREDIT_FOREIGN, COL_CREDIT_MONEY, COL_BALANCE_FOREIGN, COL_BALANCE_MONEY, _
                        ROW_HEAD1, ROW_HEAD1)
            Case "数量外币式"
                Call DoRedrawCellHead(m_iColWidth, COL_DEBIT_AMOUNT, COL_DEBIT_MONEY, _
                        COL_CREDIT_AMOUNT, COL_CREDIT_MONEY, COL_BALANCE_AMOUNT, COL_BALANCE_MONEY, _
                        ROW_HEAD1, ROW_HEAD1)
        End Select
    End If
End Sub

Private Sub cboSubject_Click()
   With CboSubject
        If Not m_bFormLoad And m_sPreSubject <> .text Then
            m_sSubjCode = Mid(CboSubject.text, 1, InStr(1, CboSubject.text, "=") - 1)
            m_sSubjName = Mid(CboSubject.text, InStr(1, CboSubject.text, "=") + 1)
            Me.ShowResult
            CboSubject.SetFocus
        End If
        m_sPreSubject = .text
    End With
End Sub

'调整列宽时触发
Private Sub Cllr_AllowSizeCol(ByVal col As Long, ByVal row As Long, approve As Long)
    Dim vCurColWidth As Variant
    Dim lCurChangeCol As Long
    Dim iTotalPages As Integer
    Dim lCurrentPage As Long
    Dim bChangeColWidth As Boolean
    Dim i As Long
    Dim j As Long
    
    Select Case usAccountFormat
        Case "金额式"
            If col = COL_UNIT_PRICE Or col = COL_EXCHANGE_RATE Or _
                col = COL_DEBIT_AMOUNT Or col = COL_DEBIT_FOREIGN Or _
                col = COL_CREDIT_AMOUNT Or col = COL_CREDIT_FOREIGN Or _
                col = COL_BALANCE_AMOUNT Or col = COL_BALANCE_FOREIGN Then
                approve = False
            Else
                approve = True
            End If
        Case "数量金额式"
            If col = COL_EXCHANGE_RATE Or col = COL_DEBIT_FOREIGN Or _
                col = COL_CREDIT_FOREIGN Or col = COL_BALANCE_FOREIGN Then
                approve = False
            Else
                approve = True
            End If
        Case "外币金额式"
            If col = COL_UNIT_PRICE Or col = COL_DEBIT_AMOUNT Or _
                col = COL_CREDIT_AMOUNT Or col = COL_BALANCE_AMOUNT Then
                approve = False
            Else
                approve = True
            End If
        Case "数量外币式"
            approve = True
    End Select
    If col = COL_END + 1 Then
        approve = False
    End If
    
    '如果某页某列的列宽改变，则重新设置所有页的该列列宽
    For i = LBound(m_iColWidthTemp) To UBound(m_iColWidthTemp)
     vCurColWidth = Cllr.GetColWidth(1, i, Cllr.GetCurSheet)
        If vCurColWidth <> "" Then
            If vCurColWidth <> m_iColWidthTemp(i) Then
                bChangeColWidth = True
                m_iColWidthTemp(i) = vCurColWidth
                lCurChangeCol = i
            End If
        End If
    Next i

    With Cllr
        If bChangeColWidth Then
            lCurrentPage = .GetCurSheet
            iTotalPages = .GetTotalSheets
            For i = 0 To iTotalPages - 1
                .SetCurSheet i
                .SetColWidth 1, m_iColWidthTemp(lCurChangeCol), lCurChangeCol, i
            Next i
            .SetCurSheet lCurrentPage
        End If
    End With
End Sub

'调整行高时触发
Private Sub cllR_allowsizerow(ByVal col As Long, ByVal row As Long, approve As Long)
    approve = False
End Sub

'双击单元格
'------------------changjh edit-----------
Private Sub cllR_mousedclick(ByVal col As Long, ByVal row As Long)
    Dim frmV As frmVoucher
    Dim VoucherMuster As AccountExtend.clsVoucherCollentionCx
    Dim iGlo As GlobalInterface.clsGlobal, iGlosys As GlobalInterface.clsGlobalSys

    Dim sMonth As String
    Dim sDay As String
    Dim sPZZL As String
    Dim sPZBH As String
    
    On Error GoTo handl:

    sMonth = Cllr.GetCellString(2, row, Cllr.GetCurSheet)
    sDay = Cllr.GetCellString(3, row, Cllr.GetCurSheet)
    sPZZL = Cllr.GetCellString(4, row, Cllr.GetCurSheet)
    sPZBH = Cllr.GetCellString(5, row, Cllr.GetCurSheet)
    
    If sMonth <> "" And sDay <> "" And sPZZL <> "" And sPZBH <> "" Then
        '当所在行在凭证记录上时, 调用凭证查询
        If CInt(sMonth) >= 1 And CInt(sMonth) <= 12 _
            And CInt(sDay) >= 1 And CInt(sDay) <= 31 And sPZZL <> "" And sPZBH <> "" Then
                Set frmV = New frmVoucher
                Set VoucherMuster = New AccountExtend.clsVoucherCollentionCx
                Set iGlo = New GlobalInterface.clsGlobal
                Set iGlosys = New GlobalInterface.clsGlobalSys
                InitGloInface iGlo, iGlosys
                VoucherMuster.iGlo = iGlo
                VoucherMuster.iGlosys = iGlosys
                VoucherMuster.Add sPZBH, sPZZL, glo.sOperateYear & "-" & CStr(sMonth) & "-" & sDay
                VoucherMuster.Index = 1
                VoucherMuster.Voucher = VoucherMuster.Item(1)
                VoucherMuster.Voucher.Load
                 
                frmV.LoadObject = "AccountExtend.clsVoucherCollentionCx"
                Load frmV
                frmV.cBr.Bands(4).Visible = False
                frmV.Show
                frmV.LoadingObjects = VoucherMuster
                frmV.Reload VoucherMuster.Voucher
        End If
    End If
    Exit Sub
handl:
   MsgBox "本行不是最明细科目", vbOKOnly
End Sub
'---------------------edit end-------------


Private Sub cllR_OnRClickGrid(ByVal col As Long, ByVal row As Long, ByVal updn As Boolean)
    If updn = False Then
        m_iCol = col
        m_iRow = row
        fMainForm.mnuBalanceResult.Visible = True
        fMainForm.mnuDetailResult.Visible = False
        fMainForm.mnuVoucherResult.Visible = True
        fMainForm.mnuDailyResult.Visible = False
        PopupMenu fMainForm.mnuQueryAccount
    End If
End Sub

Private Sub Form_Activate()
TbrControl False
End Sub

Private Sub Form_Deactivate()
TbrControl True
End Sub

Private Sub form_load()
    m_bFormLoad = True
    TbrControl False
'    Me.Caption = "日记账查询 - “" & m_sSubjCode & "=" & m_sSubjName & "”"
    usAccountType = "日记账"
    usAccountFormat = "金额式"
    Select Case usAccountFormat
        Case "金额式"
            m_sDefaultColWidth = COLWIDTH_MONEY
        Case "数量金额式"
            m_sDefaultColWidth = COLWIDTH_AMOUNT
        Case "外币金额式"
            m_sDefaultColWidth = COLWIDTH_FOREIGN
        Case "数量外币式"
            m_sDefaultColWidth = COLWIDTH_AMOUNT_FOREIGN
    End Select
    '求出各列的宽度
    m_iColWidth = GetColWidth(usAccountType, usAccountFormat, m_sDefaultColWidth)
    m_iColWidthTemp = m_iColWidth
    
    
    '设置COMBOX
    Call SetRjzkm
    
    With Cllr
        .Login "南京伊康计算机工程公司", "11010504", "0060-1733-7722-3004"
        If .OpenFile(App.Path & "\CellFiles\Book.cll", "") = -1 Then
            MsgBox "CELL文件不存在！", vbOKOnly
        End If
        .SetCols COL_END + 2, 0
        .SetRows ROW_GRID_START + ROWS_PAGE, 0
        .SetDefaultFont .FindFontIndex("宋体", 1), 10
        .WorkbookReadonly = True
        .AllowSizeColInGrid = True
    End With

    m_bFormLoad = False
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    Cllr.Width = Me.ScaleWidth - 100
    Cllr.Height = Me.ScaleHeight - 200
End Sub

'窗体卸载前, 检查账页的列宽是否被调整
Private Sub Form_Unload(Cancel As Integer)
    Cancel = 0
    If IsColChange(Me.Cllr, m_iColWidth) = True Then
        If MsgBox(usAccountFormat & "账簿格式已经改变，是否保存？", _
                    vbQuestion + vbYesNo + vbDefaultButton2) = vbYes Then
            Call SaveColChange(m_iColWidth, usAccountType, usAccountFormat)
        End If
    End If
    TbrControl True
    m_Mutex.DeleteMutexID gloSys.sSubSysId, glo.sAccountID, "mnuAccountBook", m_iID
End Sub

Private Sub SetGrid(ByVal PageNo As Long, Optional ByVal FactRows As Long)
    Dim i As Long, j As Long
    Dim iAmountLen As Integer       '数量单位字符串的长度
    Dim iForeignlen As Integer      '外币单位字符串的长度
    Dim iPageNoLen As Integer       '页号字符串的长度
    Dim maxLen As Integer           '最大字符串的长度
    
    With Cllr
        .SetCurSheet PageNo - 1
        .SetRows FactRows, PageNo - 1
        .SetCols COL_END + 2, PageNo - 1
        .SetSelectMode PageNo - 1, 2
        .SetFixedCol COL_START, COL_BILL
        .SetFixedRow ROW_TITLE, ROW_HEAD2