⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 account.bas

📁 金算盘软件代码
💻 BAS
📖 第 1 页 / 共 5 页
字号:
🔍
12345 
'    SqlStr = "{ ? =  CALL NewBalance( " & lngActivityID & ", " & lngReceiptTypeID & ") } "
'    Set TmpQ.ActiveConnection = gclsBase.BaseDB
'    TmpQ.sql = SqlStr
'    TmpQ(0).Type = rdTypeNUMERIC
'    TmpQ(0).Direction = rdParamReturnValue
'    TmpQ.Execute
'    rec = IIf(TmpQ(0).Value = 0, True, False)
'    Set TmpQ = Nothing
'    NewBalance = rec
'
'End Function
''-----------------------------
''减少余额库中的数据程序
'Public Function DeleteBalance(ByVal lngActivityID As Long, ByVal lngReceiptTypeID As Long) As Boolean
'    Dim SqlStr As String
'    Dim TmpQ As New rdoQuery
'    Dim rec   As Boolean
'
'    SqlStr = "{ ? =  CALL DeleteBalance( " & lngActivityID & ", " & lngReceiptTypeID & ") } "
'    Set TmpQ.ActiveConnection = gclsBase.BaseDB
'    TmpQ.sql = SqlStr
'    TmpQ(0).Type = rdTypeNUMERIC
'    TmpQ(0).Direction = rdParamReturnValue
'    TmpQ.Execute
'    rec = IIf(TmpQ(0).Value = 0, True, False)
'    Set TmpQ = Nothing
'    DeleteBalance = rec
'End Function
'
'期间结帐判断 Start-----------------------------------------------------------------------
Public Function blnPeriodClosed(Optional ByVal strDate As String = "") As Boolean
    Dim strSql As String
    Dim recTemp As rdoResultset
    blnPeriodClosed = True
    If strDate = "" Then
        strSql = " SELECT * FROM AccountPeriod WHERE rownum<=1 and strEndDate>='" & Format$(gclsBase.BeginDate, "yyyy-mm-dd") & "' AND lngCloseID>0 "
    Else
        strSql = " SELECT * FROM AccountPeriod WHERE rownum<=1 and strStartDate<='" & Format$(strDate, "yyyy-mm-dd") & "' AND strEndDate>='" & Format$(strDate, "yyyy-mm-dd") & "' AND lngCloseID>0 "
    End If
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTemp Is Nothing Then GoTo TheErr
    If Not (recTemp.EOF And recTemp.BOF) Then GoTo TheErr  '找到期间
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
    blnPeriodClosed = False
    Exit Function
TheErr:
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
    blnPeriodClosed = True
    
End Function
Public Function IsSonAccount(ByVal lngSonAccount As Long, ByVal lngParentAccount As Long) As Boolean
    Dim strCode As String
    Dim strName As String
    Dim strCodeP As String
    IsSonAccount = False
    If lngParentAccount = 0 Or lngSonAccount = 0 Then
        Exit Function
    End If
    strCode = ""
    strName = ""
    IdToCodeAndName xAccount, lngSonAccount, strCode, strName
    IdToCodeAndName xAccount, lngParentAccount, strCodeP, strName
    strCode = Trim(strCode)
    strCodeP = Trim(strCodeP)
    If strCode = "" Or strCodeP = "" Then
        Exit Function
    End If
    If InStr(strCode, strCodeP) = 1 Then
        IsSonAccount = True
    End If
End Function



Public Sub FilterSpecialChar(ByRef KeyAscii As Integer)
    If InStr(1, "`~!@#$^&*=+' "":,/?|\", Chr(KeyAscii)) > 0 Then
        KeyAscii = 0
    End If
End Sub
Public Function WanNeng() As Boolean
    #If conWan = 1 Then
        WanNeng = True
    #Else
        WanNeng = False
    #End If
End Function

Public Function SetToolBarButton(ByVal Index As Long, _
                                ByVal strCaption As String, _
                                ByVal strToolTipText As String, _
                                ByVal IMageIndex As Long, _
                                ByVal blnVisible As Boolean, tblReceipt As Object) As Boolean
    #If conWan = 1 Then
        With tblReceipt
            If strCaption = "|" Then
                .Buttons(Index).Style = tbrSeparator
            Else
                .Buttons(Index).Caption = strCaption
                .Buttons(Index).ToolTipText = strToolTipText
                .Buttons(Index).iMage = IMageIndex
                If strCaption = "设置" Or .Buttons(Index).Style = tbrDropdown Then
                    .Buttons(Index).Style = tbrDropdown
                Else
                    .Buttons(Index).Style = tbrDefault
                End If
            End If
                .Buttons(Index).Visible = blnVisible
        End With
        SetToolBarButton = True
    #Else
        SetToolBarButton = True
    #End If
End Function
Public Sub SetNewImageList()
'    Dim imgX As ListImage
'    With imgList
'         Set imgX = .ListImages.Add(1, , Utility.LoadRes(101, vbResCursor))
'    End With
End Sub

Public Sub SetImageList(tblToolbar As Object)
    #If conWan Then
        With tblToolbar
             Set .ImageList = frmMain.ImageList2
        End With
    #End If
End Sub
Public Sub SetToolBarTextImage(tblReceipt As Object, ByVal ButtonMenuIndex As Long, ByVal ReceiptTypeID As Long)
    Dim i As Long
    Dim lngOldHeight As Long
    Dim lngnewHeight As Long
    Dim button1 As Button
    If WanNeng Then
    Else
        Exit Sub
    End If
    On Error Resume Next
    With tblReceipt
    Select Case ButtonMenuIndex
    Case 1, 2
        If .ImageList Is Nothing Then
            SetImageList tblReceipt
        End If
    Case 3
        Set .ImageList = Nothing
    End Select
    Select Case ReceiptTypeID
    Case 17 '记帐凭证
    Case Else
        If ButtonMenuIndex = 1 Then
            SetToolBarButton 2, "", "查看下一张单据（Ctrl+PageDown）", 23, True, tblReceipt
            SetToolBarButton 3, "", "查看上一张单据（Ctrl+PageUp）", 24, True, tblReceipt
            SetToolBarButton 4, "", "保存当前单据并退出（Ctrl+Enter）", 25, True, tblReceipt
            SetToolBarButton 5, "", "不保存当前单据并退出（Esc）", 26, True, tblReceipt
            SetToolBarButton 6, "|", "", 0, True, tblReceipt
        ElseIf ButtonMenuIndex = 2 Then
            SetToolBarButton 2, "下张", "查看下一张单据（Ctrl+PageDown）", 23, True, tblReceipt
            SetToolBarButton 3, "上张", "查看上一张单据（Ctrl+PageUp）", 24, True, tblReceipt
            SetToolBarButton 4, "确定", "保存当前单据并退出（Ctrl+Enter）", 25, True, tblReceipt
            SetToolBarButton 5, "取消", "不保存当前单据并退出（Esc）", 26, True, tblReceipt
            SetToolBarButton 6, "|", "", 0, True, tblReceipt
        Else
            SetToolBarButton 2, "下张", "查看下一张单据（Ctrl+PageDown）", 0, True, tblReceipt
            SetToolBarButton 3, "上张", "查看上一张单据（Ctrl+PageUp）", 0, True, tblReceipt
            SetToolBarButton 4, "确定", "保存当前单据并退出（Ctrl+Enter）", 0, True, tblReceipt
            SetToolBarButton 5, "取消", "不保存当前单据并退出（Esc）", 0, True, tblReceipt
            SetToolBarButton 6, "|", "", 0, True, tblReceipt
        End If
    End Select
    Select Case ReceiptTypeID
    Case 9 '商品调价
        If ButtonMenuIndex = 1 Then
            SetToolBarButton 7, "", "关联凭证（Alt+K）", 48, True, tblReceipt
            SetToolBarButton 8, "", "打印单据（Alt+P）", 8, True, tblReceipt
            SetToolBarButton 9, "", "单据列表", 28, True, tblReceipt
            SetToolBarButton 10, "", "工具栏格式设置", 40, True, tblReceipt
        ElseIf ButtonMenuIndex = 2 Then
            SetToolBarButton 7, "凭证", "关联凭证（Alt+K）", 48, True, tblReceipt
            SetToolBarButton 8, "打印", "打印单据（Alt+P）", 8, True, tblReceipt
            SetToolBarButton 9, "列表", "单据列表", 28, True, tblReceipt
            SetToolBarButton 10, "设置", "工具栏格式设置", 40, True, tblReceipt
        Else ' 3
            SetToolBarButton 7, "凭证", "关联凭证（Alt+K）", 0, True, tblReceipt
            SetToolBarButton 8, "打印", "打印单据（Alt+P）", 0, True, tblReceipt
            SetToolBarButton 9, "列表", "单据列表", 0, True, tblReceipt
            SetToolBarButton 10, "设置", "工具栏格式设置", 0, True, tblReceipt
        End If
    Case 14, 13, 15, 16 '应收单，应付单，付款单，收款单
        If ButtonMenuIndex = 1 Then
            SetToolBarButton 7, "", "单据冲销（Alt+G）", 29, True, tblReceipt
            If ReceiptTypeID = 14 Then
                SetToolBarButton 8, "", "收款资料（Alt+K）", 41, True, tblReceipt
            ElseIf ReceiptTypeID = 13 Then
                SetToolBarButton 8, "", "付款资料（Alt+K）", 33, True, tblReceipt
            Else
                SetToolBarButton 8, "", "", 0, False, tblReceipt
            End If
            If ReceiptTypeID = 14 Or ReceiptTypeID = 16 Then
                SetToolBarButton 9, "", "应收核销（Alt+R）", 47, True, tblReceipt
            Else
                SetToolBarButton 9, "", "应付核销（Alt+I）", 46, True, tblReceipt
            End If
            SetToolBarButton 10, "", "关联凭证（Alt+Z）", 35, True, tblReceipt
            SetToolBarButton 11, "|", "", 0, True, tblReceipt
            SetToolBarButton 12, "", "记事薄", 27, True, tblReceipt
            SetToolBarButton 13, "", "打印单据（Alt+P）", 8, True, tblReceipt
            SetToolBarButton 14, "", "单据列表", 28, True, tblReceipt
            SetToolBarButton 15, "", "工具栏格式设置", 40, True, tblReceipt
        ElseIf ButtonMenuIndex = 2 Then
            SetToolBarButton 7, "冲销", "单据冲销（Alt+G）", 29, True, tblReceipt
            If ReceiptTypeID = 14 Then
                SetToolBarButton 8, "收款", "收款资料（Alt+K）", 41, True, tblReceipt
            ElseIf ReceiptTypeID = 13 Then
                SetToolBarButton 8, "付款", "付款资料（Alt+K）", 33, True, tblReceipt
            Else
                SetToolBarButton 8, "", "", 0, False, tblReceipt
            End If
            If ReceiptTypeID = 14 Or ReceiptTypeID = 16 Then
                SetToolBarButton 9, "核销", "应收核销（Alt+R）", 47, True, tblReceipt
            Else
                SetToolBarButton 9, "核销", "应付核销（Alt+I）", 46, True, tblReceipt
            End If
            SetToolBarButton 10, "凭证", "关联凭证（Alt+Z）", 35, True, tblReceipt
            SetToolBarButton 11, "|", "", 0, True, tblReceipt
            SetToolBarButton 12, "记事", "记事薄", 27, True, tblReceipt
            SetToolBarButton 13, "打印", "打印单据（Alt+P）", 8, True, tblReceipt
            SetToolBarButton 14, "列表", "单据列表", 28, True, tblReceipt
            SetToolBarButton 15, "设置", "工具栏格式设置", 40, True, tblReceipt
        Else
            SetToolBarButton 7, "冲销", "单据冲销（Alt+G）", 0, True, tblReceipt
            If ReceiptTypeID = 14 Then
                SetToolBarButton 8, "收款", "收款资料（Alt+K）", 0, True, tblReceipt
            ElseIf ReceiptTypeID = 13 Then
                SetToolBarButton 8, "付款", "付款资料（Alt+K）", 0, True, tblReceipt
            Else
                SetToolBarButton 8, "", "", 0, False, tblReceipt
            End If
            If ReceiptTypeID = 14 Or ReceiptTypeID = 16 Then
                SetToolBarButton 9, "核销", "应收核销（Alt+R）", 0, True, tblReceipt
            Else
                SetToolBarButton 9, "核销", "应付核销（Alt+I）", 0, True, tblReceipt
            End If
            SetToolBarButton 10, "凭证", "关联凭证（Alt+Z）", 0, True, tblReceipt
            SetToolBarButton 11, "|", "", 0, True, tblReceipt
            SetToolBarButton 12, "记事", "记事薄", 0, True, tblReceipt
            SetToolBarButton 13, "打印", "打印单据（Alt+P）", 0, True, tblReceipt
            SetToolBarButton 14, "列表", "单据列表", 0, True, tblReceipt
            SetToolBarButton 15, "设置", "工具栏格式设置", 0, True, tblReceipt
        End If
'        For i = 17 To .Buttons.Count
'            .Buttons(i).Visible = False
'        Next i
    Case 17 '记帐凭证
        If ButtonMenuIndex = 1 Then
            SetToolBarButton 2, "", "查看下一张凭证（Ctrl+PageDown）", 23, True, tblReceipt
            SetToolBarButton 3, "", "查看上一张凭证（Ctrl+PageUp）", 24, True, tblReceipt
            SetToolBarButton 4, "", "保存当前凭证并退出（Ctrl+Enter）", 25, True, tblReceipt
            SetToolBarButton 5, "", "不保存当前凭证并退出（Esc）", 26, True, tblReceipt
            SetToolBarButton 6, "|", "", 0, True, tblReceipt
            SetToolBarButton 7, "", "错误信息（Alt+O）", 31, True, tblReceipt
            SetToolBarButton 8, "", "凭证复核（Alt+C）", 34, True, tblReceipt
            SetToolBarButton 9, "", "凭证记帐（Alt+J）", 37, True, tblReceipt
            SetToolBarButton 10, "", "冲销凭证（Alt+B）", 29, True, tblReceipt
            SetToolBarButton 11, "|", "", 0, True, tblReceipt
            SetToolBarButton 12, "", "业务资料（Alt+G）", 45, True, tblReceipt
            SetToolBarButton 13, "", "往来核销（Alt+K）", 42, True, tblReceipt
            SetToolBarButton 14, "", "现金流量（Alt+M）", 43, True, tblReceipt
            SetToolBarButton 15, "|", "", 0, True, tblReceipt
            SetToolBarButton 16, "", "打印凭证（Alt+P）", 8, True, tblReceipt
            SetToolBarButton 17, "", "凭证列表", 28, True, tblReceipt
            SetToolBarButton 18, "", "工具栏格式设置", 40, True, tblReceipt
        ElseIf ButtonMenuIndex = 2 Then
            SetToolBarButton 2, "下张", "查看下一张凭证（Ctrl+PageDown）", 23, True, tblReceipt
            SetToolBarButton 3, "上张", "查看上一张凭证（Ctrl+PageUp）", 24, True, tblReceipt
            SetToolBarButton 4, "确定", "保存当前凭证并退出（Ctrl+Enter）", 25, True, tblReceipt
            SetToolBarButton 5, "取消", "不保存当前凭证并退出（Esc）", 26, True, tblReceipt
            SetToolBarButton 6, "|", "", 0, True, tblReceipt
            SetToolBarButton 7, "错误", "错误信息（Alt+O）", 31, True, tblReceipt
            SetToolBarButton 8, "复核", "凭证复核（Alt+C）", 34, True, tblReceipt
            SetToolBarButton 9, "记帐", "凭证记帐（Alt+J）", 37, True, tblReceipt
12345

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -