Attribute VB_Name = "XtjbModule"
'系統基本模塊(主要用來放置公用函數及模塊)
                
'系統信息
Public XtMenuList As String    '系統菜單功能編碼

'系統日期
Public Xtkjqjgs As Integer     '用戶設定會計期間個數
Public Xtyear As Integer       '用戶進入系統選擇年度
Public Xtmm As Integer         '用戶進入系統選擇會計期間
Public Xtrq As Date            '系統日期
Public Xtrlbz As String        '系統日歷標志

'系統往返參數值
Public Xtcdcs As String        '系統傳遞參數值(專門用來傳遞幫助信息)
Public Xtcdcsfz As String      '系統傳遞參數值(輔助信息)
Public Xtfhcs As String        '系統返回參數值(專門用來傳遞幫助信息)
Public Xtfhcsfz As String      '系統返回參數值(輔助信息)

'系統通用編碼參照代碼
Public Xtbmczdm As String      '系統通用編碼參照代碼

'(系統等待調用窗體)
Public XtCxgnsm As String      '調用程序功能說明

Public Xtczy As String         '系統使用操作員
Public Xtczybm As String       '系統操作員編碼
Public Xtztbm As String        '系統帳套編碼
Public Xtdwm As String         '系統打開帳套單位

'帳套基本參數
Public Xtjezws As Integer      '金額總位數
Public Xtslzws As Integer      '數量總位數
Public Xtdjzws As Integer      '單價總位數
Public Xtjexsws As Integer     '金額小數位數
Public Xtslxsws As Integer     '數量小數位數
Public Xtdjxsws As Integer     '單價小數位數
Public XtSCurrCode As String   '本位幣編碼
Public XtSCurrName As String   '本位幣名稱

'其它全局變量
Public Unload_TF As Boolean    '窗體是否卸載
Public P_RecordCount As Integer '記錄條數
Public YesNo_str As String
Public SsqlHelp As String
Public P_Code As String: Public P_Name As String  '編碼、名稱
Public AddExit_TF As Boolean '添加或編輯狀態

Public P_Ssql As String  'Sql 語句

'引用API函數
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
'變量聲明begin 2002-10-21 add 4 new Operate & Access Right
Public ServerName As String
Public Xt_RoleCode As String
Public gBillId As String
Private LocalIP As String
Public Const Ebo_gsProductName = "Ebodiy2008"       '統一使用，不可修改
Public Const Ebo_gsPrjName = "Gen13301481112"        '工程項目名稱，根據項目和版本號修改
Public str_right(7) As String
'1單據索引、2單據名稱、3功能索引、4角色代碼、5單據號、6單據id號、7提示信息
Public str_billsql As String     '顯示單據的字符串,用于判斷對當前單據有權限的角色
'變量聲明end 2002-10-21
'Public Const hx_RecCount = 1000      '查詢結果顯示記錄條數
Public hx_RecCount As Long  '查詢結果顯示記錄條數

'圖標
Public Enum enumIcon
   ebodiyError = 1        '錯誤
   ebodiyQuery = 2        '詢問
   ebodiyWarning = 3      '警告
   ebodiyInfomation = 4   '信息
End Enum

'信息框類型
Public Enum enumMsgType
   ebodiyOKOnly = 0       '確定
   ebodiyOkCancel = 2     '確定/取消
   ebodiyYesNo = 1        'Yes/No
End Enum


Public Enum SortOfForms
      ebodiyBasicForm = 0
      ebodiyBillForm = 1
End Enum

Public Function Strcdcs(Lrcsstr As String, Lrzdcd As Integer) As Integer                            '測量并限制字符串長度(漢字與字符區分)
   
    '參數說明:Lrcsstr 需要測量和限制輸出的字符串 Lrzdcd 限制輸出長度
  
    lrtextlong = Len(Trim(Lrcsstr))
    lrcscd = 0
    For jsqte = 1 To lrtextlong
        lrcszf = Mid(Lrcsstr, jsqte, 1)
        lrzzcd = lrcscd
        If Asc(lrcszf) >= 0 And Asc(lrcszf) <= 255 Then
            lrcscd = lrcscd + 1
        Else
            lrcscd = lrcscd + 2
        End If
        If lrcscd > Lrzdcd Then
            lrstrjqcd = jsqte - 1
            Lrcsstr = Mid(Lrcsstr, 1, lrstrjqcd)
            Strcdcs = lrzzcd
            Exit Function
        Else
            Strcdcs = lrcscd
        End If
    Next jsqte

End Function

'======================以下為文本錄入內容格式輸入控制過程函數======================='
Public Sub Lrfzszxz(Sjwb As TextBox, lrzfasc As Integer)              '文本框錄入整數值(負)限制
   
    '輸入參數：sjwb 錄入限制文本框 lrzfasc 用戶錄入字符Ascii碼值
    If Not ((lrzfasc >= Asc("0") And lrzfasc <= Asc("9")) Or lrzfasc = vbKeyBack Or (Chr(lrzfasc) = "-" And Sjwb.SelStart = 0)) Then
        lrzfasc = 0
    End If

End Sub

Public Sub Lrzszxz(lrzfasc As Integer)                                '文本框錄入整數值(正)限制
    '輸入參數：lrzfasc 用戶錄入字符Ascii碼值
    If Not ((lrzfasc >= Asc("0") And lrzfasc <= Asc("9")) Or lrzfasc = vbKeyBack) Then
        lrzfasc = 0
    End If

End Sub

Public Sub Lrszzfxz(lrzfasc As Integer)                               '文本框錄入數字及字符限制
    
    '輸入參數：lrzfasc 用戶錄入字符Ascii碼值
    If Not ((lrzfasc >= Asc("0") And lrzfasc <= Asc("9")) Or (lrzfasc >= Asc("a") And lrzfasc <= Asc("z")) Or (lrzfasc >= Asc("A") And lrzfasc <= Asc("Z")) Or lrzfasc = vbKeyBack) Then
        lrzfasc = 0
    End If

End Sub

Public Sub Lrfhzxz(lrzfasc As Integer)                                '文本框錄入非漢字限制
    
    '輸入參數：lrzfasc 用戶錄入字符Ascii碼值
    If Not ((lrzfasc >= 0 And lrzfasc <= 255) Or lrzfasc = vbKeyBack) Then
        lrzfasc = 0
    End If

End Sub

Public Sub Lrrqxz(lrzfasc As Integer)                                 '文本框錄入日期限制
    
    '輸入參數：lrzfasc 用戶錄入字符Ascii碼值
    If Not ((lrzfasc >= Asc("0") And lrzfasc <= Asc("9")) Or Chr(lrzfasc) = "-" Or lrzfasc = vbKeyBack) Then
        lrzfasc = 0
    End If
    
End Sub

Public Sub Lrxszxz(Sjwb As TextBox, lrzfasc As Integer)               '文本框錄入帶有小數位及正負號數值字段
  
    If Not ((Chr(lrzfasc) >= "0" And Chr(lrzfasc) <= "9") Or (Chr(lrzfasc) = "." And InStr(1, Sjwb.Text, ".") = 0) Or lrzfasc = vbKeyBack Or (Chr(lrzfasc) = "-" And Sjwb.SelStart = 0)) Then
        lrzfasc = 0
    End If

End Sub

Public Sub Lrxzszxz(Sjwb As TextBox, lrzfasc As Integer)              '文本框錄入帶有小數位正>=0數值字段
    
    If Not ((Chr(lrzfasc) >= "0" And Chr(lrzfasc) <= "9") Or (Chr(lrzfasc) = "." And InStr(1, Sjwb.Text, ".") = 0) Or lrzfasc = vbKeyBack) Then
        lrzfasc = 0
    End If

End Sub

'5.04
'Public Sub Sjgskz(Sjwb As TextBox, zsws As Integer, xsws As Integer)  '保證數值錄入字段錄入格式
'
'    '輸入參數:sjwb 錄入限制文本框 zsws 數值錄入限制整數位數 xsws 數值錄入限制小數位數
'
'    Dim xsdwz%, bccrd%
'    xsdwz = InStr(1, Sjwb.Text, ".")
'    bccrd = Sjwb.SelStart
'    If xsdwz = 0 Then
'        Sjwb.Text = Mid(Sjwb.Text, 1, zsws)
'        Sjwb.SelStart = bccrd
'        Exit Sub
'    End If
'    If zsws > xsdwz - 1 Then
'        Zswstr = Mid(Sjwb, 1, xsdwz - 1)
'    Else
'        Zswstr = Mid(Sjwb, 1, zsws)
'    End If
'    Xswstr = Mid(Sjwb, xsdwz + 1, xsws)
'    Sjwb = Zswstr + "." + Xswstr
'    Sjwb.SelStart = bccrd
'
'End Sub

Public Sub Sjgskz(Sjwb As TextBox, zsws As Integer, xsws As Integer)  '保證數值錄入字段錄入格式

    '輸入參數:sjwb 錄入限制文本框 zsws 數值錄入限制整數位數 xsws 數值錄入限制小數位數
   
   Dim bccrd%
   Dim Ws, Zswstr, Xswstr As String
   Dim B_fu As Boolean
   Dim sjzws As Integer

   bccrd = Sjwb.SelStart
   B_fu = False
   
    Ws = InStr(1, Sjwb, "-")
    If Ws > 0 Then Sjwb = Mid(Sjwb, Ws)

   If Left(Sjwb, 1) = "-" Then
      B_fu = True
      zsws = zsws - 1
      Zswstr = Mid(Sjwb, 2)
   Else
      Zswstr = Mid(Sjwb, 1)
   End If
   
   Ws = InStr(1, Zswstr, ".")                   '整數位數+1
   
    If Ws > 0 Then
        If zsws > Ws - 1 Then
            Zswstr = Mid(Zswstr, 1, Ws - 1) + Mid(Zswstr, Ws, xsws + 1)
        Else
            Zswstr = Mid(Zswstr, 1, zsws) + Mid(Zswstr, Ws, xsws + 1)
            Ws = InStr(1, Zswstr, ".")                   '整數位數+1
        End If
        Ws = Len(Zswstr) - Ws                   '小數位數
        If Left(Zswstr, 1) = "." Then
            bccrd = bccrd + 1
            Zswstr = "0" & Zswstr
        End If
        If Ws < xsws Then
           Zswstr = Format(Zswstr, "#0." + String(Ws, "0"))
        Else
           Zswstr = Format(Zswstr, "#0." + String(xsws, "0"))
        End If
   Else
      Zswstr = Mid(Zswstr, 1, zsws)
      Zswstr = Format(Zswstr)
   End If
   
   If B_fu Then
       Zswstr = "-" & Zswstr
       zsws = zsws + 1
   End If

   Sjwb = Zswstr
   Sjwb.SelStart = bccrd

End Sub

Public Sub InputFieldLimit(Ydtextte As TextBox, Zdsjlxte As Integer, KeyAsciite As Integer)     '錄入字段事中控制程序

    '函數參數:錄入限制文本框,字段數據類型,錄入字符
    Select Case Zdsjlxte
        Case 1                                  '1-錄入(Ascii0-255)
            Call Lrfhzxz(KeyAsciite)
        Case 2
            Call Lrszzfxz(KeyAsciite)             '2-錄入(0-9,a-z,A-Z)
        Case 3
            Call Lrfzszxz(Ydtextte, KeyAsciite)   '3-錄入整數值(正負)
        Case 4
            Call Lrzszxz(KeyAsciite)              '4-錄入整數值(正)
        Case 5, 8, 9
            Call Lrxszxz(Ydtextte, KeyAsciite)    '5-錄入小數值(正負) 8-金額型(正負) 9-數量型（正負）
        Case 6, 10, 11, 12
            Call Lrxzszxz(Ydtextte, KeyAsciite)   '6-錄入小數值(正) 10-單價型 11-金額型(正) 12-數量型（正）
        Case 7
            Call Lrrqxz(KeyAsciite)               '7-錄入日期
    End Select

End Sub
Public Sub TextChangeLimit(Ydtextte As TextBox, Zdsjlxte As Integer)      '文本框字段錄入控制(事后、防止用戶采用粘貼錄入)
    '函數參數:錄入限制文本框,字段數據類型
    
    Dim Str_JudgeStr As String      '判斷字符
    Dim jsqte As Integer           '臨時使用計數器
    Dim Str_Result As String        '結果字符串
    Dim KeyAsciite As Integer
    
    Str_Result = ""
    
    For jsqte = 1 To Len(Trim(Ydtextte.Text))
        Str_JudgeStr = Mid(Trim(Ydtextte.Text), jsqte, 1)
        KeyAsciite = Asc(Str_JudgeStr)
    
        If Str_JudgeStr = "'" Then
           Str_JudgeStr = ""
        End If
        
        Select Case Zdsjlxte
            Case 1                                           '1-錄入(Ascii0-255)
                Call Lrfhzxz(KeyAsciite)
                If KeyAsciite = 0 Then
                   Str_JudgeStr = ""
                End If
            Case 2
                Call Lrszzfxz(KeyAsciite)                    '2-錄入(0-9,a-z,A-Z)
                If KeyAsciite = 0 Then
                   Str_JudgeStr = ""
                End If
            Case 4, 6, 10, 11, 12
                If Str_JudgeStr = "-" Then                   '錄入數值(正)
                   Str_JudgeStr = ""
                End If
                
        End Select
        Str_Result = Str_Result + Str_JudgeStr
     Next jsqte
     
     If Str_Result <> Trim(Ydtextte.Text) Then
        Ydtextte.Text = Str_Result
        Ydtextte.SelStart = Len(Ydtextte.Text)
     End If
     '2003-12-08 by lg
     If Zdsjlxte = 4 Or Zdsjlxte = 6 Or Zdsjlxte = 10 Or Zdsjlxte = 11 Or Zdsjlxte = 12 Then
        If Not IsNumeric(Ydtextte) Then Ydtextte.Text = ""
     End If
     'end
End Sub

Public Function Kjjdzy(Zyjdzs As Integer) As Boolean                                    '控件焦點轉移(針對回車鍵)
    Kjjdzy = False
    On Error Resume Next
    If Screen.ActiveControl.TabIndex <= Zyjdzs - 1 Then
        Kjjdzy = True
        SendKeys "{tab}"
    End If
End Function

Public Sub Pbwxzf(Zfc As Integer)                                                       '錄入時屏蔽"'"
    If Chr(Zfc) = "'" Then
        Zfc = 0
    End If
End Sub

Public Sub F1bz()                                                                           '發送F1鍵
    SendKeys "{F1}"
End Sub

Public Sub Textyx(Textte As TextBox)                                                        '文本框有效
    
    Textte.Enabled = True
    Textte.BackColor = &H80000005

End Sub

Public Sub Textwx(Textte As TextBox)                                                        '文本框無效
   
    Textte.Enabled = False
    Textte.BackColor = &HC0C0C0

End Sub

'//* 功能: 金額小寫轉換為大寫  調用參數:jesj...人民幣小寫金額
'//* 返回變量: name..人民幣大寫金額
Public Function Fun_Jezh(Jesj As Double) As String
    
    Dim Name1$, Name2$, Mje1$, Name$
    Dim len_mje1%, k%, Ws%, j%, ws1%, m%
    Dim Bz As Boolean
    Name1 = "壹貳叁肆伍陸柒捌玖"
    Name2 = "分角元拾佰仟萬拾佰仟億拾佰仟"
    Mje1 = Trim(Format(Jesj, "###.00"))
    len_mje1 = Len(Mje1)
    If len_mje1 > 16 Or Jesj < 0.01 Or IsNull(Jesj) Then
        Fun_Jezh = ""
        Exit Function
    End If
    '//取無小數的字符串
    Mje1 = Left(Mje1, len_mje1 - 3) + Right(Mje1, 2)
    len_mje1 = len_mje1 - 1
    k = len_mje1 * 2 - 1
    Ws = Int(Mid(Mje1, 1, 1)) * 2 - 1

    If len_mje1 = 3 And Ws < 0 Then     '//如果金額<1 name=''
        Name = ""
    Else
        If Ws > 0 Then
            Name = MidB(Name1, Ws, 2) + MidB(Name2, k, 2) '//如果金額>=1,轉換金額
        End If
    End If
    j = 2
    k = k - 2
    Bz = True
xh1:
    Do While j <= len_mje1 And Bz