资源名称:ERPSYS.zip [点击查看]
上传用户:zhpu1995
上传日期:2013-09-06
资源大小:61151k
文件大小:28k
源码类别:
企业管理
开发平台:
Visual Basic
- VERSION 5.00
- Object = "{BEEECC20-4D5F-4F8B-BFDC-5D9B6FBDE09D}#1.0#0"; "vsflex8.ocx"
- Begin VB.Form XT_TybmczFrm
- BorderStyle = 3 'Fixed Dialog
- Caption = "通用编码参照表"
- ClientHeight = 6000
- ClientLeft = 6030
- ClientTop = 1905
- ClientWidth = 6435
- Icon = "系统_通用编码参照.frx":0000
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 6000
- ScaleWidth = 6435
- ShowInTaskbar = 0 'False
- Begin VSFlex8Ctl.VSFlexGrid CzxsGrid
- Height = 4965
- Left = 0
- TabIndex = 8
- Top = 525
- Width = 6390
- _cx = 11271
- _cy = 8758
- Appearance = 1
- BorderStyle = 1
- Enabled = -1 'True
- BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
- Name = "宋体"
- Size = 9
- Charset = 134
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- MousePointer = 0
- BackColor = -2147483643
- ForeColor = -2147483640
- BackColorFixed = -2147483633
- ForeColorFixed = -2147483630
- BackColorSel = -2147483635
- ForeColorSel = -2147483634
- BackColorBkg = -2147483636
- BackColorAlternate= -2147483643
- GridColor = -2147483633
- GridColorFixed = -2147483632
- TreeColor = -2147483632
- FloodColor = 192
- SheetBorder = -2147483642
- FocusRect = 1
- HighLight = 1
- AllowSelection = -1 'True
- AllowBigSelection= -1 'True
- AllowUserResizing= 0
- SelectionMode = 0
- GridLines = 1
- GridLinesFixed = 2
- GridLineWidth = 1
- Rows = 50
- Cols = 10
- FixedRows = 1
- FixedCols = 1
- RowHeightMin = 0
- RowHeightMax = 0
- ColWidthMin = 0
- ColWidthMax = 0
- ExtendLastCol = 0 'False
- FormatString = ""
- ScrollTrack = 0 'False
- ScrollBars = 3
- ScrollTips = 0 'False
- MergeCells = 0
- MergeCompare = 0
- AutoResize = -1 'True
- AutoSizeMode = 0
- AutoSearch = 0
- AutoSearchDelay = 2
- MultiTotals = -1 'True
- SubtotalPosition= 1
- OutlineBar = 0
- OutlineCol = 0
- Ellipsis = 0
- ExplorerBar = 0
- PicturesOver = 0 'False
- FillStyle = 0
- RightToLeft = 0 'False
- PictureType = 0
- TabBehavior = 0
- OwnerDraw = 0
- Editable = 0
- ShowComboButton = 1
- WordWrap = 0 'False
- TextStyle = 0
- TextStyleFixed = 0
- OleDragMode = 0
- OleDropMode = 0
- DataMode = 0
- VirtualData = -1 'True
- DataMember = ""
- ComboSearch = 3
- AutoSizeMouse = -1 'True
- FrozenRows = 0
- FrozenCols = 0
- AllowUserFreezing= 0
- BackColorFrozen = 0
- ForeColorFrozen = 0
- WallPaperAlignment= 9
- AccessibleName = ""
- AccessibleDescription= ""
- AccessibleValue = ""
- AccessibleRole = 24
- End
- Begin VB.CheckBox Chk_Blur
- Caption = "模糊定位"
- Height = 255
- Left = 5340
- TabIndex = 7
- Top = 180
- Width = 1035
- End
- Begin VB.Timer Timer1
- Interval = 1
- Left = 120
- Top = 90
- End
- Begin VB.CommandButton Gridsz
- Caption = "恢复默认格式"
- Height = 300
- Index = 1
- Left = 1410
- TabIndex = 6
- Top = 5580
- Width = 1335
- End
- Begin VB.CommandButton Gridsz
- Caption = "保存表格格式"
- Height = 300
- Index = 0
- Left = 30
- TabIndex = 5
- Top = 5580
- Width = 1335
- End
- Begin VB.TextBox CodeText
- Height = 300
- Left = 1080
- TabIndex = 0
- Top = 150
- Width = 4035
- End
- Begin VB.CommandButton Bjcommand
- Caption = "编辑(&E)"
- Height = 300
- Left = 5250
- TabIndex = 3
- Top = 5580
- Width = 1120
- End
- Begin VB.CommandButton QxCommand
- Cancel = -1 'True
- Caption = "取消(&C)"
- Height = 300
- Left = 4110
- TabIndex = 2
- Top = 5580
- Width = 1120
- End
- Begin VB.CommandButton QdCommand
- Caption = "确定(&O)"
- Default = -1 'True
- Height = 300
- Left = 2970
- TabIndex = 1
- Top = 5580
- Width = 1120
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- BackColor = &H00C0C0C0&
- BackStyle = 0 'Transparent
- Caption = "编码或名称:"
- Height = 180
- Index = 0
- Left = 90
- TabIndex = 4
- Top = 210
- Width = 990
- End
- End
- Attribute VB_Name = "XT_TybmczFrm"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- '******************************************************************
- '* 模 块 名 称 :打印基本模块
- '* 功 能 描 述 :
- '* 程序员姓名 : 张建忠
- '* 最后修改人 : 张建忠
- '* 最后修改时间: 2001/11/13
- '* 备 注:
- '* Xtcdcs 用来传递用户输入内容; xtbmczdm 用来传递所选编码参照
- '* xtfhcs 用来返回用户所选编码; xtfhcsfz 用来返回用户所选名称;
- '******************************************************************
- Dim Cznr As String '网格首次进入查找内容
- Dim Bmzdsyh As String '编码字段索引号
- Dim Mczdsyh As String '名称字段索引号
- Dim Sqlstr As String '查询语句
- Dim Bmczdmte As String '所选编码参照代码
- '以下为固定使用变量
- Dim Cxnrrec As New ADODB.Recordset '显示查询内容动态集
- Dim GridCode As String '显示网格网格代码
- Dim GridInf() As Variant '整个网格设置信息
- Dim Tsxx As String '系统提示信息
- Dim Qslz As Long '网格隐藏(非操作显示)列数
- Dim Sjhgd As Double '网格数据行高度
- Dim GridBoolean() As Boolean '网格列信息(布尔型)
- Dim GridStr() As String '网格列信息(字符型)
- Dim GridInt() As Integer '网格列信息(整型)
- Dim Szzls As Integer '数组总列数(网格列数-1)
- Private Sub CodeText_Change() '用户可模糊定位编码或名称信息
- Dim DwRow As Long
- Dim Lng_BmCol As Long
- Dim Lng_McCol As Long
- On Error Resume Next
- Lng_BmCol = Sydz(Bmzdsyh, GridStr(), Szzls)
- Lng_McCol = Sydz(Mczdsyh, GridStr(), Szzls)
- Cznr = Trim(CodeText.Text)
- With CzxsGrid
- '按编码定位(按前几位精确匹配定位)
- For DwRow = .FixedRows To .Rows - 1
- If Mid(.TextMatrix(DwRow, Lng_BmCol), 1, Len(Cznr)) = Cznr Then
- .Row = DwRow
- .Col = Lng_BmCol
- CzxsGrid.SetFocus
- SendKeys "{LEFT}", True
- CodeText.SetFocus
- .TopRow = DwRow
- Exit Sub
- End If
- Next DwRow
- '按名称定位(支持按前几位精确匹配定位和模糊匹配定位两种)
- For DwRow = .FixedRows To .Rows - 1
- If Chk_Blur.Value = 0 Then
- If Mid(.TextMatrix(DwRow, Lng_McCol), 1, Len(Cznr)) = Cznr Then
- .Row = DwRow
- .Col = Lng_BmCol
- CzxsGrid.SetFocus
- SendKeys "{LEFT}", True
- CodeText.SetFocus
- .TopRow = DwRow
- Exit Sub
- End If
- Else
- If InStr(1, .TextMatrix(DwRow, Lng_McCol), Cznr) <> 0 Then
- .Row = DwRow
- .Col = Lng_BmCol
- CzxsGrid.SetFocus
- SendKeys "{LEFT}", True
- CodeText.SetFocus
- .TopRow = DwRow
- Exit Sub
- End If
- End If
- Next DwRow
- '按拼音码定位(支持按前几位精确匹配定位和模糊匹配定位两种)
- For DwRow = .FixedRows To .Rows - 1
- If Chk_Blur.Value = 0 Then
- If Mid(GetPY(.TextMatrix(DwRow, Lng_McCol)), 1, Len(Cznr)) = UCase(Cznr) Then
- .Row = DwRow
- .Col = Lng_BmCol
- CzxsGrid.SetFocus
- SendKeys "{LEFT}", True
- CodeText.SetFocus
- .TopRow = DwRow
- Exit Sub
- End If
- Else
- If InStr(1, GetPY(.TextMatrix(DwRow, Lng_McCol)), UCase(Cznr)) <> 0 Then
- .Row = DwRow
- .Col = Lng_BmCol
- CzxsGrid.SetFocus
- SendKeys "{LEFT}", True
- CodeText.SetFocus
- .TopRow = DwRow
- Exit Sub
- End If
- End If
- Next DwRow
- End With
- End Sub
- Private Sub CzxsGrid_GotFocus()
- SendKeys "{LEFT}", True
- End Sub
- Private Sub Form_Load()
- On Error GoTo Cwcl
- '接收通用参照编码
- Bmczdmte = Xtbmczdm
- Xtbmczdm = ""
- '读入编码参照数据
- Call Drbmczsx
- '调 入 网 格
- Call Sub_ShowGrid(CzxsGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
- Qslz = GridInf(1)
- Sjhgd = GridInf(2)
- Szzls = CzxsGrid.Cols - 1
- Bmzd = GridStr(Sydz(Bmzdsyh, GridStr(), Szzls), 4)
- Mczd = GridStr(Sydz(Mczdsyh, GridStr(), Szzls), 4)
- '填 充 网 格
- CzxsGrid.Redraw = False '为了加快显示速度
- Call bmtcwg
- CzxsGrid.Redraw = True
- Exit Sub
- Cwcl:
- Tsxx = "此字段编码参照调入时出现错误!"
- Call Xtxxts(Tsxx, 0, 4)
- Unload Me
- Exit Sub
- End Sub
- Private Sub Timer1_Timer()
- Timer1.Enabled = False
- '填充定位文本框,同时定位
- CodeText.Text = Trim(Xtcdcs)
- '首次让帮助网格得到焦点
- CzxsGrid.SetFocus
- End Sub
- Private Sub bmtcwg() '查询内容填充网格,并模糊定位用户录入信息
- Dim Coljsq As Long
- Sqlstr = Replace(Sqlstr, "@", "'" & Trim(Xtcdcs) & "%'")
- Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
- With Cxnrrec
- If .EOF And .BOF Then
- Exit Sub
- Else
- .MoveLast
- CzxsGrid.Rows = CzxsGrid.FixedRows
- CzxsGrid.Rows = .RecordCount + CzxsGrid.FixedRows
- .MoveFirst
- End If
- Jsqte = CzxsGrid.FixedRows
- Do While Not .EOF
- If Jsqte >= CzxsGrid.Rows Then
- CzxsGrid.AddItem ""
- End If
- For Coljsq = Qslz To CzxsGrid.Cols - 1
- If GridBoolean(Coljsq, 6) Then
- If .Fields(GridStr(Coljsq, 4)) Then
- CzxsGrid.TextMatrix(Jsqte, Sydz(GridStr(Coljsq, 1), GridStr(), Szzls)) = True
- End If
- Else
- CzxsGrid.TextMatrix(Jsqte, Sydz(GridStr(Coljsq, 1), GridStr(), Szzls)) = Trim(.Fields(GridStr(Coljsq, 4)) & "")
- End If
- Next Coljsq
- CzxsGrid.RowHeight(Jsqte) = Sjhgd
- .MoveNext
- Jsqte = Jsqte + 1
- Loop
- End With
- End Sub
- Private Sub CzxsGrid_Click() '单击网格固定行某列按此列排序(字符型)
- With CzxsGrid
- If .MouseRow <= .FixedRows - 1 And .MouseCol>=0 Then
- .Col = .MouseCol
- .Sort = flexSortStringAscending
- End If
- End With
- End Sub
- Private Sub CzxsGrid_DblClick() '用户双击网格返回当前选中编码
- Call Fhxzbm
- End Sub
- Private Sub Form_Unload(Cancel As Integer) '退出
- Set Cxnrrec = Nothing
- End Sub
- Private Sub Gridsz_Click(Index As Integer)
- Select Case Index
- Case 0 '保存表格格式
- Call Bcwggs1(CzxsGrid, GridCode)
- Case 1 '恢复默认格式
- Call Hfmrgs1(CzxsGrid, GridCode)
- End Select
- End Sub
- Private Sub QdCommand_Click() '确 定
- Call Fhxzbm
- End Sub
- Private Sub QxCommand_Click() '取 消
- Xtfhcs = ""
- Xtfhcsfz = ""
- Unload Me
- End Sub
- Private Sub Bjcommand_Click() '调入编码编辑窗体
- Call Drbmbj(Bmczdmte)
- Call bmtcwg
- End Sub
- Private Sub Fhxzbm() '返回用户选中编码并退出
- With CzxsGrid
- If .Row >= .FixedRows Then
- Xtfhcs = Trim(.TextMatrix(.Row, Sydz(Bmzdsyh, GridStr(), Szzls)))
- Xtfhcsfz = Trim(.TextMatrix(.Row, Sydz(Mczdsyh, GridStr(), Szzls)))
- Else
- Xtfhcs = ""
- Xtfhcsfz = ""
- End If
- End With
- Unload Me
- End Sub
- Private Sub Drbmczsx() '读入编码参照表属性
- Dim Tyhelprec As New ADODB.Recordset '帮助编码动态集
- Sqlstr = "select * from xt_tyhelp where help_code='" + Bmczdmte + "'"
- Set Tyhelprec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
- With Tyhelprec
- If Not .EOF Then
- GridCode = Trim(.Fields("grid_code"))
- Sqlstr = Trim(.Fields("sql_string"))
- Bmzdsyh = Trim(.Fields("code_field"))
- Mczdsyh = Trim(.Fields("name_field"))
- If .Fields("edit_enable") Then
- Bjcommand.Enabled = True
- Else
- Bjcommand.Enabled = False
- End If
- Me.Caption = Trim(.Fields("help_name"))
- End If
- End With
- End Sub
- Private Sub Sub_ShowGrid(Xsgrid, Wgdmte As String, GridInf() As Variant, GridBoolean() As Boolean, GridInt() As Integer, GridStr() As String) '标准网格初始化模块
- '过程参数为:生成网格对象名称(微软),网格参数编码,返回网格设置信息(返回整体信息)
- '网格列属性(返回布尔型信息),网格列属性(返回整型信息),网格列属性(返回字符型信息)
- Dim wglbt() As String '网格显示列标题
- Dim Wgxsls As Long '网格显示(主操作)列数
- Dim gdls As Long '网格固定列数
- 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
- 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 .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 '固定行背景色 ('&H80000018)
- .FixedRows = Gdhs '固定行数
- .Rows = Gdhs
- .FixedCols = gdls '固定列数
- .Cols = Qslz + Wgxsls
- .AllowUserResizing = flexResizeBoth
- .SelectionMode = flexSelectionByRow
- .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
- .ColWidth(Coljsq) = wglkd(Coljsq)
- .ColAlignment(Coljsq) = wglzz(Coljsq)
- .FixedAlignment(Coljsq) = 4
- If GridBoolean(Coljsq, 6) Then
- .ColDataType(Coljsq) = flexDTBoolean
- End If
- Next Coljsq
- End With
- End Sub
- Private Sub Bcwggs1(Bcgsgrid, Wggsdm As String) '保存网格格式(包括网格列宽,网格列顺序)
- '过程参数:保存格式网格对象,网格格式代码(网格参数)
- Dim Cxsjbrec As New ADODB.Recordset
- Dim Qslzte As Integer
- Dim Tsxx As String
- Cw_DataEnvi.DataConnect.BeginTrans
- On Error GoTo Swcwcl
- If Cxsjbrec.State = 1 Then Cxsjbrec.Close
- Cxsjbrec.Open "select * from xt_grid where Grid_Code='" + Trim(Wggsdm) + "' order by ColId", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
- With Cxsjbrec
- 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
- .Fields("ColId") = Jsqte - Qslzte + 1
- .Fields("ColWidth") = Bcgsgrid.ColWidth(Jsqte)
- .Update
- Else
- GoTo Swcwcl
- 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
- Private Sub Hfmrgs1(Bcgsgrid, Wggsdm As String) '恢复网格默认列宽
- '过程参数:保存格式网格对象,网格格式代码(网格参数)
- Dim Cxsjbrec As New ADODB.Recordset '查询数据表动态集
- Dim Qslzte As Integer
- Dim Tsxx As String
- Cw_DataEnvi.DataConnect.BeginTrans
- If Cxsjbrec.State = 1 Then Cxsjbrec.Close
- Cxsjbrec.Open "select * from xt_grid where Grid_Code='" + Trim(Wggsdm) + "' order by ColId", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
- On Error GoTo Swcwcl
- With Cxsjbrec
- 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
- 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