📄 系统_基本函数模块.bas
字号:
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 '固定行背景色
.Rows = Gdhs
.FixedRows = 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 vsFlexGrid, 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 vsFlexGrid, 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
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()——网格的信息数组
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -