?? 系統(tǒng)_基本函數(shù)模塊.bas
字號:
Attribute VB_Name = "XtjbModule"
'系統(tǒng)基本模塊(主要用來放置公用函數(shù)及模塊)
'系統(tǒng)信息
Public XtMenuList As String '系統(tǒng)菜單功能編碼
'系統(tǒng)日期
Public Xtkjqjgs As Integer '用戶設(shè)定會計期間個數(shù)
Public Xtyear As Integer '用戶進入系統(tǒng)選擇年度
Public Xtmm As Integer '用戶進入系統(tǒng)選擇會計期間
Public Xtrq As Date '系統(tǒng)日期
Public Xtrlbz As String '系統(tǒng)日歷標志
'系統(tǒng)往返參數(shù)值
Public Xtcdcs As String '系統(tǒng)傳遞參數(shù)值(專門用來傳遞幫助信息)
Public Xtcdcsfz As String '系統(tǒng)傳遞參數(shù)值(輔助信息)
Public Xtfhcs As String '系統(tǒng)返回參數(shù)值(專門用來傳遞幫助信息)
Public Xtfhcsfz As String '系統(tǒng)返回參數(shù)值(輔助信息)
'系統(tǒng)通用編碼參照代碼
Public Xtbmczdm As String '系統(tǒng)通用編碼參照代碼
'(系統(tǒng)等待調(diào)用窗體)
Public XtCxgnsm As String '調(diào)用程序功能說明
Public Xtczy As String '系統(tǒng)使用操作員
Public Xtczybm As String '系統(tǒng)操作員編碼
Public Xtztbm As String '系統(tǒng)帳套編碼
Public Xtdwm As String '系統(tǒng)打開帳套單位
'帳套基本參數(shù)
Public Xtjezws As Integer '金額總位數(shù)
Public Xtslzws As Integer '數(shù)量總位數(shù)
Public Xtdjzws As Integer '單價總位數(shù)
Public Xtjexsws As Integer '金額小數(shù)位數(shù)
Public Xtslxsws As Integer '數(shù)量小數(shù)位數(shù)
Public Xtdjxsws As Integer '單價小數(shù)位數(shù)
Public XtSCurrCode As String '本位幣編碼
Public XtSCurrName As String '本位幣名稱
'其它全局變量
Public Unload_TF As Boolean '窗體是否卸載
Public P_RecordCount As Integer '記錄條數(shù)
Public YesNo_str As String
Public SsqlHelp As String
Public P_Code As String: Public P_Name As String '編碼、名稱
Public AddExit_TF As Boolean '添加或編輯狀態(tài)
Public P_Ssql As String 'Sql 語句
'引用API函數(shù)
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" '統(tǒng)一使用,不可修改
Public Const Ebo_gsPrjName = "Gen13301481112" '工程項目名稱,根據(jù)項目和版本號修改
Public str_right(7) As String
'1單據(jù)索引、2單據(jù)名稱、3功能索引、4角色代碼、5單據(jù)號、6單據(jù)id號、7提示信息
Public str_billsql As String '顯示單據(jù)的字符串,用于判斷對當前單據(jù)有權(quán)限的角色
'變量聲明end 2002-10-21
'Public Const hx_RecCount = 1000 '查詢結(jié)果顯示記錄條數(shù)
Public hx_RecCount As Long '查詢結(jié)果顯示記錄條數(shù)
'圖標
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 '測量并限制字符串長度(漢字與字符區(qū)分)
'參數(shù)說明: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
'======================以下為文本錄入內(nèi)容格式輸入控制過程函數(shù)======================='
Public Sub Lrfzszxz(Sjwb As TextBox, lrzfasc As Integer) '文本框錄入整數(shù)值(負)限制
'輸入?yún)?shù):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) '文本框錄入整數(shù)值(正)限制
'輸入?yún)?shù):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) '文本框錄入數(shù)字及字符限制
'輸入?yún)?shù):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) '文本框錄入非漢字限制
'輸入?yún)?shù):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) '文本框錄入日期限制
'輸入?yún)?shù):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) '文本框錄入帶有小數(shù)位及正負號數(shù)值字段
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) '文本框錄入帶有小數(shù)位正>=0數(shù)值字段
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) '保證數(shù)值錄入字段錄入格式
'
' '輸入?yún)?shù):sjwb 錄入限制文本框 zsws 數(shù)值錄入限制整數(shù)位數(shù) xsws 數(shù)值錄入限制小數(shù)位數(shù)
'
' 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) '保證數(shù)值錄入字段錄入格式
'輸入?yún)?shù):sjwb 錄入限制文本框 zsws 數(shù)值錄入限制整數(shù)位數(shù) xsws 數(shù)值錄入限制小數(shù)位數(shù)
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, ".") '整數(shù)位數(shù)+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, ".") '整數(shù)位數(shù)+1
End If
Ws = Len(Zswstr) - Ws '小數(shù)位數(shù)
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) '錄入字段事中控制程序
'函數(shù)參數(shù):錄入限制文本框,字段數(shù)據(jù)類型,錄入字符
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-錄入整數(shù)值(正負)
Case 4
Call Lrzszxz(KeyAsciite) '4-錄入整數(shù)值(正)
Case 5, 8, 9
Call Lrxszxz(Ydtextte, KeyAsciite) '5-錄入小數(shù)值(正負) 8-金額型(正負) 9-數(shù)量型(正負)
Case 6, 10, 11, 12
Call Lrxzszxz(Ydtextte, KeyAsciite) '6-錄入小數(shù)值(正) 10-單價型 11-金額型(正) 12-數(shù)量型(正)
Case 7
Call Lrrqxz(KeyAsciite) '7-錄入日期
End Select
End Sub
Public Sub TextChangeLimit(Ydtextte As TextBox, Zdsjlxte As Integer) '文本框字段錄入控制(事后、防止用戶采用粘貼錄入)
'函數(shù)參數(shù):錄入限制文本框,字段數(shù)據(jù)類型
Dim Str_JudgeStr As String '判斷字符
Dim jsqte As Integer '臨時使用計數(shù)器
Dim Str_Result As String '結(jié)果字符串
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 '錄入數(shù)值(正)
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 '控件焦點轉(zhuǎn)移(針對回車鍵)
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() '發(fā)送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
'//* 功能: 金額小寫轉(zhuǎn)換為大寫 調(diào)用參數(shù):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
'//取無小數(shù)的字符串
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,轉(zhuǎn)換金額
End If
End If
j = 2
k = k - 2
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -