frmcashsettle.frm

金算盘软件代码

Option Explicit
Private mNotSaveInput As Boolean     '单据号默认前缀
Private mstrAlpha As String          '单据号默认前缀
Private mstrErrMsg As String         '错误信息
Private mblnMayChange As Boolean     '可修改标志
Private mblnIsChanged As Boolean     '被修改标志
Private blnColVisible() As Boolean   '列可视性
Private Customer As CustomerProperty '单位相关属性
Private mlngVoucherID As Long        '凭证ID
Private mblnPrinted As Long          '已打印标志
Private mlngOperatorID As Long       '原单据操作员ID
Private ReceiptType As Long          '39--采购付款 40--销售收款
Private strColName() As String
Private lngCurrDec As Long
Private mdblCurrRate As Double
Private strCurrDec As String
Private strPriceDec As String
Private mblnSucceed As Long
Private WithEvents mclsGrid As Grid
Attribute mclsGrid.VB_VarHelpID = -1
Private xlngColNo() As Long
Private mlngOldCol As Long
Private mlngReceiptTypeID As Long
Private mlngActivityID As Long
Private mstrDoing As String
Private frmName As Form
Private mlngMsgNO As Message
Private Type RowData    '行属性
    lngAccountID As Long
    lngPaymentMethodID As Long
    lngDepartmentID As Long
    lngEmployeeID As Long
    lngClassID1 As Long
    lngClassID2 As Long
    blnIsCheck As Boolean   '票据管理标志
    blnIsCustomer As Boolean
    blnIsDepartment As Boolean
    blnIsEmployee As Boolean
    blnIsClass1 As Boolean
    blnIsClass2 As Boolean
    blnIsQuantity As Boolean
    lngActivityDetailID As Long '收付款单据名细ID
    lngActivityID As Long       '收付款单据ID
    lngCheck As Long            '票据管理，1---需要票据管理
    lngDiscountID As Long       '折扣单据ID
    Account As AccountblnOther  '科目相关属性
    intYear As Long             '会计年度
    bytPeriod As Long           '期间
    strDate As String           '日期
End Type
Private RowDatas() As RowData
Private mlngARAPTempLateID As Long
Private mlngDiscTempLateID As Long
Private mlngDiscAccountID As Long
Private mblnFirst As Boolean
Public Function ShowMe(frmTmp As Form) As Long
    'return:0---cancel -1---未现结 1---已现结
    On Error Resume Next
    mblnSucceed = 0
    Set frmName = frmTmp
    mlngReceiptTypeID = C2lng(frmName.lblHead(2).Tag)
    If mlngReceiptTypeID < 12 Then
        mstrDoing = "付款"
        ReceiptType = 39
    Else
        mstrDoing = "收款"
        ReceiptType = 40
    End If
    mlngActivityID = frmName.getID()
    mlngARAPTempLateID = 0
    mlngDiscTempLateID = 0
    mlngDiscAccountID = 0
    
    Me.Show vbModal
    ShowMe = mblnSucceed
End Function
Public Function GetGridRefID(ByVal strName As String, ByVal lngRowno As Long) As Long
    If lngRowno > GrdCol.Rows - 1 Or lngRowno < 1 Then
        Exit Function
    End If
    lngRowno = GrdCol.RowData(lngRowno)
    Select Case UCase(strName)
    Case UCase("Account")
        GetGridRefID = RowDatas(lngRowno).lngAccountID
    Case UCase("PaymentMethod")
        GetGridRefID = RowDatas(lngRowno).lngPaymentMethodID
    Case UCase("Department")
        GetGridRefID = RowDatas(lngRowno).lngDepartmentID
    Case UCase("Employee")
        GetGridRefID = RowDatas(lngRowno).lngEmployeeID
    Case UCase("Class1")
        GetGridRefID = RowDatas(lngRowno).lngClassID1
    Case UCase("Class2")
        GetGridRefID = RowDatas(lngRowno).lngClassID2
    Case UCase("ActivityID")
        GetGridRefID = RowDatas(lngRowno).lngActivityID
    Case UCase("ActivityDetailID")
        GetGridRefID = RowDatas(lngRowno).lngActivityDetailID
    Case UCase("Check")
        GetGridRefID = RowDatas(lngRowno).lngCheck
    Case UCase("Discount")
        GetGridRefID = RowDatas(lngRowno).lngDiscountID
    Case Else
        GetGridRefID = 0
    End Select
End Function

Private Sub Form_Activate()
    If Me.HelpContextID <> 0 Then
        SetHelpID Me.HelpContextID
    End If
    If mblnFirst = False Then
        mblnFirst = True
        refHead(0).SetFocus
    End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        If Me.ActiveControl Is GrdCol Then
        Else
            BKKEY Me.ActiveControl.hwnd, vbKeyTab
        End If
    End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = 93 Then
        If GrdCol.Row > 0 Then
            mnuEditDel.Enabled = True
        Else
            mnuEditDel.Enabled = False
        End If
        PopupMenu mnuEdit
        Exit Sub
    End If
End Sub

Private Sub Form_Load()
    Dim i As Long
    Dim j As Long
    Dim lngTmp As Long

    Screen.MousePointer = vbHourglass
    Utility.LoadFormResPicture Me
    
    mdblCurrRate = C2Dbl(frmName.lblField(6).Caption)
    lngCurrDec = CurrencyDec(frmName.getFieldID(7))
    If BillPublic.blnCurrencyInDirect(frmName.getFieldID(7)) Then
        mdblCurrRate = 1 / mdblCurrRate
    End If
    strCurrDec = FormatString(lngCurrDec)
    strPriceDec = FormatString(gclsBase.PriceDec)
    hlb(0).TextAlign = fmTextAlignRight
    
    GrdCol.Redraw = False
    Set mclsGrid = New Grid
    Set mclsGrid.Grid = GrdCol
    Set mclsGrid.Form = Me
    mclsGrid.ListSet.ViewId = 999999999 '虚拟视图
'    mclsGrid.ColOfs = 1
    GrdCol.Cols = 14
    mclsGrid.ListSet.Columns = GrdCol.Cols - 1
        
    lblHead(7).Caption = mstrDoing & "单据模板(&T)"
    GrdCol.TextMatrix(0, 1) = mstrDoing & "日期"
    GrdCol.TextMatrix(0, 2) = mstrDoing & "单据号"
    GrdCol.TextMatrix(0, 3) = "现金/银行科目"
    GrdCol.TextMatrix(0, 4) = mstrDoing & "方式"
    GrdCol.TextMatrix(0, 5) = "票据号"
    GrdCol.TextMatrix(0, 6) = "原币" & mstrDoing & "金额"
    GrdCol.TextMatrix(0, 7) = "本币" & mstrDoing & "金额"
    GrdCol.TextMatrix(0, 8) = "原币折扣金额"
    GrdCol.TextMatrix(0, 9) = "本币折扣金额"
    GrdCol.TextMatrix(0, 10) = "部门"
    GrdCol.TextMatrix(0, 11) = "职员"
    GrdCol.TextMatrix(0, 12) = "统计"
    GrdCol.TextMatrix(0, 13) = "项目"
    
    ReDim strColName(GrdCol.Cols - 1)
    ReDim xlngColNo(GrdCol.Cols - 1)
     
    For i = 0 To GrdCol.Cols - 1
        If InStr(GrdCol.TextMatrix(0, i), "金额") > 0 Then
            GrdCol.ColAlignment(i) = flexAlignRightCenter
        Else
            GrdCol.ColAlignment(i) = flexAlignLeftCenter
        End If
        strColName(i) = GrdCol.TextMatrix(0, i)
        xlngColNo(i) = i
    Next
'    mclsGrid.ColOfs = 2
'    mclsGrid.ListSetToGrid
    LoadGrdColWidth
    mclsGrid.ShowTotal = True
    mclsGrid.SetupStyle
    mclsGrid.SetEditText mstrDoing & "日期", , , , dtmInput
    mclsGrid.SetEditText mstrDoing & "单据号", , , , txtInput
    mclsGrid.SetEditText "现金/银行科目", , , , refInput
    mclsGrid.SetEditText mstrDoing & "方式", , , , refInput
    mclsGrid.SetEditText "票据号", , , , txtInput
    mclsGrid.SetEditText "原币" & mstrDoing & "金额", , , , curInput
    mclsGrid.SetEditText "本币" & mstrDoing & "金额", , , , curInput
    mclsGrid.SetEditText "原币折扣金额", , , , curInput
    mclsGrid.SetEditText "本币折扣金额", , , , curInput
    mclsGrid.SetEditText "部门", , , , refInput
    mclsGrid.SetEditText "职员", , , , refInput
    mclsGrid.SetEditText "统计", , , , refInput
    mclsGrid.SetEditText "项目", , , , refInput
    
    InitForm
    If GrdCol.ColWidth(0) <> 0 Then
        GrdCol.ColWidth(0) = 0
    End If
    GrdCol.Rows = 1
    GrdCol.Redraw = True
    
    '----------------------------------
    'CAIQIKE
    ReDim blnColVisible(14)
    LoadBill mlngActivityID
    SetMayChange
    SetChange
    mblnIsChanged = False
    '----------------------------------
    If GrdCol.Row > 0 Then
        cmdOkCancel(3).Enabled = mblnMayChange
    Else
        cmdOkCancel(3).Enabled = False
    End If
    Screen.MousePointer = vbDefault
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim i  As Long
    
    If mblnIsChanged Then
        
        For i = 1 To GrdCol.Rows - 1
            RowDatas(GrdCol.RowData(i)).intYear = gclsBase.FYearOfDate(C2Date(GrdCol.TextMatrix(i, xlngColNo(1))))
            RowDatas(GrdCol.RowData(i)).bytPeriod = gclsBase.PeriodOfDate(C2Date(GrdCol.TextMatrix(i, xlngColNo(1))))
            If RowDatas(GrdCol.RowData(i)).intYear > 0 Then
                Call blnMaxNODecrease(RowDatas(GrdCol.RowData(i)).intYear, RowDatas(GrdCol.RowData(i)).bytPeriod, ReceiptType, mstrAlpha, strDigitOfStr(GrdCol.TextMatrix(i, xlngColNo(2))))
            End If
        Next
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If Me.MousePointer = vbHourglass Then
        Cancel = 1
        Exit Sub
    End If
    SaveGrdColWidth
    Utility.UnLoadFormResPicture Me
    Erase strColName
    Erase xlngColNo
    Erase RowDatas
    Set mclsGrid = Nothing
End Sub

Private Sub GrdCol_Mouseup(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim i As Integer
    Dim j As Long
    Dim lngRowBak As Long
        
    If GrdCol.Row > 0 Then
        cmdOkCancel(3).Enabled = mblnMayChange
    Else
        cmdOkCancel(3).Enabled = False
    End If
    If Button = vbRightButton Then
        If GrdCol.Row > 0 Then
            mnuEditDel.Enabled = mblnMayChange
        Else
            mnuEditDel.Enabled = False
        End If
        mnuEditNew.Enabled = mblnMayChange
        PopupMenu mnuEdit
        Exit Sub
    End If
    If y < GrdCol.RowHeight(0) Then
        GrdCol.Redraw = False
        For i = 0 To GrdCol.Cols - 1
            If x > GrdCol.ColPos(i) And x < GrdCol.ColPos(i) + GrdCol.ColWidth(i) Then
                lngRowBak = GrdCol.RowData(GrdCol.MouseRow)
                GrdCol.Row = 0
                GrdCol.col = i
                If GrdCol.ColAlignment(i) = flexAlignRightCenter Then
                    If InStr(GrdCol.TextMatrix(0, i), "金额") <> 0 Then
                        For j = 1 To GrdCol.Rows - 1
                            GrdCol.TextMatrix(j, i) = C2Dbl(GrdCol.TextMatrix(j, i))
                        Next
                    End If
                    If InStr(GrdCol.TextMatrix(0, i), "↑") <> 0 Then
                        GrdCol.TextMatrix(0, i) = ColName(i) & "↓"
                        
                        GrdCol.Sort = flexSortNumericDescending
                    Else
                        GrdCol.TextMatrix(0, i) = ColName(i) & "↑"
                        
                        GrdCol.Sort = flexSortNumericAscending
                    End If
                    If InStr(GrdCol.TextMatrix(0, i), "金额") <> 0 Then
                        For j = 1 To GrdCol.Rows - 1
                            GrdCol.TextMatrix(j, i) = Format(C2Dbl(GrdCol.TextMatrix(j, i)), strCurrDec)
                        Next
                    End If
                Else
                    If InStr(GrdCol.TextMatrix(0, i), "↑") <> 0 Then
                        GrdCol.TextMatrix(0, i) = ColName(i) & "↓"
                        
                        GrdCol.Sort = flexSortStringNoCaseDescending
                    Else
                        GrdCol.TextMatrix(0, i) = ColName(i) & "↑"
                        
                        GrdCol.Sort = 5
                    End If
                End If
                For j = 1 To GrdCol.Rows - 1
                    If GrdCol.RowData(j) = lngRowBak Then
                        GrdCol.Row = j
                        If Not GrdCol.RowIsVisible(j) Then
                            GrdCol.TopRow = j
                        End If
                        Exit For
                    End If
                Next
            Else
                GrdCol.TextMatrix(0, i) = ColName(i)
            End If
        Next
        GrdCol.Redraw = True
    End If
End Sub