企业管理

开发平台：
Visual Basic

：源码内容
							VERSION 5.00
Object = "{D76D7128-4A96-11D3-BD95-D296DC2DD072}#1.0#0"; "VSOCX7.OCX"
Begin VB.Form XT_TybmczFrm 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "通用编码参照表"
   ClientHeight    =   6000
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6435
   Icon            =   "系统_通用编码参照.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6000
   ScaleWidth      =   6435
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CheckBox Chk_Blur 
      Caption         =   "模糊定位"
      Height          =   255
      Left            =   5340
      TabIndex        =   8
      Top             =   180
      Width           =   1035
   End
   Begin VB.Timer Timer1 
      Interval        =   1
      Left            =   120
      Top             =   90
   End
   Begin VSFlex8Ctl.VSFlexGrid CzxsGrid 
      Height          =   4905
      Left            =   60
      TabIndex        =   0
      Top             =   540
      Width           =   6315
      _ExtentX        =   11139
      _ExtentY        =   8652
      _Version        =   393216
      FocusRect       =   0
Rows =  2 
Cols =  2 
   End
   Begin VB.CommandButton Gridsz 
      Caption         =   "恢复默认格式"
      Height          =   300
      Index           =   1
      Left            =   1410
      TabIndex        =   7
      Top             =   5580
      Width           =   1335
   End
   Begin VB.CommandButton Gridsz 
      Caption         =   "保存表格格式"
      Height          =   300
      Index           =   0
      Left            =   30
      TabIndex        =   6
      Top             =   5580
      Width           =   1335
   End
   Begin VB.TextBox CodeText 
      Height          =   300
      Left            =   1080
      TabIndex        =   1
      Top             =   150
      Width           =   4035
   End
   Begin VB.CommandButton Bjcommand 
      Caption         =   "编辑(&E)"
      Height          =   300
      Left            =   5250
      TabIndex        =   4
      Top             =   5580
      Width           =   1120
   End
   Begin VB.CommandButton QxCommand 
      Cancel          =   -1  'True
      Caption         =   "取消(&C)"
      Height          =   300
      Left            =   4110
      TabIndex        =   3
      Top             =   5580
      Width           =   1120
   End
   Begin VB.CommandButton QdCommand 
      Caption         =   "确定(&O)"
      Default         =   -1  'True
      Height          =   300
      Left            =   2970
      TabIndex        =   2
      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        =   5
      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                   '所选编码参照代码
Public sParamater 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, 3)
      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) & "%'")
    Sqlstr = Replace(Sqlstr, "#", "'" & Trim(Me.sParamater) & "'")
    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

						