企业管理

开发平台：
Visual Basic

+：源码内容
							VERSION 5.00
Object = "{D76D7128-4A96-11D3-BD95-D296DC2DD072}#1.0#0"; "VSOCX7.OCX"
Begin VB.Form Set_PmItemFrm 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "工资系统可查阅的人事项目"
   ClientHeight    =   4695
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3495
   Icon            =   "设置_工资可查阅项目.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4695
   ScaleWidth      =   3495
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton Cmd_All 
      Caption         =   "全选(&A)"
      Height          =   300
      Left            =   1140
      TabIndex        =   4
      Top             =   3960
      Width           =   1120
   End
   Begin VB.CommandButton Cmd_Cancel 
      Caption         =   "取消(&C)"
      Height          =   300
      Left            =   2315
      TabIndex        =   3
      Top             =   4320
      Width           =   1120
   End
   Begin VB.CommandButton Cmd_Save 
      Caption         =   "保存(&S)"
      Height          =   300
      Left            =   1140
      TabIndex        =   2
      Top             =   4320
      Width           =   1120
   End
   Begin VB.CommandButton Cmd_Qing 
      Caption         =   "全清(&Q)"
      Height          =   300
      Left            =   2310
      TabIndex        =   1
      Top             =   3960
      Width           =   1120
   End
   Begin VSFlex8Ctl.VSFlexGrid CzxsGrid 
      Height          =   3825
      Left            =   30
      TabIndex        =   0
      Top             =   0
      Width           =   3405
      _ExtentX        =   6006
      _ExtentY        =   6747
      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
      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   'False
      ShowComboButton =   -1  'True
      WordWrap        =   0   'False
      TextStyle       =   0
      TextStyleFixed  =   0
      OleDragMode     =   0
      OleDropMode     =   0
      DataMode        =   0
      VirtualData     =   -1  'True
   End
End
Attribute VB_Name = "Set_PmItemFrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*******************************************************
'*    模 块 名 称 :显示项目设置
'*    功 能 描 述 :设置字段是否对工资和人事系统可见
'*    程序员姓名  :刘  刚
'*    最后修改人  :刘  刚
'*    最后修改时间:2001/11/30
'*    备        注:经过自己测试
'*******************************************************
Option Explicit
Dim Rec_CodeSet As New ADODB.Recordset   '编码设置表
Dim jdzygs As Integer                    '控件焦点转移个数
Dim Lrzt As Integer                      '录入状态标志(0-非录入状态 1-增加 2-修改)
Dim Rsc As New ADODB.Recordset
Dim Str_RightEdit As String              '编辑(新增、修改、删除)权限索引
Dim i As Long
'以下为固定使用变量(网格)
Dim Cxnrrec As New ADODB.Recordset       '显示查询内容动态集
Dim Dyymctbl As New DY_Dyymsz            '打印页面窗体变量
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 Cmd_All_Click()
    With CzxsGrid
        For i = .FixedRows To .Rows - 1
            .TextMatrix(i, Sydz("002", GridStr(), Szzls)) = 1
        Next
    End With
End Sub
Private Sub Cmd_Cancel_Click()
    Unload Me
End Sub
Private Sub Cmd_Qing_Click()
    '清空除工号和姓名以外的显示字段
    With CzxsGrid
        For i = .FixedRows To .Rows - 1
            If LCase(Trim(.TextMatrix(i, 0))) <> "empno" And _
               LCase(Trim(.TextMatrix(i, 0))) <> "empname" And _
               LCase(Trim(.TextMatrix(i, 0))) <> "deptcode" Then
                   .TextMatrix(i, Sydz("002", GridStr(), Szzls)) = 0
            End If
        Next
    End With
    
End Sub
Private Sub Cmd_Save_Click()
    Dim Sql As String
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
        Exit Sub
    End If
    Sql = ""
    With CzxsGrid
        For i = .FixedRows To .Rows - 1
            Select Case LCase(Trim(.TextMatrix(i, 0)))
                Case "empno"
                    If .TextMatrix(i, Sydz("002", GridStr(), Szzls)) = False Then
                        Call Xtxxts("工号必须被选中!", 0, 1)
                        Exit Sub
                    End If
                Case "empname"
                    If .TextMatrix(i, Sydz("002", GridStr(), Szzls)) = False Then
                        Call Xtxxts("姓名必须被选中!", 0, 1)
                        Exit Sub
                    End If
                Case "deptcode"
                    If .TextMatrix(i, Sydz("002", GridStr(), Szzls)) = False Then
                        Call Xtxxts("部门必须被选中!", 0, 1)
                        Exit Sub
                    End If
            End Select
            If .TextMatrix(i, Sydz("002", GridStr(), Szzls)) = True Then
                Sql = Sql & ",'" & .TextMatrix(i, 0) & "'"
            End If
        Next
    End With
    If Trim(Sql) <> "" Then
        Sql = Right(Trim(Sql), Len(Trim(Sql)) - 1)
        Sql = "update rs_Items set pm=0 " & _
          " update Rs_items set pm=1 where FieldName in ( " & Sql & " ) "
    End If
    On Error GoTo Err1
    With Cw_DataEnvi.DataConnect
        .BeginTrans
        If Trim(Sql) <> "" Then
            .Execute Sql
        End If
        .CommitTrans
    End With
    Call Xtxxts("保存成功!", 0, 4)
    Exit Sub
Err1:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Call Xtxxts("保存不成功!", 0, 1)
End Sub
Private Sub CzxsGrid_BeforeEdit(ByVal Row As Long, ByVal Col As Long, Cancel As Boolean)
    If Col <> Sydz("002", GridStr(), Szzls) Then
        Cancel = True
    Else
        Cancel = False
    End If
End Sub
Private Sub Form_Load()
    '调入网格设置信息
    GridCode = "rs_pmitem"
    Call BzWgcsh(CzxsGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Szzls = CzxsGrid.Cols - 1
    CzxsGrid.TextMatrix(0, 0) = "字段名"
    CzxsGrid.Editable = True
    
    '填 充 网 格
    Call Cxnrtcwg
    Str_RightEdit = "Rs_PmItem_Edit"
End Sub
Private Sub Cxnrtcwg()                               '查询内容填充网格
    Dim Sqlstr As String              '查询连接串
    Dim jsqte As Long                 '查询临时使用变量
  
    '为加快显示速度,将网格刷新动作冻结
    CzxsGrid.Redraw = False
  
    '[>>查询连接串
    Sqlstr = "SELECT * FROM Rs_Items  where Sid=1  order by ItemId"
    '<<]
    Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    With Cxnrrec
        CzxsGrid.Rows = CzxsGrid.FixedRows
        If .EOF And .BOF Then
            CzxsGrid.Redraw = True
            Exit Sub
        End If
        
        jsqte = CzxsGrid.FixedRows
        
        Do While Not .EOF
            CzxsGrid.AddItem ""
            Call Jltcwg(Cxnrrec, jsqte)                              '调入填充网格子过程
            CzxsGrid.RowHeight(jsqte) = Sjhgd                        '设置网格高度
            .MoveNext
            jsqte = jsqte + 1
        Loop
    End With
  
    '将网格刷新动作解冻
    CzxsGrid.Redraw = True
End Sub
Private Sub Jltcwg(Jlbrec As ADODB.Recordset, Rowjsq As Long)           '记录内容填充网格
    '[>>以下为自定义部分
    With Jlbrec
        CzxsGrid.TextMatrix(Rowjsq, 0) = .Fields("FieldName")
        CzxsGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("ChName") & "")            '项目名称
        CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = .Fields("Pm")        'Rs
    End With
    '以上为自定义部分<<]
End Sub

						