系统_基本函数模块.bas

适合于中小型企业管理

            End If
            If Asc(t1) >= Asc("昔") And Asc(t1) < Asc("压") Then
                GetPY = GetPY + "X"
                GoTo L1
            End If
            If Asc(t1) >= Asc("压") And Asc(t1) < Asc("匝") Then
                GetPY = GetPY + "Y"
                GoTo L1
            End If
            If Asc(t1) >= Asc("匝") Then
                GetPY = GetPY + "Z"
                GoTo L1
            End If
        Else
            If UCase(t1) <= "Z" And UCase(t1) >= "A" Then
                GetPY = GetPY + UCase(t1)
            Else
                GetPY = t1
            End If
        End If
L1:
    Next Jsqte
    
End Function

'<<<<<<<<<<<<<<<<<<<<<
Public Function Item_Info()  '项目查询连接
    
    Dim aDo_Item As New Recordset
    Dim sSql As String
    Set aDo_Item = Cw_DataEnvi.DataConnect.Execute("select * from DEV_item")
    
    With aDo_Item
        Do While Not .EOF
            If !yncode = 1 And Trim(aDo_Item!TableName) = "CorrelationList" Then
                If !YNRoot = 1 Then
                    sSql = sSql & ",N_" & !ItemFieldName & "=(select ListName from DEV_CorrelationList c where convert(varchar(18),c.ListCode)=b." & !ItemFieldName & ")"
                Else
                    sSql = sSql & ",N_" & !ItemFieldName & "=(select ListName from DEV_CorrelationList c where convert(varchar(18),c.ListCode)=a." & !ItemFieldName & ")"
                End If
                '-----------------
            Else
                If !yncode = 1 Then
                    If !YNRoot = 1 Then
                        sSql = sSql & ",N_" & !ItemFieldName & "=(select " & aDo_Item!CloumnName2 & " from " & aDo_Item!TableName & " c where c." & aDo_Item!CloumnName1 & "=b." & !ItemFieldName & ")"
                    Else
                        sSql = sSql & ",N_" & !ItemFieldName & "=(select " & aDo_Item!CloumnName2 & " from " & aDo_Item!TableName & " c where c." & aDo_Item!CloumnName1 & "=a." & !ItemFieldName & ")"
                    End If
                End If
            End If
            .MoveNext
        Loop
        sSql = "select b.dcode,b.tcode,b.lcode,b.dname,b.manage,b.dxh,b.mader,b.zflag,b.mlevel,b.pdate,b.state,b.dno,b.conno,a.*,N_Lcode=(select isname from DEV_ItemSort c where convert(varchar(18),c.isid)=b.lcode)" & sSql & " FROM DEV_RootInfo a,DEV_main b"
    End With
    Item_Info = sSql
    
End Function

'====================单据编号格式化==============
Public Function BillCodeFormat(BillCode As String, Code As String) As String
    BillCode = Trim(BillCode): Code = Trim(Code)
    Dim Profix  As String       '前缀
    Dim Glida As Integer        '流水方式
    Dim CodeLen As Integer      '代码长度
    Dim aDo_re As New Recordset
    Set aDo_re = Cw_DataEnvi.DataConnect.Execute("select * from Gy_BillNumber where BillCode='" & Trim(BillCode) & "'")
    If aDo_re.RecordCount > 0 Then
        Profix = aDo_re!Profix
        Glida = aDo_re!Glida
        CodeLen = aDo_re!CodeLen
    Else
        BillCodeFormat = "": Exit Function
    End If
    aDo_re.Close
    If Len(Code) >= Len(Profix) + CodeLen Then BillCodeFormat = Code: Exit Function
    If Glida = 0 Then
        If Len(Code) >= Len(Profix) Then
            If Profix <> Mid(Code, 1, Len(Profix)) Then
                BillCodeFormat = Profix & String(CodeLen - Len(Code), "0") & Code
            Else
                If Len(Code) = Len(Profix) Then BillCodeFormat = Code: Exit Function
                BillCodeFormat = Profix & String(CodeLen - Len(Code), "0") & Mid(Code, Len(Profix) + 1, Len(Code))
            End If
        Else
            BillCodeFormat = Profix & String(CodeLen - Len(Code), "0") & Code: Exit Function
        End If
    Else
        If Len(Code) >= Len(Profix) Then
            If Profix <> Mid(Code, 1, Len(Profix)) Then
                BillCodeFormat = Profix & Code
            Else
                BillCodeFormat = Code
            End If
        End If
    End If
    
    
End Function

'====================单据ID处理==================
Public Function CreatBillID(BillCode As String) As Integer
    '参数说明： BillCode 单据编码
    Dim BillType As String
    Dim aDo_re As New Recordset
    Set aDo_re = Cw_DataEnvi.DataConnect.Execute("select * from Gy_BillNumber where BillCode='" & Trim(BillCode) & "'")
    If aDo_re.RecordCount > 0 Then
        CreatBillID = aDo_re!IDNow
        BillType = aDo_re!BillType
    End If
    aDo_re.Close
    Cw_DataEnvi.DataConnect.Execute "update  Gy_BillNumber set IDNow=IDNow+1 where BillType='" & Trim(BillType) & "'"
End Function

'====================单据编码处理==================
Public Function CreatBillCode(BillCode As String, Optional Add As Boolean = False, Optional KjYear As Integer, Optional Period As Integer, Optional WhCode As String) As String
    
    '参数说明： BillCode 单据编码，KjYear 会计年度，Period 会计期间，WhCode 仓库编码,Add 编号是累加(True 加，False,否)
    Dim BillCodeMode As Integer '编码方式
    Dim Profix  As String       '前缀
    Dim Glida As Integer        '流水方式
    Dim CodeLen As Integer      '代码长度
    Dim aDo_re As New Recordset
    Set aDo_re = Cw_DataEnvi.DataConnect.Execute("select * from Gy_BillNumber where BillCode='" & Trim(BillCode) & "'")
    With aDo_re
        If .RecordCount > 0 Then
            BillCodeMode = !BillCodeMode
            Profix = !Profix
            Glida = !Glida
            CodeLen = !CodeLen
            .Close
        Else
            Exit Function
        End If
    End With
    
    Select Case BillCodeMode
    Case 0 '单据方式
        '=============
        Select Case Glida
        Case 0
            Set aDo_re = Cw_DataEnvi.DataConnect.Execute("select * from Gy_Maxnum where BillCode='" & Trim(BillCode) & "'")
            If aDo_re.RecordCount < 1 Then '当编号记录没有时
                Cw_DataEnvi.DataConnect.Execute "insert into Gy_Maxnum(BillCode,NowNumber) VALUES ('" & Trim(BillCode) & "',1)"
                CreatBillCode = Trim(Profix) & String(CodeLen - 1, "0") & 1
            Else
                CreatBillCode = Trim(Profix) & String(CodeLen - Len(aDo_re!NowNumBer), "0") & aDo_re!NowNumBer
            End If
            If Add = True Then
                Cw_DataEnvi.DataConnect.Execute "update Gy_Maxnum set NowNumBer=NowNumBer+1  where BillCode='" & Trim(BillCode) & "'"
            End If
            Exit Function
        Case 1
            Set aDo_re = Cw_DataEnvi.DataConnect.Execute("select * from Gy_Maxnum where BillCode='" & Trim(BillCode) & "' and KjYear= " & KjYear)
            If aDo_re.RecordCount < 1 Then '当前年记录没有时
                Cw_DataEnvi.DataConnect.Execute "insert into Gy_Maxnum(BillCode,Kjyear,NowNumber) VALUES ('" & Trim(BillCode) & "'," & KjYear & ",1)"
                CreatBillCode = Trim(Profix) & KjYear & String(CodeLen - 1 - Len(Trim(Str(KjYear))), "0") & "1"
            Else
                CreatBillCode = Trim(Profix) & KjYear & String(CodeLen - Len(aDo_re!NowNumBer) - Len(Trim(Str(KjYear))), "0") & aDo_re!NowNumBer
            End If
            If Add = True Then
                Cw_DataEnvi.DataConnect.Execute "update Gy_Maxnum set NowNumBer=NowNumBer+1 where BillCode='" & Trim(BillCode) & "' and KjYear= " & KjYear
            End If
            Exit Function
        Case 2
            Set aDo_re = Cw_DataEnvi.DataConnect.Execute("select * from Gy_Maxnum where BillCode='" & Trim(BillCode) & "' and KjYear= " & KjYear & " and Period=" & Period)
            If aDo_re.RecordCount < 1 Then '当前年当前期间记录没有时
                Cw_DataEnvi.DataConnect.Execute "insert into Gy_Maxnum(BillCode,Kjyear,Period,NowNumber) VALUES ('" & Trim(BillCode) & "'," & KjYear & "," & Period & ",1)"
                CreatBillCode = Trim(Profix) & KjYear & String(2 - Len(Trim(Str(Period))), "0") & Period & String(CodeLen - 1 - Len(Trim(Str(KjYear))) - 2, "0") & "1"
            Else
                CreatBillCode = Trim(Profix) & KjYear & String(2 - Len(Trim(Str(Period))), "0") & Period & String(CodeLen - Len(aDo_re!NowNumBer) - Len(Trim(Str(KjYear))) - 2, "0") & aDo_re!NowNumBer
            End If
            If Add = True Then
                Cw_DataEnvi.DataConnect.Execute "update Gy_Maxnum set NowNumBer=NowNumBer+1 where BillCode='" & Trim(BillCode) & "' and KjYear= " & KjYear & " and Period=" & Period
            End If
            Exit Function
        End Select
        '==============
    Case 1 '单据+仓库方式
        
        '=============
        Select Case Glida
        Case 0
            Set aDo_re = Cw_DataEnvi.DataConnect.Execute("select * from Gy_Maxnum where BillCode='" & Trim(BillCode) & "' and WhCode='" & Trim(WhCode) & "'")
            If aDo_re.RecordCount < 1 Then '当编号记录没有时
                Cw_DataEnvi.DataConnect.Execute "insert into Gy_Maxnum(BillCode,WhCode ,NowNumber) VALUES ('" & Trim(BillCode) & "','" & Trim(WhCode) & "',1)"
                CreatBillCode = Trim(Profix) & Trim(WhCode) & String(CodeLen - 1 - Len(Trim(WhCode)), "0") & 1
            Else
                CreatBillCode = Trim(Profix) & Trim(WhCode) & String(CodeLen - Len(aDo_re!NowNumBer) - Len(Trim(WhCode)), "0") & aDo_re!NowNumBer
            End If
            If Add = True Then
                Cw_DataEnvi.DataConnect.Execute "update Gy_Maxnum set NowNumBer=NowNumBer+1 where BillCode='" & Trim(BillCode) & "' and WhCode='" & Trim(WhCode) & "'"
            End If
            Exit Function
        Case 1
            Set aDo_re = Cw_DataEnvi.DataConnect.Execute("select * from Gy_Maxnum where BillCode='" & Trim(BillCode) & "' and KjYear= " & KjYear & " and WhCode='" & Trim(WhCode) & "'")
            If aDo_re.RecordCount < 1 Then '当前年记录没有时
                Cw_DataEnvi.DataConnect.Execute "insert into Gy_Maxnum(BillCode,Kjyear,WhCode,NowNumber) VALUES ('" & Trim(BillCode) & "'," & KjYear & ",'" & Trim(WhCode) & "',1)"
                CreatBillCode = Trim(Profix) & Trim(WhCode) & KjYear & String(CodeLen - 1 - Len(Trim(Str(KjYear))) - Len(Trim(WhCode)), "0") & "1"
            Else
                CreatBillCode = Trim(Profix) & Trim(WhCode) & KjYear & String(CodeLen - Len(aDo_re!NowNumBer) - Len(Trim(Str(KjYear))) - Len(Trim(WhCode)), "0") & aDo_re!NowNumBer
            End If
            If Add = True Then
                Cw_DataEnvi.DataConnect.Execute "update Gy_Maxnum set NowNumBer=NowNumBer+1 where BillCode='" & Trim(BillCode) & "' and KjYear= " & KjYear & " and WhCode='" & Trim(WhCode) & "'"
            End If
            Exit Function
        Case 2
            Set aDo_re = Cw_DataEnvi.DataConnect.Execute("select * from Gy_Maxnum where BillCode='" & Trim(BillCode) & "' and KjYear= " & KjYear & " and Period=" & Period & " and WhCode='" & Trim(WhCode) & "'")
            If aDo_re.RecordCount < 1 Then '当前年当前期间记录没有时
                Cw_DataEnvi.DataConnect.Execute "insert into Gy_Maxnum(BillCode,Kjyear,Period,WhCode,NowNumber) VALUES ('" & Trim(BillCode) & "'," & KjYear & "," & Period & ",'" & Trim(WhCode) & "',1)"
                CreatBillCode = Trim(Profix) & Trim(WhCode) & KjYear & String(2 - Len(Trim(Str(Period))), "0") & Period & String(CodeLen - 1 - Len(Trim(Str(KjYear))) - 2 - Len(Trim(WhCode)), "0") & "1"
            Else
                CreatBillCode = Trim(Profix) & Trim(WhCode) & KjYear & String(2 - Len(Trim(Str(Period))), "0") & Period & String(CodeLen - Len(aDo_re!NowNumBer) - Len(Trim(Str(KjYear))) - 2 - Len(Trim(WhCode)), "0") & aDo_re!NowNumBer
            End If
            If Add = True Then
                Cw_DataEnvi.DataConnect.Execute "update Gy_Maxnum set NowNumBer=NowNumBer+1 where BillCode='" & Trim(BillCode) & "' and KjYear= " & KjYear & " and Period=" & Period & " and WhCode='" & Trim(WhCode) & "'"
            End If
            Exit Function
        End Select
        '==============
        
    End Select
End Function

Public Sub SetTxtBackcolor(txtObj As Object, Optional WhereUse As SortOfForms = EboBasicForm)
    '设置文本框颜色函数
    
    Dim i As Integer
    
    On Error Resume Next
    
    Select Case WhereUse
        Case EboBasicForm  '用于基础数据窗体
            For i = 0 To txtObj.UBound
                If txtObj(i).Enabled = False Or txtObj(i).Locked = True Then
                     txtObj(i).BackColor = &H80000004
                Else
                     txtObj(i).BackColor = &H80000005
                End If
            Next i
        Case EboBillForm     '用于单据窗体
            For i = 0 To txtObj.UBound
                If txtObj(i).Enabled = False Or txtObj(i).Locked = True Then
                     txtObj(i).BackColor = &HF2FAEB
                Else
                     txtObj(i).BackColor = &H80000005
                End If
            Next i
        Case Else                   '用于其它窗体
            For i = 0 To txtObj.UBound
                If txtObj(i).Enabled = False Or txtObj(i).Locked = True Then
                     txtObj(i).BackColor = &H80000005
                Else
                     txtObj(i).BackColor = &H80000005
                End If
            Next i
        End Select
End Sub