?? 系統_基本函數模塊.bas
字號:
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 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 語句
Private Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLength As Integer
hAddrList As Long
End Type
'引用API函數
Private Declare Function gethostname Lib "WSOCK32.DLL" (ByVal hostname$, ByVal HostLen As Long) As Long
Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal hostname$) As Long
Private Declare Sub RtlMoveMemory Lib "KERNEL32" (hpvDest As Any, ByVal hpvSource&, ByVal cbCopy&)
'變量聲明begin 2002-10-21 add 4 new Operate & Access Right
Public ServerName As String
Public gBillId As String
Public Const LOG_IN = True
Public Const LOG_OUT = False
Public Const Ebo_gsProductName = "Ebodiy2008" '統一使用,不可修改
Public Const Ebo_gsPrjName = "Gen13301481112" '工程項目名稱,根據項目和版本號修改
'變量聲明end 2002-10-21
Sub Main()
If App.PrevInstance = True Then
Exit Sub
Else
XT_login.Show
End If
End Sub
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
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 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 Function Xtxxts(xttsxx As String, xttslb As Integer, Tbtslb As Integer) '系統信息提示
msgtitle = "宇迪光學/ERP2.00-總控臺"
Select Case xttslb
Case 0 '確定
Xtxxts = MsgBox(xttsxx, Tbtslb * 16, msgtitle)
Case 1 'YES/NO
Xtxxts = MsgBox(xttsxx, vbYesNo + Tbtslb * 16, msgtitle)
Case 2 '確定/取消
Xtxxts = MsgBox(xttsxx, vbOKCancel + Tbtslb * 16, msgtitle)
Case Else
Xtxxts = "9"
End Select
End Function
Public Function Kjjdzy(Zyjdzs As Integer) As Boolean '控件焦點轉移(針對回車鍵)
Kjjdzy = False
On Error GoTo Cwcl
If Screen.ActiveControl.TabIndex <= Zyjdzs - 1 Then
Kjjdzy = True
SendKeys "{tab}"
End If
Exit Function
Cwcl:
Resume Next '有些對象不支持TabIndex屬性
End Function
Public Sub Pbwxzf(Zfc As Integer) '錄入時屏蔽"'"
If Chr(Zfc) = "'" Then
Zfc = 0
End If
End Sub
Public Function Mmjm(Srmm As String) As String '密碼加密對照模塊
Dim Zfcte As Integer
Mmjm = ""
For jsqte = 1 To Len(Srmm)
Zfcte = Asc(Mid(Srmm, jsqte, 1)) + Asc(Mid(Srmm, Len(Srmm) - jsqte + 1, 1)) + Len(Srmm) + jsqte
Mmjm = Mmjm + Trim(Str(Zfcte))
Next jsqte
End Function
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
Public Function Sub_FillPeriod(Combote As ComboBox, Year As Integer, Period As Integer) '列表框填充會計期間
'過程參數;填充列表框,會計年度,默認會計期間
Dim jsqte As Integer
With Combote
.Clear
For jsqte = 1 To 12
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -