上传用户: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      =   3420
  8.    ClientTop       =   1680
  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            =   0
  20.       TabIndex        =   8
  21.       Top             =   525
  22.       Width           =   6390
  23.       _cx             =   11271
  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.     Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  351.     With Cxnrrec
  352.         If .EOF And .BOF Then
  353.             Exit Sub
  354.         Else
  355.             .MoveLast
  356.             CzxsGrid.Rows = CzxsGrid.FixedRows
  357.             CzxsGrid.Rows = .RecordCount + CzxsGrid.FixedRows
  358.             .MoveFirst
  359.         End If
  360.         jsqte = CzxsGrid.FixedRows
  361.         Do While Not .EOF
  362.             If jsqte >= CzxsGrid.Rows Then
  363.                 CzxsGrid.AddItem ""
  364.             End If
  365.             For Coljsq = Qslz To CzxsGrid.Cols - 1
  366.                 If GridBoolean(Coljsq, 6) Then
  367.                     If .Fields(GridStr(Coljsq, 4)) Then
  368.                         CzxsGrid.TextMatrix(jsqte, Sydz(GridStr(Coljsq, 1), GridStr(), Szzls)) = True
  369.                     End If
  370.                 Else
  371.                     CzxsGrid.TextMatrix(jsqte, Sydz(GridStr(Coljsq, 1), GridStr(), Szzls)) = Trim(.Fields(GridStr(Coljsq, 4)) & "")
  372.                 End If
  373.             Next Coljsq
  374.             CzxsGrid.RowHeight(jsqte) = Sjhgd
  375.             .MoveNext
  376.             jsqte = jsqte + 1
  377.         Loop
  378.     End With
  379. End Sub
  380. Private Sub CzxsGrid_Click()                           '单击网格固定行某列按此列排序(字符型)
  381.     With CzxsGrid
  382.         If .MouseRow <= .FixedRows - 1 And .MouseCol > 0 Then
  383.             .Col = .MouseCol
  384.             .Sort = flexSortStringAscending
  385.         End If
  386.     End With
  387. End Sub
  388. Private Sub CzxsGrid_DblClick()                        '用户双击网格返回当前选中编码
  389.     Call Fhxzbm
  390. End Sub
  391. Private Sub Form_Unload(Cancel As Integer)             '退出
  392.     Set Cxnrrec = Nothing
  393. End Sub
  394. Private Sub Gridsz_Click(Index As Integer)
  395.     
  396.     Select Case Index
  397.         Case 0                                   '保存表格格式
  398.             Call Bcwggs1(CzxsGrid, GridCode)
  399.         Case 1                                   '恢复默认格式
  400.             Call Hfmrgs1(CzxsGrid, GridCode)
  401.     End Select
  402. End Sub
  403. Private Sub QdCommand_Click()                          '确 定
  404.     Call Fhxzbm
  405. End Sub
  406. Private Sub QxCommand_Click()                          '取 消
  407.     
  408.     Xtfhcs = ""
  409.     Xtfhcsfz = ""
  410.     Unload Me
  411. End Sub
  412. Private Sub Bjcommand_Click()                          '调入编码编辑窗体
  413.     
  414.     Call Drbmbj(Bmczdmte)
  415.     Call bmtcwg
  416. End Sub
  417. Private Sub Fhxzbm()                                   '返回用户选中编码并退出
  418.   
  419.     With CzxsGrid
  420.         If .Row >= .FixedRows Then
  421.             Xtfhcs = Trim(.TextMatrix(.Row, Sydz(Bmzdsyh, GridStr(), Szzls)))
  422.             Xtfhcsfz = Trim(.TextMatrix(.Row, Sydz(Mczdsyh, GridStr(), Szzls)))
  423.         Else
  424.             Xtfhcs = ""
  425.             Xtfhcsfz = ""
  426.         End If
  427.     End With
  428.     Unload Me
  429. End Sub
  430. Private Sub Drbmczsx()                                 '读入编码参照表属性
  431.     
  432.     Dim Tyhelprec As New ADODB.Recordset                '帮助编码动态集
  433.     Sqlstr = "select * from xt_tyhelp where help_code='" + Bmczdmte + "'"
  434.     Set Tyhelprec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  435.     With Tyhelprec
  436.         If Not .EOF Then
  437.             GridCode = Trim(.Fields("grid_code"))
  438.             Sqlstr = Trim(.Fields("sql_string"))
  439.             Bmzdsyh = Trim(.Fields("code_field"))
  440.             Mczdsyh = Trim(.Fields("name_field"))
  441.             If .Fields("edit_enable") Then
  442.                 Bjcommand.Enabled = True
  443.             Else
  444.                 Bjcommand.Enabled = False
  445.             End If
  446.             Me.Caption = Trim(.Fields("help_name"))
  447.         End If
  448.     End With
  449. End Sub
  450. Private Sub Sub_ShowGrid(Xsgrid, Wgdmte As String, GridInf() As Variant, GridBoolean() As Boolean, GridInt() As Integer, GridStr() As String)           '标准网格初始化模块
  451.   
  452.     '过程参数为:生成网格对象名称(微软),网格参数编码,返回网格设置信息(返回整体信息)
  453.     '网格列属性(返回布尔型信息),网格列属性(返回整型信息),网格列属性(返回字符型信息)
  454.     
  455.     Dim wglbt() As String                      '网格显示列标题
  456.     Dim Wgxsls As Long                         '网格显示(主操作)列数
  457.     Dim gdls As Long                           '网格固定列数
  458.     Dim Gdhs As Long                           '网格固定行数(标题行数)
  459.     Dim Gdhgd As Double                        '网格固定行高度
  460.     Dim wglkd() As Double                      '每列默认字符个数
  461.     Dim wglzz() As Integer                     '网格列组织形式
  462.     Dim zdxsgs() As String                     '数值字段显示格式
  463.     Dim Sfhide() As Boolean                    '网格列是否隐藏
  464.     Dim Sfhxz As Boolean                       '网格列是否行选中
  465.     Dim Qslz As Long                           '网格隐藏(非操作显示)列数
  466.     Dim Sjhgd As Double                        '网格数据行高度
  467.     Dim Wglsfkydpx As Integer                  '网格列是否可移动及排序
  468.     Dim wgxsrec As New ADODB.Recordset         '网格显示动态集
  469.     
  470.     ReDim GridInf(1 To 7)                       '整个网格设置信息
  471.     Set wgxsrec = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM xt_grid WHERE Grid_Code ='" + Wgdmte + "' ORDER BY ColId")
  472.     With wgxsrec
  473.         If .EOF And .BOF Then
  474.             Exit Sub
  475.         Else
  476.             .MoveFirst
  477.         End If
  478.      
  479.         Qslz = .Fields("BeginCol")                '网格隐藏(非操作显示)列数
  480.         Sjhgd = .Fields("DataRowHeight")          '网格数据行高度
  481.          
  482.         GridInf(1) = Qslz                         '起始列值
  483.         GridInf(2) = Sjhgd                        '数据行高度
  484.         GridInf(3) = .Fields("KeepDataRows")      '屏幕保持数据行数
  485.         GridInf(4) = .Fields("AssistantRows")     '辅助项网格行数(例如:合计行)
  486.         If .Fields("SaveHelpWidth_Flag") Then     '是否保留帮助宽度(字段提供帮助时,是否为按钮保留空间)
  487.             GridInf(5) = True
  488.         Else
  489.             GridInf(5) = False
  490.         End If
  491.         If .Fields("DeleteRowAsk_Flag") Then      '删除有效记录行是否提示
  492.             GridInf(6) = True
  493.         Else
  494.             GridInf(6) = False
  495.         End If
  496.         If .Fields("ShowSumGrid_Flag") Then       '是否显示合计网格
  497.             GridInf(7) = True
  498.         Else
  499.             GridInf(7) = False
  500.         End If
  501.            
  502.         Wgxsls = .RecordCount - 1                 '网格显示(主操作)列数(原.Fields("wgxsls"))
  503.         gdls = .Fields("FixCols")                 '网格固定列数
  504.         Gdhs = .Fields("FixRows")                 '网格固定行数(标题行数)
  505.         Gdhgd = .Fields("FixRowHeight")           '网格固定行高度
  506.         Wglsfkydpx = .Fields("explorerbar")       '网格列是否可移动及排序
  507.         
  508.         If .Fields("SelectRow_Flag") Then         '是否行选中
  509.             Sfhxz = True
  510.         End If
  511.         
  512.         ReDim wglbt(Gdhs - 1, Wgxsls + Qslz - 1)  '网格显示列标题
  513.         ReDim wglkd(Qslz + Wgxsls - 1)            '每列默认字符个数
  514.         ReDim zdxsgs(Qslz + Wgxsls - 1)           '数值字段标志
  515.         ReDim wglzz(Qslz + Wgxsls - 1)            '网格列组织形式
  516.         ReDim Sfhide(Qslz + Wgxsls - 1)           '网格列是否显示
  517.         ReDim GridBoolean(Qslz + Wgxsls - 1, 1 To 6)   '网格列属性(布尔型)
  518.         ReDim GridStr(Qslz + Wgxsls - 1, 1 To 20)      '网格列信息(字符型)
  519.         ReDim GridInt(Qslz + Wgxsls - 1, 1 To 7)       '网格列信息(整型)
  520.         
  521.         .MoveNext
  522.         jsqte = 0
  523.         Do While Not .EOF
  524.         
  525.             wglkd(Qslz + jsqte) = .Fields("ColWidth")                  '网格列宽度限制
  526.             If Not IsNull(.Fields("ColTitle1")) Then
  527.                 wglbt(0, Qslz + jsqte) = Trim(.Fields("ColTitle1"))    '网格列标题1
  528.             End If
  529.             If Not IsNull(.Fields("ColTitle2")) And Gdhs = 2 Then      '网格列标题2
  530.                 wglbt(1, Qslz + jsqte) = Trim(.Fields("ColTitle2"))
  531.             End If
  532.          
  533.             If .Fields("ColFormat") Then                               '字段显示格式(千分符)
  534.                 If .Fields("Text_Int_Length") <> 0 Then
  535.                     zdxsgs(Qslz + jsqte) = "#,##0." + String(.Fields("Text_deci_Length"), "0")
  536.                 Else
  537.                     zdxsgs(Qslz + jsqte) = "#,##0.00"
  538.                 End If
  539.                 Select Case .Fields("Text_Data_Type")
  540.                     Case 8, 11  '金额
  541.                         zdxsgs(Qslz + jsqte) = "#,##0." + String(Xtjexsws, "0")
  542.                     Case 9, 12  '数量
  543.                         zdxsgs(Qslz + jsqte) = "#,##0." + String(Xtslxsws, "0")
  544.                     Case 10     '单价
  545.                         zdxsgs(Qslz + jsqte) = "#,##0." + String(Xtdjxsws, "0")
  546.                 End Select
  547.             Else
  548.                 If .Fields("Text_Int_Length") <> 0 Then
  549.                     zdxsgs(Qslz + jsqte) = "##0." + String(.Fields("Text_deci_Length"), "0")
  550.                 End If
  551.             End If
  552.     
  553.             wglzz(Qslz + jsqte) = .Fields("ColAlignment")              '网格列组织形式
  554.             If .Fields("ColHidden") Then                               '网格列是否隐藏
  555.                 Sfhide(Qslz + jsqte) = True
  556.             End If
  557.             If .Fields("Edit_Flag") Then                               '网格列是否可编辑
  558.                 GridBoolean(Qslz + jsqte, 1) = True
  559.             End If
  560.             If .Fields("Help_Flag") Then                               '网格列是否提供帮助
  561.                 GridBoolean(Qslz + jsqte, 2) = True
  562.             End If
  563.             If .Fields("Combo_Flag") Then                              '网格列是否列表框录入
  564.                 GridBoolean(Qslz + jsqte, 3) = True
  565.             End If
  566.             If .Fields("ColSum_Flag") Then                             '网格列是否合计
  567.                 GridBoolean(Qslz + jsqte, 4) = True
  568.             End If
  569.             If .Fields("Zero_Empty_Flag") Then                         '网格内容为零是否清空
  570.                 GridBoolean(Qslz + jsqte, 5) = True
  571.             End If
  572.             If .Fields("BooleanFlag") Then                             '网格列是否为布尔型
  573.                 GridBoolean(Qslz + jsqte, 6) = True
  574.             End If
  575.         
  576.             If Not IsNull(.Fields("Text_Data_Type")) Then              '字段数据类型
  577.                 GridInt(Qslz + jsqte, 1) = .Fields("Text_Data_Type")
  578.             End If
  579.             If Not IsNull(.Fields("Text_Length")) Then                 '字段录入长度
  580.                 GridInt(Qslz + jsqte, 2) = .Fields("Text_Length")
  581.             End If
  582.             If Not IsNull(.Fields("Text_Int_Length")) Then             '字段整数位长度
  583.                 GridInt(Qslz + jsqte, 3) = .Fields("Text_Int_Length")
  584.             End If
  585.             If Not IsNull(.Fields("Text_Deci_Length")) Then            '字段小数位长度
  586.                 GridInt(Qslz + jsqte, 4) = .Fields("Text_Deci_Length")
  587.             End If
  588.             If Not IsNull(.Fields("NotAllowEmpty_Type")) Then          '字段不允许为空或为零
  589.                 GridInt(Qslz + jsqte, 5) = .Fields("NotAllowEmpty_Type")
  590.             End If
  591.             If Not IsNull(.Fields("Help_Type")) Then                   '帮助类型
  592.                 GridInt(Qslz + jsqte, 6) = .Fields("Help_Type")
  593.             End If
  594.             If Not IsNull(.Fields("HelpReturnValue")) Then             '帮助返回值(0-显示返回编码 1-显示返回名称)
  595.                 GridInt(Qslz + jsqte, 7) = .Fields("HelpReturnValue")
  596.             End If
  597.         
  598.             GridStr(Qslz + jsqte, 1) = Trim(.Fields("ColIndex") & "")    '网格列索引值
  599.         
  600.             GridStr(Qslz + jsqte, 2) = Trim(.Fields("EmptyMessage") & "") '字段为空提示信息
  601.         
  602.             GridStr(Qslz + jsqte, 3) = Trim(.Fields("Help_Code") & "")    '通用帮助编码
  603.         
  604.             GridStr(Qslz + jsqte, 4) = Trim(.Fields("FieldsName") & "")   '连接字段(通用帮助)
  605.         
  606.             GridStr(Qslz + jsqte, 5) = Trim(.Fields("Combo_Code") & "")   '列表框编码
  607.            
  608.             .MoveNext
  609.             jsqte = jsqte + 1
  610.         Loop
  611.     End With
  612.    
  613.     '网格列组织形式
  614.    
  615.     With Xsgrid
  616.         .BackColorFixed = &H8000000F                                     '固定行背景色 ('&H80000018)
  617.         .FixedRows = Gdhs                                                '固定行数
  618.         .Rows = Gdhs
  619.         .FixedCols = gdls                                                '固定列数
  620.         .Cols = Qslz + Wgxsls
  621.         .AllowUserResizing = flexResizeBoth
  622.         .SelectionMode = flexSelectionByRow
  623.         .WordWrap = True
  624.         
  625.         '填 充 网 格 标 题
  626.         For Rowjsq = 0 To .FixedRows - 1
  627.             .MergeRow(Rowjsq) = True
  628.             .RowHeight(Rowjsq) = Gdhgd
  629.             For Coljsq = Qslzte To .Cols - 1
  630.                 .TextMatrix(Rowjsq, Coljsq) = wglbt(Rowjsq, Coljsq)
  631.             Next Coljsq
  632.         Next Rowjsq
  633.         
  634.         '数 据 网 格 高 度
  635.         For Rowjsq = .FixedRows To .Rows - 1
  636.             .RowHeight(Rowjsq) = Sjhgd
  637.         Next Rowjsq
  638.      
  639.         '定 义 录 入 字 段 属 性
  640.         For Coljsq = 0 To .Cols - 1
  641.             .ColWidth(Coljsq) = wglkd(Coljsq)
  642.             .ColAlignment(Coljsq) = wglzz(Coljsq)
  643.             .FixedAlignment(Coljsq) = 4
  644.             If GridBoolean(Coljsq, 6) Then
  645.                 .ColDataType(Coljsq) = flexDTBoolean
  646.             End If
  647.         Next Coljsq
  648.     End With
  649. End Sub
  650. Private Sub Bcwggs1(Bcgsgrid, Wggsdm As String)             '保存网格格式(包括网格列宽,网格列顺序)
  651.     
  652.     '过程参数:保存格式网格对象,网格格式代码(网格参数)
  653.     
  654.     Dim Cxsjbrec As New ADODB.Recordset
  655.     Dim Qslzte As Integer
  656.     Dim Tsxx As String
  657.     Cw_DataEnvi.DataConnect.BeginTrans
  658.     
  659.     On Error GoTo Swcwcl
  660.     
  661.     If Cxsjbrec.State = 1 Then Cxsjbrec.Close
  662.     Cxsjbrec.Open "select * from xt_grid where Grid_Code='" + Trim(Wggsdm) + "' order by ColId", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  663.     With Cxsjbrec
  664.         If Not .EOF Then
  665.             Qslzte = .Fields("BeginCol")
  666.             .MoveNext
  667.         End If
  668.         Do While Not .EOF
  669.             For jsqte = Qslzte To Bcgsgrid.Cols - 1
  670.                 If Bcgsgrid.FixedRows = 1 Then
  671.                     If Trim(.Fields("ColTitle1")) = Trim(Bcgsgrid.TextMatrix(0, jsqte)) Then
  672.                         Exit For
  673.                     End If
  674.                 Else
  675.                     If Trim(.Fields("ColTitle1")) = Trim(Bcgsgrid.TextMatrix(0, jsqte)) And Trim(.Fields("ColTitle2")) = Trim(Bcgsgrid.TextMatrix(1, jsqte)) Then
  676.                         Exit For
  677.                     End If
  678.                 End If
  679.             Next jsqte
  680.             If jsqte <= Bcgsgrid.Cols - 1 Then
  681.                 .Fields("ColId") = jsqte - Qslzte + 1
  682.                 .Fields("ColWidth") = Bcgsgrid.ColWidth(jsqte)
  683.                 .Update
  684.             Else
  685.                 GoTo Swcwcl
  686.             End If
  687.             .MoveNext
  688.         Loop
  689.     End With
  690.     Cw_DataEnvi.DataConnect.CommitTrans
  691.     Tsxx = "表格格式保存完毕!"
  692.     Call Xtxxts(Tsxx, 0, 4)
  693.     Exit Sub
  694. Swcwcl:
  695.     Cw_DataEnvi.DataConnect.RollbackTrans
  696.     Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
  697.     Call Xtxxts(Tsxx, 0, 1)
  698.     Exit Sub
  699. End Sub
  700. Private Sub Hfmrgs1(Bcgsgrid, Wggsdm As String)             '恢复网格默认列宽
  701.   
  702.     '过程参数:保存格式网格对象,网格格式代码(网格参数)
  703.     Dim Cxsjbrec As New ADODB.Recordset   '查询数据表动态集
  704.     Dim Qslzte As Integer
  705.     Dim Tsxx As String
  706.     Cw_DataEnvi.DataConnect.BeginTrans
  707.     If Cxsjbrec.State = 1 Then Cxsjbrec.Close
  708.     Cxsjbrec.Open "select * from xt_grid where Grid_Code='" + Trim(Wggsdm) + "' order by ColId", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  709.     
  710.     On Error GoTo Swcwcl
  711.     
  712.     With Cxsjbrec
  713.         If Not .EOF Then
  714.             Qslzte = .Fields("BeginCol")
  715.             .MoveNext
  716.         End If
  717.         Do While Not .EOF
  718.             For jsqte = Qslzte To Bcgsgrid.Cols - 1
  719.                 If Bcgsgrid.FixedRows = 1 Then
  720.                     If Trim(.Fields("ColTitle1")) = Trim(Bcgsgrid.TextMatrix(0, jsqte)) Then
  721.                         Exit For
  722.                     End If
  723.                 Else
  724.                     If Trim(.Fields("ColTitle1")) = Trim(Bcgsgrid.TextMatrix(0, jsqte)) And Trim(.Fields("ColTitle2")) = Trim(Bcgsgrid.TextMatrix(1, jsqte)) Then
  725.                         Exit For
  726.                     End If
  727.                 End If
  728.             Next jsqte
  729.             If jsqte <= Bcgsgrid.Cols - 1 Then
  730.                 Bcgsgrid.ColWidth(jsqte) = .Fields("DefaultColWidth")
  731.                 .Fields("ColWidth") = .Fields("DefaultColWidth") + 0
  732.                 .Update
  733.             End If
  734.             .MoveNext
  735.         Loop
  736.     End With
  737.     Cw_DataEnvi.DataConnect.CommitTrans
  738.     Exit Sub
  739. Swcwcl:
  740.     Cw_DataEnvi.DataConnect.RollbackTrans
  741.     Tsxx = "恢复过程中出现未知错误,程序自动恢复保存前状态!"
  742.     Call Xtxxts(Tsxx, 0, 1)
  743.     Exit Sub
  744. End Sub