?? 系統_基本函數模塊.bas
字號:
Public Function FnBln_RefreshArray(int_StartCol As Long, int_FinishCol As Long, GridStr() As String, GridInf()) As Boolean '網格列交換后數組做相應變換函數
'功能： 實現網格的列移動
'說明：本函數是在模式工程的基礎上創建的，請確認你的窗體中的網格是通過
' BzWgcsh(CxbbGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr()) 函數來定義的
'參數：int_StartCol——網格開始移動列
'參數：int_FinishCol——網格移動結束列
'參數：GridStr()——網格的信息數組
'思路：對于要移動的網格來說，所有的信息都保存在幾個系統數組中，其中GridStr（）數組保存著邏輯定位和
' 物理定位之間的轉換關系，使我們可以通過邏輯值找到物理值,由于我們通常通過邏輯值來定位網格的
' 物理列（sydz(zdbmte as String,GridStr() as String,szzls as Integer)函數），所以我們只需要
' 改變GridStr()數組中物理列和邏輯列之間的對應關系，從而達到改變列的目的。
'擴展：雖然本程序只是針對數據顯示網格而作，但是此程序給大家提供了一個思路，通過交換GridBoolean()、
' GridInt()、網格列標題wglbt()等數組，就可以實現輸入的列移動
On Error GoTo Err_Ctrl
Dim int_Temp As Integer
Dim str_Temp() As String '用來保存移動開始列的GridStr()信息
Dim i, j As Long
'如果結束列小于用戶定義網格開始列，則結束列=用戶定義網格開始列
'因為開始列以前的列都是隱藏列，由于要把當前開始移動列移動到隱藏列上
'所以控件自動把隱藏列變為顯示列，這樣在刷新數據時，會把隱藏列上的數據
'顯示出來，并且，由于開始列以前的隱藏列在XT_Grid中，不對應邏輯值，所以在保存
'網格格式時會出錯
If int_StartCol > int_FinishCol Then
If int_FinishCol < GridInf(1) Then int_FinishCol = GridInf(1)
Else
If Col < GridInf(1) Then Col = GridInf(1)
End If
'保存移動開始列的GridStr()信息
ReDim str_Temp(0, UBound(GridStr, 1))
For j = 1 To UBound(GridStr, 1)
str_Temp(0, j) = GridStr(int_StartCol, j)
Next
'[[在此加入你的代碼，保存當前開始移動列的其他信息]]
'依次移動各列的信息
If int_StartCol < int_FinishCol Then
For i = int_StartCol To int_FinishCol - 1
For j = 1 To UBound(GridStr, 1)
GridStr(i, j) = GridStr(i + 1, j)
Next j
Next i
Else
For i = int_StartCol To int_FinishCol + 1 Step -1
For j = 1 To UBound(GridStr, 1)
GridStr(i, j) = GridStr(i - 1, j)
Next j
Next i
End If
'[[在此加入你的代碼，依照上面的代碼格式，移動列的其他信息]]
'恢復開始移動列的信息到結束列上
For j = 1 To UBound(GridStr, 1)
GridStr(int_FinishCol, j) = str_Temp(0, j)
Next j
'[[在此加入你的代碼，恢復開始移動列的其他信息到結束列上]]
FnBln_RefreshArray = True
Err_Ctrl:
FnBln_RefreshArray = False
End Function
'========================以上為網格操作基本函數==============================='
Public Sub Drwbkxx(Wbklrbmte As String, Textvar() As Variant, Textboolean() As Boolean, Textint() As Integer, Textstr() As String) '讀入文本框錄入信息
'過程參數:輸入參數 Wbklrbmte 文本框錄入信息組索引號
' 輸出參數 Textvar() Textboolean() Textint() Textstr 文本框信息
Dim Wbklrbrec As ADODB.Recordset '文本框錄入表動態集
Dim Zdszxb As Integer '最大數組下標
Dim text_indexte As Integer '文本框索引值
ReDim Textvar(1 To 1)
Set Wbklrbrec = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM Xt_text_input WHERE Text_Group_Code ='" + Wbklrbmte + "' ORDER BY Text_index")
With Wbklrbrec
If Not (.BOF And .EOF) Then
.MoveLast
Zdszxb = .Fields("text_index")
Textvar(1) = Zdszxb
ReDim Textboolean(0 To Zdszxb, 1 To 5)
ReDim Textint(0 To Zdszxb, 1 To 14)
ReDim Textstr(0 To Zdszxb, 1 To 7)
.MoveFirst
Else
Exit Sub
End If
Do While Not .EOF
text_indexte = .Fields("text_index")
If .Fields("help_flag") Then '是否提供幫助
Textboolean(text_indexte, 1) = True
End If
If .Fields("Help_ManuFlag") Then '手工設置幫助按鈕
Textboolean(text_indexte, 3) = True
End If
If .Fields("Visible") Then '文本框是否顯示
Textboolean(text_indexte, 4) = True
End If
If .Fields("Enabled") Then '文本框是否可編輯
Textboolean(text_indexte, 5) = True
End If
If Not IsNull(.Fields("text_data_type")) Then '字段數據類型
Textint(text_indexte, 1) = .Fields("text_data_type")
End If
If Not IsNull(.Fields("help_type")) Then '幫助類型
Textint(text_indexte, 2) = .Fields("help_type")
End If
If Not IsNull(.Fields("show_code_name")) Then '幫助返回值顯示類型
Textint(text_indexte, 3) = .Fields("show_code_name")
End If
If Not IsNull(.Fields("judge_type")) Then '有效性判斷類型
Textint(text_indexte, 4) = .Fields("judge_type")
End If
If Not IsNull(.Fields("text_length")) Then '字段錄入長度
Textint(text_indexte, 5) = .Fields("text_length")
End If
If Not IsNull(.Fields("text_int_length")) Then '數值字段整數位長度
Textint(text_indexte, 6) = .Fields("text_int_length")
End If
If Not IsNull(.Fields("text_deci_length")) Then '數值字段小數位長度
Textint(text_indexte, 7) = .Fields("text_deci_length")
End If
If Not IsNull(.Fields("NotAllowEmpty_Type")) Then '字段不允許為空或為零
Textint(text_indexte, 8) = .Fields("NotAllowEmpty_Type")
End If
If Not IsNull(.Fields("Judge_Time")) Then '文本框有效性判斷時刻
Textint(text_indexte, 9) = .Fields("Judge_Time")
End If
If Not IsNull(.Fields("TextHeight")) Then '文本框高度
Textint(text_indexte, 10) = .Fields("TextHeight")
End If
If Not IsNull(.Fields("TextWidth")) Then '文本框寬度
Textint(text_indexte, 11) = .Fields("TextWidth")
End If
If Not IsNull(.Fields("TextTop")) Then '文本框距離頂端高度
Textint(text_indexte, 12) = .Fields("TextTop")
End If
If Not IsNull(.Fields("TextLeft")) Then '文本框左端距離
Textint(text_indexte, 13) = .Fields("TextLeft")
End If
If Not IsNull(.Fields("TabIndex")) Then '文本框焦點順序
Textint(text_indexte, 14) = .Fields("TabIndex")
End If
Textstr(text_indexte, 1) = Trim(.Fields("text_index") & "") '文本框對應索引值
Textstr(text_indexte, 2) = Trim(.Fields("text_field_code") & "") '文本框對應編碼字段
Textstr(text_indexte, 3) = Trim(.Fields("text_field_name") & "") '文本框對應名稱字段
Textstr(text_indexte, 4) = Trim(.Fields("help_code") & "") '通用幫助編碼
Textstr(text_indexte, 5) = Trim(.Fields("judge_base") & "") '字段有效性判斷依據
Textstr(text_indexte, 6) = Trim(.Fields("error_message") & "") '字段錄入錯誤提示信息
Textstr(text_indexte, 7) = Trim(.Fields("text_name") & "") '文本框名稱
.MoveNext
Loop
End With
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 Sub Drbmbj(Helpbm As String) '調入編碼參照編輯窗體
Select Case Helpbm
'Case "gy_dept" '部門編輯
'JC_BmszFrm.Show 1
End Select
End Sub
'===================以下為固定項列表框處理函數========================'
Public Function FillCombo(Combote As ComboBox, Lbkbmte As String, Dwnr As String, AddType As Integer) As String '填充列表框并定位
'函數參數：列表框，列表框分組編碼，定位內容,填充類型(0-無空記錄 1-有空記錄(1個空格) )
Dim Lbknrrec As ADODB.Recordset
'填充列表框內容
Set Lbknrrec = Cw_DataEnvi.DataConnect.Execute("select * from xt_combolist where combo_code='" + Trim(Lbkbmte) + "' order by item_index")
Combote.Clear
If AddType = 1 Then
Combote.AddItem " "
End If
With Lbknrrec
Do While Not .EOF
Combote.AddItem Trim(.Fields("item_content"))
.MoveNext
Loop
End With
'定位列表框內容
With Combote
For jsqte = .ListCount - 1 To 0 Step -1
If Dwnr = Trim(.List(jsqte)) Then
Exit For
End If
Next jsqte
If jsqte <> -1 Then
Combote.Text = .List(jsqte)
Else
If .ListCount <> 0 Then
.Text = .List(0)
End If
End If
End With
End Function
Public Function Fun_GetIndex(ComboCodeTe As String, FindText As String) As String '查找列表框內容對應索引號
'函數參數：列表框分組編碼，定位內容
Dim Lbknrrec As ADODB.Recordset
Fun_GetIndex = ""
'填充列表框內容
Set Lbknrrec = Cw_DataEnvi.DataConnect.Execute("select Item_Index from xt_combolist where combo_code='" & Trim(ComboCodeTe) & "' And Item_Content='" & Trim(FindText) & "'")
With Lbknrrec
If Not .EOF Then
Fun_GetIndex = Trim(.Fields("Item_Index"))
End If
End With
End Function
Public Function Fun_GetContent(ComboCodeTe As String, FindIndex As String) As String '查找列表框索引號對應內容
'函數參數：列表框分組編碼，定位內容
Dim Lbknrrec As ADODB.Recordset
Fun_GetContent = ""
'填充列表框內容
Set Lbknrrec = Cw_DataEnvi.DataConnect.Execute("select Item_Content from xt_combolist where combo_code='" & Trim(ComboCodeTe) & "' And Item_Index='" & Trim(FindIndex) & "'")
With Lbknrrec
If Not .EOF Then
Fun_GetContent = Trim(.Fields("Item_Content"))
End If
End With
End Function
'==========================以上為列表框處理基本函數=========================='
Public Function XtWaitMess(Str_IndexSub) '系統功能調用等待提示
'函數參數：系統功能模塊索引號
Xtcdcs = Str_IndexSub
XT_FrmWaitMess.Show 1
End Function
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
.AddItem Mid(Trim(str(10000 + Xtyear)), 2, 4) + "." + Mid(Trim(str(100 + jsqte)), 2, 2)
Next jsqte
.Text = Mid(Trim(str(10000 + Xtyear)), 2, 4) + "." + Mid(Trim(str(100 + Period)), 2, 2)
End With
End Function
'//* 功能: 金額小寫轉換為大寫 調用參數:jesj...人民幣小寫金額
'//* 返回變量: name..人民幣大寫金額
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -