?? 系統_基本函數模塊.bas
字號:
ReDim wglkd(Qslz + Wgxsls - 1) '每列默認字符個數
ReDim zdxsgs(Qslz + Wgxsls - 1) '數值字段標志
ReDim wglzz(Qslz + Wgxsls - 1) '網格列組織形式
ReDim Sfhide(Qslz + Wgxsls - 1) '網格列是否顯示
ReDim GridBoolean(Qslz + Wgxsls - 1, 1 To 6) '網格列屬性(布爾型)
ReDim GridStr(Qslz + Wgxsls - 1, 1 To 20) '網格列信息(字符型)
ReDim GridInt(Qslz + Wgxsls - 1, 1 To 7) '網格列信息(整型)
.MoveNext
jsqte = 0
Do While Not .EOF
wglkd(Qslz + jsqte) = .Fields("ColWidth") '網格列寬度限制
If Not IsNull(.Fields("ColTitle1")) Then
wglbt(0, Qslz + jsqte) = Trim(.Fields("ColTitle1")) '網格列標題1
End If
If Not IsNull(.Fields("ColTitle2")) And Gdhs >= 2 Then '網格列標題2
wglbt(1, Qslz + jsqte) = Trim(.Fields("ColTitle2"))
End If
If Not IsNull(.Fields("ColTitle3")) And Gdhs >= 3 Then '網格列標題3
wglbt(2, Qslz + jsqte) = Trim(.Fields("ColTitle3"))
End If
If .Fields("ColFormat") Then '字段顯示格式(千分符)
If .Fields("Text_Int_Length") <> 0 Then
zdxsgs(Qslz + jsqte) = "#,##0." + String(.Fields("Text_deci_Length"), "0")
Else
zdxsgs(Qslz + jsqte) = "#,##0.00"
End If
Select Case .Fields("Text_Data_Type")
Case 8, 11 '金額
zdxsgs(Qslz + jsqte) = "#,##0." + String(Xtjexsws, "0")
Case 9, 12 '數量
zdxsgs(Qslz + jsqte) = "#,##0." + String(Xtslxsws, "0")
Case 10 '單價
zdxsgs(Qslz + jsqte) = "#,##0." + String(Xtdjxsws, "0")
End Select
Else
If .Fields("Text_Int_Length") <> 0 Then
zdxsgs(Qslz + jsqte) = "##0." + String(.Fields("Text_deci_Length"), "0")
End If
End If
wglzz(Qslz + jsqte) = .Fields("ColAlignment") '網格列組織形式
If .Fields("ColHidden") Then '網格列是否隱藏
Sfhide(Qslz + jsqte) = True
End If
If .Fields("Edit_Flag") Then '網格列是否可編輯
GridBoolean(Qslz + jsqte, 1) = True
End If
If .Fields("Help_Flag") Then '網格列是否提供幫助
GridBoolean(Qslz + jsqte, 2) = True
End If
If .Fields("Combo_Flag") Then '網格列是否列表框錄入
GridBoolean(Qslz + jsqte, 3) = True
End If
If .Fields("ColSum_Flag") Then '網格列是否合計
GridBoolean(Qslz + jsqte, 4) = True
End If
If .Fields("Zero_Empty_Flag") Then '網格內容為零是否清空
GridBoolean(Qslz + jsqte, 5) = True
End If
If .Fields("BooleanFlag") Then '網格列是否為布爾型
GridBoolean(Qslz + jsqte, 6) = True
End If
If Not IsNull(.Fields("Text_Data_Type")) Then '字段數據類型
GridInt(Qslz + jsqte, 1) = .Fields("Text_Data_Type")
End If
If Not IsNull(.Fields("Text_Length")) Then '字段錄入長度
GridInt(Qslz + jsqte, 2) = .Fields("Text_Length")
End If
If Not IsNull(.Fields("Text_Int_Length")) Then '字段整數位長度
GridInt(Qslz + jsqte, 3) = .Fields("Text_Int_Length")
End If
If Not IsNull(.Fields("Text_Deci_Length")) Then '字段小數位長度
GridInt(Qslz + jsqte, 4) = .Fields("Text_Deci_Length")
End If
If Not IsNull(.Fields("NotAllowEmpty_Type")) Then '字段不允許為空或為零
GridInt(Qslz + jsqte, 5) = .Fields("NotAllowEmpty_Type")
End If
If Not IsNull(.Fields("Help_Type")) Then '幫助類型
GridInt(Qslz + jsqte, 6) = .Fields("Help_Type")
End If
If Not IsNull(.Fields("HelpReturnValue")) Then '幫助返回值(0-顯示返回編碼 1-顯示返回名稱)
GridInt(Qslz + jsqte, 7) = .Fields("HelpReturnValue")
End If
GridStr(Qslz + jsqte, 1) = Trim(.Fields("ColIndex") & "") '網格列索引值
GridStr(Qslz + jsqte, 2) = Trim(.Fields("EmptyMessage") & "") '字段為空提示信息
GridStr(Qslz + jsqte, 3) = Trim(.Fields("Help_Code") & "") '通用幫助編碼
GridStr(Qslz + jsqte, 4) = Trim(.Fields("FieldsName") & "") '連接字段(通用幫助)
GridStr(Qslz + jsqte, 5) = Trim(.Fields("Combo_Code") & "") '列表框編碼
.MoveNext
jsqte = jsqte + 1
Loop
End With
'網格列組織形式
With Xsgrid
.BackColorFixed = &H8000000F '固定行背景色
.FixedRows = Gdhs '固定行數
.Rows = Gdhs
.Cols = Qslz + Wgxsls
.FixedCols = gdls '固定列數
.AllowUserResizing = flexResizeBoth
.MergeCells = flexMergeFixedOnly '合并單元形式
If Sfhxz Then
.SelectionMode = flexSelectionByRow
Else
.FocusRect = flexFocusHeavy
.ForeColorSel = &H80000008
.BackColorSel = &H80000005
End If
.ExplorerBar = Wglsfkydpx '網格列是否可移動及排序
.ScrollTips = True
.WordWrap = True
'填 充 網 格 標 題
For Rowjsq = 0 To .FixedRows - 1
.MergeRow(Rowjsq) = True
.RowHeight(Rowjsq) = Gdhgd
For Coljsq = Qslzte To .Cols - 1
.TextMatrix(Rowjsq, Coljsq) = wglbt(Rowjsq, Coljsq)
Next Coljsq
Next Rowjsq
'數 據 網 格 高 度
For Rowjsq = .FixedRows To .Rows - 1
.RowHeight(Rowjsq) = Sjhgd
Next Rowjsq
'定 義 錄 入 字 段 屬 性
For Coljsq = 0 To .Cols - 1
If Coljsq < Qslz Or Sfhide(Coljsq) Then
.ColHidden(Coljsq) = True
Else
.ColHidden(Coljsq) = False
End If
.MergeCol(Coljsq) = True
.ColWidth(Coljsq) = wglkd(Coljsq)
.ColAlignment(Coljsq) = wglzz(Coljsq)
If Len(zdxsgs(Coljsq)) <> 0 Then
.ColFormat(Coljsq) = zdxsgs(Coljsq)
End If
If GridBoolean(Coljsq, 6) Then
.ColDataType(Coljsq) = flexDTBoolean
End If
.FixedAlignment(Coljsq) = 4
Next Coljsq
End With
End Sub
Public Sub Bcwggs(Bcgsgrid As Object, Wggsdm As String, GridStr() As String) '保存網格格式(包括網格列寬,網格列順序)
'過程參數:Bcgsgrid 保存格式網格對象,Wggsdm 網格格式代碼(網格參數),GridStr() 從中取網格列索引信息
Dim RecTemp As New ADODB.Recordset '臨時使用動態集
Dim Qslzte As Integer '起始列值
Dim Tsxx As String '系統信息提示
Cw_DataEnvi.DataConnect.BeginTrans
On Error GoTo Swcwcl
If RecTemp.State = 1 Then RecTemp.Close
RecTemp.Open "select * from xt_grid where Grid_Code='" + Trim(Wggsdm) + "' order by ColId", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
With RecTemp
If Not .EOF Then
Qslzte = .Fields("BeginCol")
.MoveNext
End If
Do While Not .EOF
For jsqte = Qslzte To Bcgsgrid.Cols - 1
If Trim(.Fields("ColIndex")) = Trim(GridStr(jsqte, 1)) Then
Exit For
End If
Next jsqte
If jsqte <= Bcgsgrid.Cols - 1 Then
.Fields("ColId") = jsqte - Qslzte + 1
.Fields("ColWidth") = Bcgsgrid.ColWidth(jsqte)
.Update
End If
.MoveNext
Loop
End With
Cw_DataEnvi.DataConnect.CommitTrans
Tsxx = "表格格式保存完畢!"
Call Xtxxts(Tsxx, 0, 4)
Exit Sub
Swcwcl:
Cw_DataEnvi.DataConnect.RollbackTrans
Tsxx = "存盤過程中出現未知錯誤,程序自動恢復保存前狀態!"
Call Xtxxts(Tsxx, 0, 1)
Exit Sub
End Sub
Public Sub Hfmrgs(Bcgsgrid As Object, Wggsdm As String, GridStr() As String) '恢復網格默認列寬
'過程參數:保存格式網格對象,網格格式代碼(網格參數),GridStr() 從中取網格列索引信息
Dim RecTemp As New ADODB.Recordset '臨時使用動態集
Dim Qslzte As Integer '起始列值
Dim Tsxx As String '系統提示信息
Cw_DataEnvi.DataConnect.BeginTrans
If RecTemp.State = 1 Then RecTemp.Close
RecTemp.Open "select * from xt_grid where Grid_Code='" + Trim(Wggsdm) + "' order by ColId", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
On Error GoTo Swcwcl
With RecTemp
If Not .EOF Then
Qslzte = .Fields("BeginCol")
.MoveNext
End If
Do While Not .EOF
For jsqte = Qslzte To Bcgsgrid.Cols - 1
If Trim(.Fields("ColIndex")) = Trim(GridStr(jsqte, 1)) Then
Exit For
End If
Next jsqte
If jsqte <= Bcgsgrid.Cols - 1 Then
Bcgsgrid.ColWidth(jsqte) = .Fields("DefaultColWidth")
.Fields("ColWidth") = .Fields("DefaultColWidth") + 0
.Update
End If
.MoveNext
Loop
End With
Cw_DataEnvi.DataConnect.CommitTrans
Exit Sub
Swcwcl:
Cw_DataEnvi.DataConnect.RollbackTrans
Tsxx = "恢復過程中出現未知錯誤,程序自動恢復保存前狀態!"
Call Xtxxts(Tsxx, 0, 1)
Exit Sub
End Sub
Public Sub Szxsxm(SzgsGrid As vsFlexGrid, Wggsdm As String) '設置網格顯示項目
'過程參數:調整顯示項目網格對象,網格格式代碼(網格參數)
Xtcdcs = Wggsdm
XT_BgxsxmszFrm.Show 1 '調整網格顯示項目
Call Cxxswg(SzgsGrid, Wggsdm) '重新定義網格顯示
End Sub
Public Sub Cxxswg(Bcgsgrid As vsFlexGrid, Wggsdm As String) '根據用戶定義顯示項目重新顯示網格
'過程參數:調整顯示項目網格對象,網格格式代碼(網格參數)
Dim RecTemp As New ADODB.Recordset '查詢數據表動態集
Dim Qslzte As Integer
Dim Tsxx As String
Set RecTemp = Cw_DataEnvi.DataConnect.Execute("select * from xt_grid where Grid_Code='" + Trim(Wggsdm) + "' order by ColId")
With RecTemp
If Not .EOF Then
Qslzte = .Fields("BeginCol")
.MoveNext
End If
Do While Not .EOF
For jsqte = Qslzte To Bcgsgrid.Cols - 1
If Bcgsgrid.FixedRows = 1 Then
If Trim(.Fields("ColTitle1")) = Trim(Bcgsgrid.TextMatrix(0, jsqte)) Then
Exit For
End If
Else
If Trim(.Fields("ColTitle1")) = Trim(Bcgsgrid.TextMatrix(0, jsqte)) And Trim(.Fields("ColTitle2")) = Trim(Bcgsgrid.TextMatrix(1, jsqte)) Then
Exit For
End If
End If
Next jsqte
If jsqte <= Bcgsgrid.Cols - 1 Then
If .Fields("ColHidden") Then
Bcgsgrid.ColHidden(jsqte) = True
Else
Bcgsgrid.ColHidden(jsqte) = False
End If
End If
.MoveNext
Loop
End With
End Sub
Public Function Sydz(Zdbmte As String, GridStr() As String, Szzls As Integer) As Integer '網格索引對照表(用來對照網格物理與邏輯順序關系)
'函數參數:索引編碼,網格列屬性(字符型),網格列最大數組下標值
Sydz = 0
For jsqte = 0 To Szzls
If Trim(GridStr(jsqte, 1)) = Zdbmte Then
Sydz = jsqte
Exit Function
End If
Next jsqte
End Function
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -