📄 系统_基本函数模块.bas
字号:
Dim Gdhs As Long '网格固定行数(标题行数)
Dim Gdhgd As Double '网格固定行高度
Dim wglkd() As Double '每列默认字符个数
Dim wglzz() As Integer '网格列组织形式
Dim zdxsgs() As String '数值字段显示格式
Dim Sfhide() As Boolean '网格列是否隐藏
Dim Sfhxz As Boolean '网格列是否行选中
Dim Qslz As Long '网格隐藏(非操作显示)列数
Dim Sjhgd As Double '网格数据行高度
Dim Wglsfkydpx As Integer '网格列是否可移动及排序
Dim wgxsrec As New ADODB.Recordset '网格显示动态集
ReDim GridInf(1 To 7) '整个网格设置信息
Set wgxsrec = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM xt_grid WHERE Grid_Code ='" + Wgdmte + "' ORDER BY ColId")
With wgxsrec
If .EOF And .BOF Then
Exit Sub
Else
.MoveFirst
End If
'如果网格为单据则设置网格大小、位置
If .Fields("GridType") = 1 Then
Xsgrid.Height = .Fields("GridHeight") '网格高度
Xsgrid.Width = .Fields("Gridwidth") '网格宽度
Xsgrid.Top = .Fields("GridTop") '网格上边距
Xsgrid.Left = .Fields("GridLeft") '网格左边距
End If
Qslz = .Fields("BeginCol") '网格隐藏(非操作显示)列数
Sjhgd = .Fields("DataRowHeight") '网格数据行高度
GridInf(1) = Qslz '起始列值
GridInf(2) = Sjhgd '数据行高度
GridInf(3) = .Fields("KeepDataRows") '屏幕保持数据行数
GridInf(4) = .Fields("AssistantRows") '辅助项网格行数(例如:合计行)
If .Fields("SaveHelpWidth_Flag") Then '是否保留帮助宽度(字段提供帮助时,是否为按钮保留空间)
GridInf(5) = True
Else
GridInf(5) = False
End If
If .Fields("DeleteRowAsk_Flag") Then '删除有效记录行是否提示
GridInf(6) = True
Else
GridInf(6) = False
End If
If .Fields("ShowSumGrid_Flag") Then '是否显示合计网格
GridInf(7) = True
Else
GridInf(7) = False
End If
Wgxsls = .RecordCount - 1 '网格显示(主操作)列数(原.Fields("wgxsls"))
gdls = .Fields("FixCols") '网格固定列数
Gdhs = .Fields("FixRows") '网格固定行数(标题行数)
Gdhgd = .Fields("FixRowHeight") '网格固定行高度
Wglsfkydpx = .Fields("explorerbar") '网格列是否可移动及排序
If .Fields("SelectRow_Flag") Then '是否行选中
Sfhxz = True
End If
ReDim wglbt(Gdhs - 1, Wgxsls + Qslz - 1) '网格显示列标题
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 '固定行背景色
.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 '调整网格显示项目
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -