企业管理

开发平台：
Visual Basic

：源码内容
							VERSION 5.00
Object = "{BEEECC20-4D5F-4F8B-BFDC-5D9B6FBDE09D}#1.0#0"; "vsflex8.ocx"
Begin VB.Form XT_BgxsxmszFrm 
   Caption         =   "表格显示项目设置"
   ClientHeight    =   4680
   ClientLeft      =   3675
   ClientTop       =   2160
   ClientWidth     =   4515
   Icon            =   "系统_网格显示项目定义.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4680
   ScaleWidth      =   4515
   Begin VSFlex8Ctl.VSFlexGrid XmxzGrid 
      Height          =   4290
      Left            =   0
      TabIndex        =   2
      Top             =   0
      Width           =   4440
      _cx             =   7832
      _cy             =   7567
      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.CommandButton QdCommand 
      Caption         =   "确定(&O)"
      Height          =   300
      Left            =   2070
      TabIndex        =   0
      Top             =   4350
      Width           =   1120
   End
   Begin VB.CommandButton QxCommand 
      Cancel          =   -1  'True
      Caption         =   "取消(&C)"
      Height          =   300
      Left            =   3360
      TabIndex        =   1
      Top             =   4350
      Width           =   1120
   End
End
Attribute VB_Name = "XT_BgxsxmszFrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************
'*    模 块 名 称 :网格显示项目选择
'*    功 能 描 述 :用户可以根据需要选择哪些项目显示,哪些不显示
'*
'*                 参数:需要设置网格代码,通过Xtcdcs全局变量传入
'*
'*    程序员姓名  :张建忠
'*    最后修改人  :张建忠
'*    最后修改时间:2001/06/21
'*    备        注:封版
'****************************************************************
Dim Xsxmrec As New ADODB.Recordset       '网格显示参数动态集
Dim Szwgdm As String                     '设置网格网格代码
'以下为固定使用变量
Dim Cxnrrec As New ADODB.Recordset       '显示查询内容动态集
Dim Dyymctbl As New DY_Dyymsz            '打印页面窗体变量
Dim GridCode As String                   '显示网格网格代码
Dim GridInf() As Variant                 '整个网格设置信息
Dim Szbbzbt As String                    '报表主标题
Dim Tsxx As String                       '系统提示信息
Dim Sfxshjwg As Boolean                  '是否显示合计网格
Dim Qslz As Long                         '网格隐藏(非操作显示)列数
Dim Sjhgd As Double                      '网格数据行高度
Dim GridBoolean() As Boolean             '网格列信息(布尔型)
Dim GridStr()  As String                 '网格列信息(字符型)
Dim GridInt() As Integer                 '网格列信息(整型)
Dim Shsfts As Boolean                    '删除记录行是否提示
Dim Szzls As Integer                     '数组总列数(网格列数-1)
Private Sub Form_Load()
  
    '读入需要设置网格代码
    Szwgdm = Xtcdcs
    '调 入 网 格
    GridCode = "wgxsxm"
    Call BzWgcsh(XmxzGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
      
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Shsfts = GridInf(6)
    Sfxshjwg = GridInf(7)
    Szzls = XmxzGrid.Cols - 1
  
    '初 始 化 网 格
    Call Cshwg
  
End Sub
Private Sub Cshwg()                                        '初 始 化 网 格
    
    If Xsxmrec.State = 1 Then Xsxmrec.Close
    Xsxmrec.Open "select * from xt_grid where Grid_Code='" + Szwgdm + "' and ColId>=1 order by ColId", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    With Xsxmrec
        XmxzGrid.Rows = XmxzGrid.FixedRows + .RecordCount
        jsqte = XmxzGrid.FixedRows
        Do While Not .EOF
            If jsqte > XmxzGrid.Rows Then
                XmxzGrid.AddItem ""
            End If
            XmxzGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("ColTitle1") & "")
            XmxzGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("ColTitle2") & "")
            If Not .Fields("ColHidden") Then
                XmxzGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = "√"
            End If
            If Val("" & .Fields("NotAllowEmpty_Type")) <> 0 Then
                XmxzGrid.TextMatrix(jsqte, Sydz("004", GridStr(), Szzls)) = "√"
            End If
            jsqte = jsqte + 1
            .MoveNext
        Loop
    End With
End Sub
Private Sub XmxzGrid_DblClick()                            '选 择 显 示 项 目(双击网格)
    
    With XmxzGrid
        If XmxzGrid.TextMatrix(.Row, Sydz("003", GridStr(), Szzls)) = "√" And XmxzGrid.TextMatrix(.Row, Sydz("004", GridStr(), Szzls)) <> "√" Then
            XmxzGrid.TextMatrix(.Row, Sydz("003", GridStr(), Szzls)) = ""
        Else
            XmxzGrid.TextMatrix(.Row, Sydz("003", GridStr(), Szzls)) = "√"
        End If
    End With
End Sub
Private Sub QdCommand_Click()                              '确 定
    
    Dim Lng_ItemCount As Long           '显示项目计数器
    With XmxzGrid
        '判断用户选择项目个数是否为零
        Lng_ItemCount = 0
        For jsqte = .FixedRows To .Rows - 1
            If XmxzGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = "√" Then
                Lng_ItemCount = Lng_ItemCount + 1
            End If
        Next jsqte
        If Lng_ItemCount = 0 Then
            Tsxx = "网格显示项目个数不能为0!"
            Call Xtxxts(Tsxx, 0, 4)
            Exit Sub
        End If
   
        '将用户选择设置存盘
        Cw_DataEnvi.DataConnect.BeginTrans
        Xsxmrec.MoveFirst
        For jsqte = .FixedRows To .Rows - 1
            If XmxzGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = "√" Then
                Xsxmrec.Fields("ColHidden") = 0
            Else
                Xsxmrec.Fields("ColHidden") = 1
            End If
            Xsxmrec.Update
            Xsxmrec.MoveNext
        Next jsqte
    End With
    Cw_DataEnvi.DataConnect.CommitTrans
    Unload Me
End Sub
Private Sub QxCommand_Click()                              '取 消
    Unload Me
End Sub
Private Sub XmxzGrid_KeyPress(KeyAscii As Integer)         '用户按空格键(焦点在网格上)
    
    If KeyAscii = vbKeyReturn Then
        XmxzGrid.TextMatrix(XmxzGrid.Row, Sydz("003", GridStr(), Szzls)) = "√"
    End If
    If Chr(KeyAscii) = " " Then
        Call XmxzGrid_DblClick
    End If
End Sub

						