📄
字号:
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 '调整网格显示项目
Call Cxxswg(SzgsGrid, Wggsdm) '重新定义网格显示
End Sub
Public Sub Cxxswg(Bcgsgrid As vsFlexGrid, Wggsdm As String) '根据用户定义显示项目重新显示网格
'过程参数:调整显示项目网格对象,网格格式代码(网格参数)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -