上传用户:zhpu1995
上传日期:2013-09-06
资源大小:61151k
文件大小:28k
源码类别:

企业管理

开发平台:

Visual Basic

  1. VERSION 5.00
  2. Object = "{BEEECC20-4D5F-4F8B-BFDC-5D9B6FBDE09D}#1.0#0"; "vsflex8.ocx"
  3. Begin VB.Form XT_TybmczFrm 
  4.    BorderStyle     =   3  'Fixed Dialog
  5.    Caption         =   "通用编码参照表"
  6.    ClientHeight    =   6000
  7.    ClientLeft      =   2370
  8.    ClientTop       =   2025
  9.    ClientWidth     =   6435
  10.    Icon            =   "系统_通用编码参照.frx":0000
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   6000
  15.    ScaleWidth      =   6435
  16.    ShowInTaskbar   =   0   'False
  17.    Begin VSFlex8Ctl.VSFlexGrid CzxsGrid 
  18.       Height          =   4965
  19.       Left            =   75
  20.       TabIndex        =   8
  21.       Top             =   525
  22.       Width           =   6240
  23.       _cx             =   11007
  24.       _cy             =   8758
  25.       Appearance      =   1
  26.       BorderStyle     =   1
  27.       Enabled         =   -1  'True
  28.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  29.          Name            =   "宋体"
  30.          Size            =   9
  31.          Charset         =   134
  32.          Weight          =   400
  33.          Underline       =   0   'False
  34.          Italic          =   0   'False
  35.          Strikethrough   =   0   'False
  36.       EndProperty
  37.       MousePointer    =   0
  38.       BackColor       =   -2147483643
  39.       ForeColor       =   -2147483640
  40.       BackColorFixed  =   -2147483633
  41.       ForeColorFixed  =   -2147483630
  42.       BackColorSel    =   -2147483635
  43.       ForeColorSel    =   -2147483634
  44.       BackColorBkg    =   -2147483636
  45.       BackColorAlternate=   -2147483643
  46.       GridColor       =   -2147483633
  47.       GridColorFixed  =   -2147483632
  48.       TreeColor       =   -2147483632
  49.       FloodColor      =   192
  50.       SheetBorder     =   -2147483642
  51.       FocusRect       =   1
  52.       HighLight       =   1
  53.       AllowSelection  =   -1  'True
  54.       AllowBigSelection=   -1  'True
  55.       AllowUserResizing=   0
  56.       SelectionMode   =   0
  57.       GridLines       =   1
  58.       GridLinesFixed  =   2
  59.       GridLineWidth   =   1
  60.       Rows            =   50
  61.       Cols            =   10
  62.       FixedRows       =   1
  63.       FixedCols       =   1
  64.       RowHeightMin    =   0
  65.       RowHeightMax    =   0
  66.       ColWidthMin     =   0
  67.       ColWidthMax     =   0
  68.       ExtendLastCol   =   0   'False
  69.       FormatString    =   ""
  70.       ScrollTrack     =   0   'False
  71.       ScrollBars      =   3
  72.       ScrollTips      =   0   'False
  73.       MergeCells      =   0
  74.       MergeCompare    =   0
  75.       AutoResize      =   -1  'True
  76.       AutoSizeMode    =   0
  77.       AutoSearch      =   0
  78.       AutoSearchDelay =   2
  79.       MultiTotals     =   -1  'True
  80.       SubtotalPosition=   1
  81.       OutlineBar      =   0
  82.       OutlineCol      =   0
  83.       Ellipsis        =   0
  84.       ExplorerBar     =   0
  85.       PicturesOver    =   0   'False
  86.       FillStyle       =   0
  87.       RightToLeft     =   0   'False
  88.       PictureType     =   0
  89.       TabBehavior     =   0
  90.       OwnerDraw       =   0
  91.       Editable        =   0
  92.       ShowComboButton =   1
  93.       WordWrap        =   0   'False
  94.       TextStyle       =   0
  95.       TextStyleFixed  =   0
  96.       OleDragMode     =   0
  97.       OleDropMode     =   0
  98.       DataMode        =   0
  99.       VirtualData     =   -1  'True
  100.       DataMember      =   ""
  101.       ComboSearch     =   3
  102.       AutoSizeMouse   =   -1  'True
  103.       FrozenRows      =   0
  104.       FrozenCols      =   0
  105.       AllowUserFreezing=   0
  106.       BackColorFrozen =   0
  107.       ForeColorFrozen =   0
  108.       WallPaperAlignment=   9
  109.       AccessibleName  =   ""
  110.       AccessibleDescription=   ""
  111.       AccessibleValue =   ""
  112.       AccessibleRole  =   24
  113.    End
  114.    Begin VB.CheckBox Chk_Blur 
  115.       Caption         =   "模糊定位"
  116.       Height          =   255
  117.       Left            =   5340
  118.       TabIndex        =   7
  119.       Top             =   180
  120.       Width           =   1035
  121.    End
  122.    Begin VB.Timer Timer1 
  123.       Interval        =   1
  124.       Left            =   120
  125.       Top             =   90
  126.    End
  127.    Begin VB.CommandButton Gridsz 
  128.       Caption         =   "恢复默认格式"
  129.       Height          =   300
  130.       Index           =   1
  131.       Left            =   1410
  132.       TabIndex        =   6
  133.       Top             =   5580
  134.       Width           =   1335
  135.    End
  136.    Begin VB.CommandButton Gridsz 
  137.       Caption         =   "保存表格格式"
  138.       Height          =   300
  139.       Index           =   0
  140.       Left            =   30
  141.       TabIndex        =   5
  142.       Top             =   5580
  143.       Width           =   1335
  144.    End
  145.    Begin VB.TextBox CodeText 
  146.       Height          =   300
  147.       Left            =   1080
  148.       TabIndex        =   0
  149.       Top             =   150
  150.       Width           =   4035
  151.    End
  152.    Begin VB.CommandButton Bjcommand 
  153.       Caption         =   "编辑(&E)"
  154.       Height          =   300
  155.       Left            =   5250
  156.       TabIndex        =   3
  157.       Top             =   5580
  158.       Width           =   1120
  159.    End
  160.    Begin VB.CommandButton QxCommand 
  161.       Cancel          =   -1  'True
  162.       Caption         =   "取消(&C)"
  163.       Height          =   300
  164.       Left            =   4110
  165.       TabIndex        =   2
  166.       Top             =   5580
  167.       Width           =   1120
  168.    End
  169.    Begin VB.CommandButton QdCommand 
  170.       Caption         =   "确定(&O)"
  171.       Default         =   -1  'True
  172.       Height          =   300
  173.       Left            =   2970
  174.       TabIndex        =   1
  175.       Top             =   5580
  176.       Width           =   1120
  177.    End
  178.    Begin VB.Label Label1 
  179.       AutoSize        =   -1  'True
  180.       BackColor       =   &H00C0C0C0&
  181.       BackStyle       =   0  'Transparent
  182.       Caption         =   "编码或名称:"
  183.       Height          =   180
  184.       Index           =   0
  185.       Left            =   90
  186.       TabIndex        =   4
  187.       Top             =   210
  188.       Width           =   990
  189.    End
  190. End
  191. Attribute VB_Name = "XT_TybmczFrm"
  192. Attribute VB_GlobalNameSpace = False
  193. Attribute VB_Creatable = False
  194. Attribute VB_PredeclaredId = True
  195. Attribute VB_Exposed = False
  196. '******************************************************************
  197. '*    模 块 名 称 :打印基本模块
  198. '*    功 能 描 述 :
  199. '*    程序员姓名  : 白凤英
  200. '*    最后修改人  : 白凤英
  201. '*    最后修改时间: 2001/11/13
  202. '*    备        注:
  203. '*    Xtcdcs 用来传递用户输入内容; xtbmczdm 用来传递所选编码参照
  204. '*    xtfhcs 用来返回用户所选编码; xtfhcsfz 用来返回用户所选名称;
  205. '******************************************************************
  206. Dim Cznr As String                       '网格首次进入查找内容
  207. Dim Bmzdsyh As String                    '编码字段索引号
  208. Dim Mczdsyh As String                    '名称字段索引号
  209. Dim SqlStr As String                     '查询语句
  210. Dim Bmczdmte As String                   '所选编码参照代码
  211. '以下为固定使用变量
  212. Dim Cxnrrec As New ADODB.Recordset       '显示查询内容动态集
  213. Dim GridCode As String                   '显示网格网格代码
  214. Dim GridInf() As Variant                 '整个网格设置信息
  215. Dim Tsxx As String                       '系统提示信息
  216. Dim Qslz As Long                         '网格隐藏(非操作显示)列数
  217. Dim Sjhgd As Double                      '网格数据行高度
  218. Dim GridBoolean() As Boolean             '网格列信息(布尔型)
  219. Dim GridStr()  As String                 '网格列信息(字符型)
  220. Dim GridInt() As Integer                 '网格列信息(整型)
  221. Dim Szzls As Integer                     '数组总列数(网格列数-1)
  222. Private Sub CodeText_Change()            '用户可模糊定位编码或名称信息
  223.   
  224.     Dim DwRow As Long
  225.     Dim Lng_BmCol As Long
  226.     Dim Lng_McCol As Long
  227.     
  228.     On Error Resume Next
  229.     Lng_BmCol = Sydz(Bmzdsyh, GridStr(), Szzls)
  230.     Lng_McCol = Sydz(Mczdsyh, GridStr(), Szzls)
  231.     Cznr = Trim(CodeText.Text)
  232.     With CzxsGrid
  233.   
  234.         '按编码定位(按前几位精确匹配定位)
  235.         For DwRow = .FixedRows To .Rows - 1
  236.             If Mid(.TextMatrix(DwRow, Lng_BmCol), 1, Len(Cznr)) = Cznr Then
  237.                 .Row = DwRow
  238.                 .Col = Lng_BmCol
  239.                 CzxsGrid.SetFocus
  240.                 SendKeys "{LEFT}", True
  241.                 CodeText.SetFocus
  242.                 .TopRow = DwRow
  243.                 Exit Sub
  244.             End If
  245.         Next DwRow
  246.         
  247.         '按名称定位(支持按前几位精确匹配定位和模糊匹配定位两种)
  248.         For DwRow = .FixedRows To .Rows - 1
  249.             If Chk_Blur.Value = 0 Then
  250.                 If Mid(.TextMatrix(DwRow, Lng_McCol), 1, Len(Cznr)) = Cznr Then
  251.                     .Row = DwRow
  252.                     .Col = Lng_BmCol
  253.                     CzxsGrid.SetFocus
  254.                     SendKeys "{LEFT}", True
  255.                     CodeText.SetFocus
  256.                     .TopRow = DwRow
  257.                     Exit Sub
  258.                 End If
  259.             Else
  260.                 If InStr(1, .TextMatrix(DwRow, Lng_McCol), Cznr) <> 0 Then
  261.                     .Row = DwRow
  262.                     .Col = Lng_BmCol
  263.                     CzxsGrid.SetFocus
  264.                     SendKeys "{LEFT}", True
  265.                     CodeText.SetFocus
  266.                     .TopRow = DwRow
  267.                     Exit Sub
  268.                 End If
  269.             End If
  270.         Next DwRow
  271.         
  272.         '按拼音码定位(支持按前几位精确匹配定位和模糊匹配定位两种)
  273.         For DwRow = .FixedRows To .Rows - 1
  274.             If Chk_Blur.Value = 0 Then
  275.                 If Mid(GetPY(.TextMatrix(DwRow, Lng_McCol)), 1, Len(Cznr)) = UCase(Cznr) Then
  276.                     .Row = DwRow
  277.                     .Col = Lng_BmCol
  278.                     CzxsGrid.SetFocus
  279.                     SendKeys "{LEFT}", True
  280.                     CodeText.SetFocus
  281.                     .TopRow = DwRow
  282.                     Exit Sub
  283.                 End If
  284.             Else
  285.                 If InStr(1, GetPY(.TextMatrix(DwRow, Lng_McCol)), UCase(Cznr)) <> 0 Then
  286.                     .Row = DwRow
  287.                     .Col = Lng_BmCol
  288.                     CzxsGrid.SetFocus
  289.                     SendKeys "{LEFT}", True
  290.                     CodeText.SetFocus
  291.                     .TopRow = DwRow
  292.                     Exit Sub
  293.                 End If
  294.             End If
  295.         Next DwRow
  296.     End With
  297. End Sub
  298. Private Sub CzxsGrid_GotFocus()
  299.     SendKeys "{LEFT}", True
  300. End Sub
  301. Private Sub Form_Load()
  302.   
  303.     On Error GoTo Cwcl
  304.   
  305.     '接收通用参照编码
  306.     Bmczdmte = Xtbmczdm
  307.     Xtbmczdm = ""
  308.     
  309.     '读入编码参照数据
  310.     Call Drbmczsx
  311.     
  312.     '调 入 网 格
  313.     Call Sub_ShowGrid(CzxsGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  314.     
  315.     Qslz = GridInf(1)
  316.     Sjhgd = GridInf(2)
  317.     Szzls = CzxsGrid.Cols - 1
  318.     Bmzd = GridStr(Sydz(Bmzdsyh, GridStr(), Szzls), 4)
  319.     Mczd = GridStr(Sydz(Mczdsyh, GridStr(), Szzls), 4)
  320.     
  321.     '填 充 网 格
  322.     
  323.     CzxsGrid.Redraw = False   '为了加快显示速度
  324.     Call bmtcwg
  325.     CzxsGrid.Redraw = True
  326.       
  327.     Exit Sub
  328.         
  329. Cwcl:
  330.       Tsxx = "此字段编码参照调入时出现错误!"
  331.       Call Xtxxts(Tsxx, 0, 4)
  332.       Unload Me
  333.       Exit Sub
  334.  
  335. End Sub
  336. Private Sub Timer1_Timer()
  337.    
  338.     Timer1.Enabled = False
  339.    
  340.     '填充定位文本框,同时定位
  341.     CodeText.Text = Trim(Xtcdcs)
  342.     
  343.     '首次让帮助网格得到焦点
  344.     CzxsGrid.SetFocus
  345. End Sub
  346. Private Sub bmtcwg()                                     '查询内容填充网格,并模糊定位用户录入信息
  347.     
  348.     Dim Coljsq As Long
  349.     SqlStr = Replace(SqlStr, "@", "'" & Trim(Xtcdcs) & "%'")
  350.     SqlStr = Replace(SqlStr, "$$", "'" & Trim(Xtczybm) & "'")
  351.     Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  352.     With Cxnrrec
  353.         If .EOF And .BOF Then
  354.             Exit Sub
  355.         Else
  356.             .MoveLast
  357.             CzxsGrid.Rows = CzxsGrid.FixedRows
  358.             CzxsGrid.Rows = .RecordCount + CzxsGrid.FixedRows
  359.             .MoveFirst
  360.         End If
  361.         Jsqte = CzxsGrid.FixedRows
  362.         Do While Not .EOF
  363.             If Jsqte >= CzxsGrid.Rows Then
  364.                 CzxsGrid.AddItem ""
  365.             End If
  366.             For Coljsq = Qslz To CzxsGrid.Cols - 1
  367.                 If GridBoolean(Coljsq, 6) Then
  368.                     If .Fields(GridStr(Coljsq, 4)) Then
  369.                         CzxsGrid.TextMatrix(Jsqte, Sydz(GridStr(Coljsq, 1), GridStr(), Szzls)) = True
  370.                     End If
  371.                 Else
  372.                     CzxsGrid.TextMatrix(Jsqte, Sydz(GridStr(Coljsq, 1), GridStr(), Szzls)) = Trim(.Fields(GridStr(Coljsq, 4)) & "")
  373.                 End If
  374.             Next Coljsq
  375.             CzxsGrid.RowHeight(Jsqte) = Sjhgd
  376.             .MoveNext
  377.             Jsqte = Jsqte + 1
  378.         Loop
  379.     End With
  380. End Sub
  381. Private Sub CzxsGrid_Click()                           '单击网格固定行某列按此列排序(字符型)
  382.     With CzxsGrid
  383.         If .MouseRow = 0 And .Col >= .FixedCols Then
  384.             .Col = .MouseCol
  385.             .Sort = flexSortStringAscending
  386.         End If
  387.     End With
  388. End Sub
  389. Private Sub CzxsGrid_DblClick()                        '用户双击网格返回当前选中编码
  390.     Call Fhxzbm
  391. End Sub
  392. Private Sub Form_Unload(Cancel As Integer)             '退出
  393.     Set Cxnrrec = Nothing
  394. End Sub
  395. Private Sub Gridsz_Click(Index As Integer)
  396.     
  397.     Select Case Index
  398.         Case 0                                   '保存表格格式
  399.             Call Bcwggs1(CzxsGrid, GridCode)
  400.         Case 1                                   '恢复默认格式
  401.             Call Hfmrgs1(CzxsGrid, GridCode)
  402.     End Select
  403. End Sub
  404. Private Sub QdCommand_Click()                          '确 定
  405.     Call Fhxzbm
  406. End Sub
  407. Private Sub QxCommand_Click()                          '取 消
  408.     
  409.     Xtfhcs = ""
  410.     Xtfhcsfz = ""
  411.     Unload Me
  412. End Sub
  413. Private Sub Bjcommand_Click()                          '调入编码编辑窗体
  414.     
  415.     Call Drbmbj(Bmczdmte)
  416.     Call bmtcwg
  417. End Sub
  418. Private Sub Fhxzbm()                                   '返回用户选中编码并退出
  419.   
  420.     With CzxsGrid
  421.         If .Row >= .FixedRows Then
  422.             Xtfhcs = Trim(.TextMatrix(.Row, Sydz(Bmzdsyh, GridStr(), Szzls)))
  423.             Xtfhcsfz = Trim(.TextMatrix(.Row, Sydz(Mczdsyh, GridStr(), Szzls)))
  424.         Else
  425.             Xtfhcs = ""
  426.             Xtfhcsfz = ""
  427.         End If
  428.     End With
  429.     Unload Me
  430. End Sub
  431. Private Sub Drbmczsx()                                 '读入编码参照表属性
  432.     
  433.     Dim Tyhelprec As New ADODB.Recordset                '帮助编码动态集
  434.     SqlStr = "select * from xt_tyhelp where help_code='" + Bmczdmte + "'"
  435.     Set Tyhelprec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  436.     With Tyhelprec
  437.         If Not .EOF Then
  438.             GridCode = Trim(.Fields("grid_code"))
  439.             SqlStr = Trim(.Fields("sql_string"))
  440.             Bmzdsyh = Trim(.Fields("code_field"))
  441.             Mczdsyh = Trim(.Fields("name_field"))
  442.             If .Fields("edit_enable") Then
  443.                 Bjcommand.Enabled = True
  444.             Else
  445.                 Bjcommand.Enabled = False
  446.             End If
  447.             Me.Caption = Trim(.Fields("help_name"))
  448.         End If
  449.     End With
  450. End Sub
  451. Private Sub Sub_ShowGrid(XsGrid, Wgdmte As String, GridInf() As Variant, GridBoolean() As Boolean, GridInt() As Integer, GridStr() As String)           '标准网格初始化模块
  452.   
  453.     '过程参数为:生成网格对象名称(微软),网格参数编码,返回网格设置信息(返回整体信息)
  454.     '网格列属性(返回布尔型信息),网格列属性(返回整型信息),网格列属性(返回字符型信息)
  455.     
  456.     Dim wglbt() As String                      '网格显示列标题
  457.     Dim Wgxsls As Long                         '网格显示(主操作)列数
  458.     Dim gdls As Long                           '网格固定列数
  459.     Dim Gdhs As Long                           '网格固定行数(标题行数)
  460.     Dim Gdhgd As Double                        '网格固定行高度
  461.     Dim wglkd() As Double                      '每列默认字符个数
  462.     Dim wglzz() As Integer                     '网格列组织形式
  463.     Dim zdxsgs() As String                     '数值字段显示格式
  464.     Dim Sfhide() As Boolean                    '网格列是否隐藏
  465.     Dim Sfhxz As Boolean                       '网格列是否行选中
  466.     Dim Qslz As Long                           '网格隐藏(非操作显示)列数
  467.     Dim Sjhgd As Double                        '网格数据行高度
  468.     Dim Wglsfkydpx As Integer                  '网格列是否可移动及排序
  469.     Dim wgxsrec As New ADODB.Recordset         '网格显示动态集
  470.     
  471.     ReDim GridInf(1 To 7)                       '整个网格设置信息
  472.     Set wgxsrec = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM xt_grid WHERE Grid_Code ='" + Wgdmte + "' ORDER BY ColId")
  473.     With wgxsrec
  474.         If .EOF And .BOF Then
  475.             Exit Sub
  476.         Else
  477.             .MoveFirst
  478.         End If
  479.      
  480.         Qslz = .Fields("BeginCol")                '网格隐藏(非操作显示)列数
  481.         Sjhgd = .Fields("DataRowHeight")          '网格数据行高度
  482.          
  483.         GridInf(1) = Qslz                         '起始列值
  484.         GridInf(2) = Sjhgd                        '数据行高度
  485.         GridInf(3) = .Fields("KeepDataRows")      '屏幕保持数据行数
  486.         GridInf(4) = .Fields("AssistantRows")     '辅助项网格行数(例如:合计行)
  487.         If .Fields("SaveHelpWidth_Flag") Then     '是否保留帮助宽度(字段提供帮助时,是否为按钮保留空间)
  488.             GridInf(5) = True
  489.         Else
  490.             GridInf(5) = False
  491.         End If
  492.         If .Fields("DeleteRowAsk_Flag") Then      '删除有效记录行是否提示
  493.             GridInf(6) = True
  494.         Else
  495.             GridInf(6) = False
  496.         End If
  497.         If .Fields("ShowSumGrid_Flag") Then       '是否显示合计网格
  498.             GridInf(7) = True
  499.         Else
  500.             GridInf(7) = False
  501.         End If
  502.            
  503.         Wgxsls = .RecordCount - 1                 '网格显示(主操作)列数(原.Fields("wgxsls"))
  504.         gdls = .Fields("FixCols")                 '网格固定列数
  505.         Gdhs = .Fields("FixRows")                 '网格固定行数(标题行数)
  506.         Gdhgd = .Fields("FixRowHeight")           '网格固定行高度
  507.         Wglsfkydpx = .Fields("explorerbar")       '网格列是否可移动及排序
  508.         
  509.         If .Fields("SelectRow_Flag") Then         '是否行选中
  510.             Sfhxz = True
  511.         End If
  512.         
  513.         ReDim wglbt(Gdhs - 1, Wgxsls + Qslz - 1)  '网格显示列标题
  514.         ReDim wglkd(Qslz + Wgxsls - 1)            '每列默认字符个数
  515.         ReDim zdxsgs(Qslz + Wgxsls - 1)           '数值字段标志
  516.         ReDim wglzz(Qslz + Wgxsls - 1)            '网格列组织形式
  517.         ReDim Sfhide(Qslz + Wgxsls - 1)           '网格列是否显示
  518.         ReDim GridBoolean(Qslz + Wgxsls - 1, 1 To 6)   '网格列属性(布尔型)
  519.         ReDim GridStr(Qslz + Wgxsls - 1, 1 To 20)      '网格列信息(字符型)
  520.         ReDim GridInt(Qslz + Wgxsls - 1, 1 To 7)       '网格列信息(整型)
  521.         
  522.         .MoveNext
  523.         Jsqte = 0
  524.         Do While Not .EOF
  525.         
  526.             wglkd(Qslz + Jsqte) = .Fields("ColWidth")                  '网格列宽度限制
  527.             If Not IsNull(.Fields("ColTitle1")) Then
  528.                 wglbt(0, Qslz + Jsqte) = Trim(.Fields("ColTitle1"))    '网格列标题1
  529.             End If
  530.             If Not IsNull(.Fields("ColTitle2")) And Gdhs = 2 Then      '网格列标题2
  531.                 wglbt(1, Qslz + Jsqte) = Trim(.Fields("ColTitle2"))
  532.             End If
  533.          
  534.             If .Fields("ColFormat") Then                               '字段显示格式(千分符)
  535.                 If .Fields("Text_Int_Length") <> 0 Then
  536.                     zdxsgs(Qslz + Jsqte) = "#,##0." + String(.Fields("Text_deci_Length"), "0")
  537.                 Else
  538.                     zdxsgs(Qslz + Jsqte) = "#,##0.00"
  539.                 End If
  540.                 Select Case .Fields("Text_Data_Type")
  541.                     Case 8, 11  '金额
  542.                         zdxsgs(Qslz + Jsqte) = "#,##0." + String(Xtjexsws, "0")
  543.                     Case 9, 12  '数量
  544.                         zdxsgs(Qslz + Jsqte) = "#,##0." + String(Xtslxsws, "0")
  545.                     Case 10     '单价
  546.                         zdxsgs(Qslz + Jsqte) = "#,##0." + String(Xtdjxsws, "0")
  547.                 End Select
  548.             Else
  549.                 If .Fields("Text_Int_Length") <> 0 Then
  550.                     zdxsgs(Qslz + Jsqte) = "##0." + String(.Fields("Text_deci_Length"), "0")
  551.                 End If
  552.             End If
  553.     
  554.             wglzz(Qslz + Jsqte) = .Fields("ColAlignment")              '网格列组织形式
  555.             If .Fields("ColHidden") Then                               '网格列是否隐藏
  556.                 Sfhide(Qslz + Jsqte) = True
  557.             End If
  558.             If .Fields("Edit_Flag") Then                               '网格列是否可编辑
  559.                 GridBoolean(Qslz + Jsqte, 1) = True
  560.             End If
  561.             If .Fields("Help_Flag") Then                               '网格列是否提供帮助
  562.                 GridBoolean(Qslz + Jsqte, 2) = True
  563.             End If
  564.             If .Fields("Combo_Flag") Then                              '网格列是否列表框录入
  565.                 GridBoolean(Qslz + Jsqte, 3) = True
  566.             End If
  567.             If .Fields("ColSum_Flag") Then                             '网格列是否合计
  568.                 GridBoolean(Qslz + Jsqte, 4) = True
  569.             End If
  570.             If .Fields("Zero_Empty_Flag") Then                         '网格内容为零是否清空
  571.                 GridBoolean(Qslz + Jsqte, 5) = True
  572.             End If
  573.             If .Fields("BooleanFlag") Then                             '网格列是否为布尔型
  574.                 GridBoolean(Qslz + Jsqte, 6) = True
  575.             End If
  576.         
  577.             If Not IsNull(.Fields("Text_Data_Type")) Then              '字段数据类型
  578.                 GridInt(Qslz + Jsqte, 1) = .Fields("Text_Data_Type")
  579.             End If
  580.             If Not IsNull(.Fields("Text_Length")) Then                 '字段录入长度
  581.                 GridInt(Qslz + Jsqte, 2) = .Fields("Text_Length")
  582.             End If
  583.             If Not IsNull(.Fields("Text_Int_Length")) Then             '字段整数位长度
  584.                 GridInt(Qslz + Jsqte, 3) = .Fields("Text_Int_Length")
  585.             End If
  586.             If Not IsNull(.Fields("Text_Deci_Length")) Then            '字段小数位长度
  587.                 GridInt(Qslz + Jsqte, 4) = .Fields("Text_Deci_Length")
  588.             End If
  589.             If Not IsNull(.Fields("NotAllowEmpty_Type")) Then          '字段不允许为空或为零
  590.                 GridInt(Qslz + Jsqte, 5) = .Fields("NotAllowEmpty_Type")
  591.             End If
  592.             If Not IsNull(.Fields("Help_Type")) Then                   '帮助类型
  593.                 GridInt(Qslz + Jsqte, 6) = .Fields("Help_Type")
  594.             End If
  595.             If Not IsNull(.Fields("HelpReturnValue")) Then             '帮助返回值(0-显示返回编码 1-显示返回名称)
  596.                 GridInt(Qslz + Jsqte, 7) = .Fields("HelpReturnValue")
  597.             End If
  598.         
  599.             GridStr(Qslz + Jsqte, 1) = Trim(.Fields("ColIndex") & "")    '网格列索引值
  600.         
  601.             GridStr(Qslz + Jsqte, 2) = Trim(.Fields("EmptyMessage") & "") '字段为空提示信息
  602.         
  603.             GridStr(Qslz + Jsqte, 3) = Trim(.Fields("Help_Code") & "")    '通用帮助编码
  604.         
  605.             GridStr(Qslz + Jsqte, 4) = Trim(.Fields("FieldsName") & "")   '连接字段(通用帮助)
  606.         
  607.             GridStr(Qslz + Jsqte, 5) = Trim(.Fields("Combo_Code") & "")   '列表框编码
  608.            
  609.             .MoveNext
  610.             Jsqte = Jsqte + 1
  611.         Loop
  612.     End With
  613.    
  614.     '网格列组织形式
  615.    
  616.     With XsGrid
  617.         .BackColorFixed = &H8000000F                                     '固定行背景色 ('&H80000018)
  618.         .FixedRows = Gdhs                                                '固定行数
  619.         .Rows = Gdhs
  620.         .FixedCols = gdls                                                '固定列数
  621.         .Cols = Qslz + Wgxsls
  622.         .AllowUserResizing = flexResizeBoth
  623.         .SelectionMode = flexSelectionByRow
  624.         .WordWrap = True
  625.         
  626.         '填 充 网 格 标 题
  627.         For Rowjsq = 0 To .FixedRows - 1
  628.             .MergeRow(Rowjsq) = True
  629.             .RowHeight(Rowjsq) = Gdhgd
  630.             For Coljsq = Qslzte To .Cols - 1
  631.                 .TextMatrix(Rowjsq, Coljsq) = wglbt(Rowjsq, Coljsq)
  632.             Next Coljsq
  633.         Next Rowjsq
  634.         
  635.         '数 据 网 格 高 度
  636.         For Rowjsq = .FixedRows To .Rows - 1
  637.             .RowHeight(Rowjsq) = Sjhgd
  638.         Next Rowjsq
  639.      
  640.         '定 义 录 入 字 段 属 性
  641.         For Coljsq = 0 To .Cols - 1
  642.             .ColWidth(Coljsq) = wglkd(Coljsq)
  643.             .ColAlignment(Coljsq) = wglzz(Coljsq)
  644.             .FixedAlignment(Coljsq) = 4
  645.             If GridBoolean(Coljsq, 6) Then
  646.                 .ColDataType(Coljsq) = flexDTBoolean
  647.             End If
  648.         Next Coljsq
  649.     End With
  650. End Sub
  651. Private Sub Bcwggs1(Bcgsgrid, Wggsdm As String)             '保存网格格式(包括网格列宽,网格列顺序)
  652.     
  653.     '过程参数:保存格式网格对象,网格格式代码(网格参数)
  654.     
  655.     Dim Cxsjbrec As New ADODB.Recordset
  656.     Dim Qslzte As Integer
  657.     Dim Tsxx As String
  658.     Cw_DataEnvi.DataConnect.BeginTrans
  659.     
  660.     On Error GoTo Swcwcl
  661.     
  662.     If Cxsjbrec.State = 1 Then Cxsjbrec.Close
  663.     Cxsjbrec.Open "select * from xt_grid where Grid_Code='" + Trim(Wggsdm) + "' order by ColId", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  664.     With Cxsjbrec
  665.         If Not .EOF Then
  666.             Qslzte = .Fields("BeginCol")
  667.             .MoveNext
  668.         End If
  669.         Do While Not .EOF
  670.             For Jsqte = Qslzte To Bcgsgrid.Cols - 1
  671.                 If Bcgsgrid.FixedRows = 1 Then
  672.                     If Trim(.Fields("ColTitle1")) = Trim(Bcgsgrid.TextMatrix(0, Jsqte)) Then
  673.                         Exit For
  674.                     End If
  675.                 Else
  676.                     If Trim(.Fields("ColTitle1")) = Trim(Bcgsgrid.TextMatrix(0, Jsqte)) And Trim(.Fields("ColTitle2")) = Trim(Bcgsgrid.TextMatrix(1, Jsqte)) Then
  677.                         Exit For
  678.                     End If
  679.                 End If
  680.             Next Jsqte
  681.             If Jsqte <= Bcgsgrid.Cols - 1 Then
  682.                 .Fields("ColId") = Jsqte - Qslzte + 1
  683.                 .Fields("ColWidth") = Bcgsgrid.ColWidth(Jsqte)
  684.                 .Update
  685.             Else
  686.                 GoTo Swcwcl
  687.             End If
  688.             .MoveNext
  689.         Loop
  690.     End With
  691.     Cw_DataEnvi.DataConnect.CommitTrans
  692.     Tsxx = "表格格式保存完毕!"
  693.     Call Xtxxts(Tsxx, 0, 4)
  694.     Exit Sub
  695. Swcwcl:
  696.     Cw_DataEnvi.DataConnect.RollbackTrans
  697.     Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
  698.     Call Xtxxts(Tsxx, 0, 1)
  699.     Exit Sub
  700. End Sub
  701. Private Sub Hfmrgs1(Bcgsgrid, Wggsdm As String)             '恢复网格默认列宽
  702.   
  703.     '过程参数:保存格式网格对象,网格格式代码(网格参数)
  704.     Dim Cxsjbrec As New ADODB.Recordset   '查询数据表动态集
  705.     Dim Qslzte As Integer
  706.     Dim Tsxx As String
  707.     Cw_DataEnvi.DataConnect.BeginTrans
  708.     If Cxsjbrec.State = 1 Then Cxsjbrec.Close
  709.     Cxsjbrec.Open "select * from xt_grid where Grid_Code='" + Trim(Wggsdm) + "' order by ColId", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  710.     
  711.     On Error GoTo Swcwcl
  712.     
  713.     With Cxsjbrec
  714.         If Not .EOF Then
  715.             Qslzte = .Fields("BeginCol")
  716.             .MoveNext
  717.         End If
  718.         Do While Not .EOF
  719.             For Jsqte = Qslzte To Bcgsgrid.Cols - 1
  720.                 If Bcgsgrid.FixedRows = 1 Then
  721.                     If Trim(.Fields("ColTitle1")) = Trim(Bcgsgrid.TextMatrix(0, Jsqte)) Then
  722.                         Exit For
  723.                     End If
  724.                 Else
  725.                     If Trim(.Fields("ColTitle1")) = Trim(Bcgsgrid.TextMatrix(0, Jsqte)) And Trim(.Fields("ColTitle2")) = Trim(Bcgsgrid.TextMatrix(1, Jsqte)) Then
  726.                         Exit For
  727.                     End If
  728.                 End If
  729.             Next Jsqte
  730.             If Jsqte <= Bcgsgrid.Cols - 1 Then
  731.                 Bcgsgrid.ColWidth(Jsqte) = .Fields("DefaultColWidth")
  732.                 .Fields("ColWidth") = .Fields("DefaultColWidth") + 0
  733.                 .Update
  734.             End If
  735.             .MoveNext
  736.         Loop
  737.     End With
  738.     Cw_DataEnvi.DataConnect.CommitTrans
  739.     Exit Sub
  740. Swcwcl:
  741.     Cw_DataEnvi.DataConnect.RollbackTrans
  742.     Tsxx = "恢复过程中出现未知错误,程序自动恢复保存前状态!"
  743.     Call Xtxxts(Tsxx, 0, 1)
  744.     Exit Sub
  745. End Sub