企业管理

开发平台：
Visual Basic

++：源码内容
							VERSION 5.00
Object = "{D76D7128-4A96-11D3-BD95-D296DC2DD072}#1.0#0"; "VSOCX7.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form Khgl_CheckQuery 
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "考核表查询"
   ClientHeight    =   6990
   ClientLeft      =   660
   ClientTop       =   1155
   ClientWidth     =   10860
   HelpContextID   =   2313001
   Icon            =   "考核表查询.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form4"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6990
   ScaleWidth      =   10860
   StartUpPosition =   1  '所有者中心
   Begin VB.PictureBox Pic_Title 
      BackColor       =   &H00FFFFFF&
      Height          =   765
      Left            =   60
      Picture         =   "考核表查询.frx":1042
      ScaleHeight     =   705
      ScaleWidth      =   10725
      TabIndex        =   7
      Top             =   570
      Width           =   10785
      Begin MSComctlLib.ImageCombo Imgcbo_Title 
         Height          =   315
         Left            =   1080
         TabIndex        =   8
         Top             =   180
         Width           =   3000
         _ExtentX        =   5292
         _ExtentY        =   556
         _Version        =   393216
         ForeColor       =   -2147483640
         BackColor       =   -2147483643
      End
      Begin VB.Label tsLabel 
         BackColor       =   &H80000018&
         BackStyle       =   0  'Transparent
         Caption         =   "考核类别:"
         ForeColor       =   &H00000000&
         Height          =   195
         Index           =   0
         Left            =   180
         TabIndex        =   9
         Top             =   240
         Width           =   855
      End
   End
   Begin VB.TextBox Ydtext 
      BackColor       =   &H00C0FFFF&
      BorderStyle     =   0  'None
      Height          =   300
      Left            =   8790
      MultiLine       =   -1  'True
      TabIndex        =   0
      Top             =   1440
      Visible         =   0   'False
      Width           =   1185
   End
   Begin VB.ComboBox YdCombo 
      Height          =   300
      Left            =   8790
      Style           =   2  'Dropdown List
      TabIndex        =   3
      Top             =   1830
      Visible         =   0   'False
      Width           =   1695
   End
   Begin VB.Timer Timer1 
      Interval        =   1
      Left            =   10020
      Top             =   1410
   End
   Begin VB.CommandButton Ydcommand 
      Height          =   300
      Left            =   10530
      Picture         =   "考核表查询.frx":1DF82
      Style           =   1  'Graphical
      TabIndex        =   1
      Top             =   1830
      Visible         =   0   'False
      Width           =   300
   End
   Begin VSFlex8Ctl.VSFlexGrid WglrGrid 
      Height          =   5505
      Left            =   60
      TabIndex        =   4
      Top             =   1380
      Width           =   8625
      _ExtentX        =   15214
      _ExtentY        =   9710
      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       =   16777215
      ForeColor       =   -2147483640
      BackColorFixed  =   12632256
      ForeColorFixed  =   -2147483630
      BackColorSel    =   -2147483635
      ForeColorSel    =   -2147483634
      BackColorBkg    =   -2147483636
      BackColorAlternate=   16777215
      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      =   1
      MergeCompare    =   0
      AutoResize      =   -1  'True
      AutoSizeMode    =   0
      AutoSearch      =   0
      MultiTotals     =   -1  'True
      SubtotalPosition=   1
      OutlineBar      =   0
      OutlineCol      =   0
      Ellipsis        =   1
      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
      Begin MSComctlLib.ImageList ImageList1 
         Left            =   9120
         Top             =   780
         _ExtentX        =   1005
         _ExtentY        =   1005
         BackColor       =   -2147483643
         ImageWidth      =   16
         ImageHeight     =   16
         MaskColor       =   12632256
         _Version        =   393216
         BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
            NumListImages   =   29
            BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":1E30C
               Key             =   "sz"
            EndProperty
            BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":1E6A6
               Key             =   "dy"
            EndProperty
            BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":1EA40
               Key             =   "yl"
            EndProperty
            BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":1EDDA
               Key             =   "xg"
            EndProperty
            BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":1F174
               Key             =   "zh"
            EndProperty
            BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":1F50E
               Key             =   "sh"
            EndProperty
            BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":1F8A8
               Key             =   "bc"
            EndProperty
            BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":1FC42
               Key             =   "fq"
            EndProperty
            BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":1FFDC
               Key             =   "bz"
            EndProperty
            BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":20376
               Key             =   "tc"
            EndProperty
            BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":20710
               Key             =   "bcgs"
            EndProperty
            BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":20AAA
               Key             =   "mrlk"
            EndProperty
            BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":20E44
               Key             =   "xsxm"
            EndProperty
            BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":211DE
               Key             =   "first"
            EndProperty
            BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":21578
               Key             =   "prev"
            EndProperty
            BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":21912
               Key             =   "next"
            EndProperty
            BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":21CAC
               Key             =   "last"
            EndProperty
            BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":22046
               Key             =   "xx"
            EndProperty
            BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":223E0
               Key             =   "define"
            EndProperty
            BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":2277A
               Key             =   "exec"
            EndProperty
            BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":22B14
               Key             =   "xz"
            EndProperty
            BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":22EAE
               Key             =   "sc"
            EndProperty
            BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":23248
               Key             =   "sx"
            EndProperty
            BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":235E2
               Key             =   "cx"
            EndProperty
            BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":2397C
               Key             =   "zd"
            EndProperty
            BeginProperty ListImage26 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":23D16
               Key             =   "dz"
            EndProperty
            BeginProperty ListImage27 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":240B0
               Key             =   "ph"
            EndProperty
            BeginProperty ListImage28 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":2444A
               Key             =   "fz"
            EndProperty
            BeginProperty ListImage29 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "考核表查询.frx":247E4
               Key             =   "dw"
            EndProperty
         EndProperty
      End
   End
   Begin MSComctlLib.Toolbar Tlb_Action 
      Align           =   1  'Align Top
      Height          =   570
      Left            =   0
      TabIndex        =   2
      Top             =   0
      Width           =   10860
      _ExtentX        =   19156
      _ExtentY        =   1005
      ButtonWidth     =   820
      ButtonHeight    =   953
      AllowCustomize  =   0   'False
      Wrappable       =   0   'False
      Appearance      =   1
      Style           =   1
      ImageList       =   "ImageList1"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   6
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "设置"
            Key             =   "ymsz"
            Object.ToolTipText     =   "打印页面设置"
            ImageKey        =   "sz"
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "打印"
            Key             =   "dy"
            Object.ToolTipText     =   "打印当前单据或Ctrl+P"
            ImageKey        =   "dy"
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "预览"
            Key             =   "yl"
            ImageKey        =   "yl"
         EndProperty
         BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "帮助"
            Key             =   "bz"
            ImageKey        =   "bz"
         EndProperty
         BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "退出"
            Key             =   "fh"
            ImageKey        =   "tc"
         EndProperty
      EndProperty
      BorderStyle     =   1
      Begin MSComctlLib.Toolbar GsToolbar 
         Height          =   540
         Left            =   9150
         TabIndex        =   6
         Top             =   0
         Width           =   1695
         _ExtentX        =   2990
         _ExtentY        =   953
         ButtonWidth     =   1455
         ButtonHeight    =   953
         AllowCustomize  =   0   'False
         Appearance      =   1
         Style           =   1
         ImageList       =   "ImageList1"
         _Version        =   393216
         BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
            NumButtons      =   2
            BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
               Caption         =   "保存格式"
               Key             =   "bcgs"
               ImageKey        =   "bcgs"
            EndProperty
            BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
               Caption         =   "默认列宽"
               Key             =   "hfmrgs"
               ImageKey        =   "mrlk"
            EndProperty
         EndProperty
      End
   End
   Begin VB.Label Lab_OperStatus 
      BackColor       =   &H000080FF&
      Caption         =   "1"
      Height          =   345
      Left            =   10500
      TabIndex        =   5
      Top             =   1440
      Visible         =   0   'False
      Width           =   345
   End
End
Attribute VB_Name = "Khgl_CheckQuery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'**************************************************************************************
'*    模 块 名 称 :考核表查询
'*    功 能 描 述 :
'*    程序员姓名  :张洪军
'*    最后修改人  :张洪军
'*    最后修改时间:2001/10/20
'*    备        注:程序中所有依实际情况自定义部分均用[>> <<]括起
'*
'*    1.每次调入外部功能窗体，均要加锁ChangeLock=True,窗体关闭后解锁ChangeLock=false
'*
'*    3.Lab_OperStatus 用此标签来标识单据录入状态(默认值为1) 1-浏览 2-修改
'*
'***************************************************************************************
 
'以下为自定义变量
Public str_TitleCode As String                  '考核类别编码
Dim strFactor()   As String                     '保存考核要素评价标准类型和评价标准编码
Dim sItem() As New CItemValue                   '保存标题头
Dim str_value As String                         '网格填充内容
Dim NullFlag As Boolean                         '网格是否有记录
 
'其它固定使用变量
Dim Tsxx As String                              '系统信息提示(Fixed)
Dim ReportTitle As String                       '报表主标题(Fixed)
   
'以下为固定使用变量(网格)
Dim Cxnrrec As New ADODB.Recordset              '显示查询内容动态集
Dim Dyymctbl As New DY_Dyymsz                   '打印页面窗体变量
Dim GridCode As String                          '显示网格网格代码
Dim GridInf() As Variant                        '整个网格设置信息
Dim Pmbcsjhs As Long                            '屏幕网格保持数据行数(大于等于1)
Dim Fzxwghs As Integer                          '辅助项网格行数(包括合计行)
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 Sfblbzkd As Boolean                         '是否保留帮助宽度(字段提供帮助时,是否为按钮保留空间)
Dim Dqlrwgh As Long                             '当前录入数据网格行
Dim Dqlrwgl As Long                             '当前录入数据网格列
Dim Dqlkwgh As Long                             '刚刚离开网格行(不一定为录入行)
Dim Dqlkwgl As Long                             '刚刚离开网格列
Dim Dqtoprow As Long                            '当前录入状态时最上端可视行
Dim Dqleftcol As Long                           '当前录入状态时最左端可视列
Dim Zdlrqnr As String                           '字段录入修改前内容(用来判断内容是否修改)
Dim Wbkbhlock As Boolean                        '文本框改变值锁
Dim Changelock As Boolean                       '网格行列改变控制锁(用来区别用户改变.程序改变)
Dim Gdtlock As Boolean                          '滚动条滚动控制(用来区别用户改变.程序改变)
Dim Yxxpdlock As Boolean                        '字段有效性判断锁(内容不修改不需进行字段有效性判断)
Dim Hyxxpdlock As Boolean                       '行有效性判断锁(字段内容不修改不需进行行有效性判断)
Dim Valilock As Boolean                         '文本框失去焦点是否进行有效性控制(TRUE 为锁定*限用网格录入)
Dim Shsfts As Boolean                           '删除记录行是否提示
Dim Szzls As Integer                            '网格信息数组最大下标值(网格列数-1)
Private Sub Form_Load()                              '窗 体 装 入
  
    '初始化各种锁值(Fixed)
    Changelock = False             '网格行列改变控制锁
    Gdtlock = False                '滚动条滚动控制
    Yxxpdlock = True               '字段有效性判断锁
    Hyxxpdlock = True              '行有效性判断锁
    Wbkbhlock = False              '文本框内容改变锁
     
    '报表主标题及报表编码(Fixed)
    ReportTitle = "考核表查询"
    XtReportCode = "Khgl_CheckQuery"
    Load Dyymctbl
    
    '填充考核类别列表框
    Call AddTitleCode
    
    
    '调 入 网 格(Fixed)
    GridCode = "Khgl_CheckQuery"      '网格属性编码
    Call BzWgcsh(WglrGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
    
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Pmbcsjhs = GridInf(3)
    Fzxwghs = GridInf(4)
    Sfblbzkd = GridInf(5)
    Shsfts = GridInf(6)
    Sfxshjwg = GridInf(7)
    Szzls = WglrGrid.Cols - 1
    
    '设置标题栏宽度、网格宽度高度(Fixed)
    Pic_Title.Move 50, Pic_Title.Top, Me.Width - 150, Pic_Title.Height
    WglrGrid.Move 50, Pic_Title.Top + Pic_Title.Height, Me.Width - 150
    WglrGrid.Height = Me.Height - WglrGrid.Top - 380
    
    '<<以下自定义
    
    '网格不合并
    WglrGrid.MergeCells = flexMergeNever
    
    '填充固定列数据，即考核要素编码、考核指标、考核要素
    
    '生成查询结果
    Call Sub_Query
    
    '设置网格
    ShowRecord
    
    '生成查询结果，填充评价标准
    
    Call Sub_QuerySub
    WglrGrid.AutoSizeMode = flexAutoSizeRowHeight
    
    '>>以上自定义
     
    
    '设置状态为修改状态
    Lab_OperStatus = "2"
 
End Sub
Private Sub Form_Unload(Cancel As Integer)           '窗体卸载
    '卸载打印页面窗体
    Unload Dyymctbl
End Sub
Private Sub Sub_Query()                              '生成查询结果，填充固定列值
    Dim Sqlstr As String                           '临时使用字符串
    Dim RecTemp As New ADODB.Recordset             '临时使用动态集
    Dim Jsqte, jsqteh, jsqtel As Long              '临时计数器
    Dim str_titleRoot As String                    '考核类别根结点编码
    '禁止网格刷新动作,为加快网格显示速度(Fixed)
    WglrGrid.Redraw = False
    NullFlag = True
    
    '取考核类别编码方案
    Sqlstr = "select * from Gy_CodeScheme where ItemCode='" & Trim("Khgl_Title") & "'"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    '取考核类别编码的根结点编码
    str_titleRoot = Mid(str_TitleCode, 1, Mid(RecTemp.Fields("CodeScheme"), 1, 1))
    RecTemp.Close
    '本张单据查询字符串,填充考核要素编码、考核指标、考核要素名称
    Sqlstr = " SELECT FactorCode,FactorName,CheckName,AppraiseType,AppraiseCode,TargetWeigh,FactorWeigh " & _
             " FROM Kh_v_ValMark where TitleCode='" & str_titleRoot & "'" & _
             " Order By ValMarkID"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
      
    With RecTemp
     
        WglrGrid.Rows = WglrGrid.FixedRows
     
        If .EOF Then
            WglrGrid.Redraw = True
            NullFlag = False
            Exit Sub
        End If
     
        Jsqte = WglrGrid.FixedRows
        
        ReDim strFactor(.RecordCount + 1, 5)
        
        Do While Not .EOF
            WglrGrid.AddItem ""
            WglrGrid.TextMatrix(Jsqte, 1) = Trim(.Fields("FactorCode") & "")      '考核要素编码
            WglrGrid.TextMatrix(Jsqte, 2) = Trim(.Fields("CheckName")) & Chr(13) & "(" & Str(Val(.Fields("TargetWeigh")) * 100) & "％)"     '考核指标
            WglrGrid.TextMatrix(Jsqte, 3) = Trim(.Fields("FactorName")) & Chr(13) & "(" & Str(Val(.Fields("FactorWeigh")) * 100) & "％)"    '考核要素
            strFactor(Jsqte, 1) = Trim(.Fields("AppraiseType") & "")           '评价标准类型
            strFactor(Jsqte, 2) = Trim(.Fields("AppraiseCode") & "")           '评价标准编码
            strFactor(Jsqte, 3) = Trim(.Fields("TargetWeigh") & "")            '考核指标权重
            strFactor(Jsqte, 4) = Trim(.Fields("FactorWeigh") & "")            '考核要素权重
            strFactor(Jsqte, 5) = Trim(.Fields("FactorCode") & "")             '考核要素编码
            '<<]
       
            WglrGrid.RowHeight(Jsqte) = Sjhgd
            .MoveNext
            Jsqte = Jsqte + 1
        Loop
        
    End With
    
    
    
            
    '将网格刷新解禁(Fixed)
    WglrGrid.Redraw = True
       
End Sub
Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button)             '用户点击工具条
     
    '屏蔽文本框,下拉组合框有效性判断
     
    Valilock = True
     
    '屏蔽网格失去焦点产生的有效性判断
     
    Changelock = True
     
    Select Case Button.Key
        Case "ymsz"                                          '页面设置
            Dyymctbl.Show 1
        Case "yl"                                            '预 览
            Call bbyl(True)
            
        Case "dy"                                            '打 印
            Call bbyl(False)
            
        Case "bz"                                            '帮 助
            Call F1bz
        Case "fh"                                            '退 出
            Unload Me
            
    End Select
       
    '解 锁
    Valilock = False
    Changelock = False
        
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作
  
    If Shift = 2 Then
        Select Case UCase(Chr(KeyCode))
            Case "P"                   'Ctrl+P 打印
                If Tlb_Action.Buttons("dy").Enabled Then
                    Call bbyl(False)
                End If
        End Select
    End If
    
End Sub
Private Function AddTitleCode()
    Dim RecExist As New Recordset
    
    FillImageCombo Imgcbo_Title, "Khgl_TitleCompute", 1
           
    Sqlstr = "SELECT TitleCode,titleName From Kh_Title where (endflag=1  and CloseFlag=0 and CreateTime=(select max(createTime) from kh_title where endflag=1  and CloseFlag=0))"
    Set RecExist = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If Not RecExist.EOF Then
        If Len(Trim(RecExist.Fields("titleName"))) > 0 Then
            Imgcbo_Title.Text = RecExist.Fields("titleName")
        End If
    End If
    
    str_TitleCode = GetComboKey(Imgcbo_Title, 0)
    
End Function
Private Sub Imgcbo_Title_Click()
    str_TitleCode = GetComboKey(Imgcbo_Title, 0)
    
        '生成查询结果
    Call Sub_Query
    
    '设置网格
    ShowRecord
    
    '生成查询结果，填充评价标准
    
    Call Sub_QuerySub
    
End Sub
Public Function ShowRecord()                '设置网格
    '定义变量
    Dim cn As Connection
    Dim s As String
    Dim rs As New ADODB.Recordset
    Dim i As Integer
    Dim j As Integer
    Dim iFixedCols As Integer
    Dim iBeginCol As Integer
    Dim maxrows  As Integer             '考核要素最大行数
    
    If NullFlag = False Then Exit Function
    
    Set cn = Cw_DataEnvi.DataConnect
    iFixedCols = 4
    
    ReDim sItem(2) '字段属性
    sItem(0).ItemCode = 0
    sItem(0).ItemName = "考核要素编码"
    
    sItem(1).ItemCode = 0
    sItem(1).ItemName = "考核指标"
    
    sItem(2).ItemCode = 0
    sItem(2).ItemName = "考核要素名称"
    
    '初始化各种变量
    iBeginCol = GridInf(1)  '数据开始行数
    
    '生成查询语句,取考核要素对应量化规则对应的量化规则明细的记录数的最大值，作为动态增加的列数
    maxrows = 0
    For Jsqte = WglrGrid.FixedRows To WglrGrid.Rows
        
        If rs.State = 1 Then rs.Close
        
        s = "select  1   From Kh_GauList  " & Chr(10) _
            & " where CheckCode ='" & strFactor(Jsqte, 2) & "'"
            
        Set rs = cn.Execute(s)
        If rs.RecordCount > maxrows Then
            maxrows = rs.RecordCount
        End If
    Next Jsqte
    
    If maxrows < 2 Then maxrows = 2   '分值规则最多两列
    
    For Jsqte = 1 To maxrows
        ReDim Preserve sItem(UBound(sItem) + 1)
        sItem(UBound(sItem)).ItemName = "评价标准"
    Next Jsqte
    
    '网格再增加2列，用于填充考核数据
    ReDim Preserve sItem(UBound(sItem) + 1)
    sItem(UBound(sItem)).ItemName = "初评"
   
    With Me.WglrGrid
        '初始化网格
        .Redraw = False
        .Cols = UBound(sItem) + 2
        .FixedCols = iFixedCols
        '设置行标题
        For i = iFixedCols To .Cols - 1
            .TextMatrix(0, i) = sItem(i - 1).ItemName
            .ColWidth(i) = 1000                         '宽度
            .ColAlignment(i) = flexAlignRightCenter     '数据右对齐
            .FixedAlignment(i) = 4                      '列标题居中
        Next i
    
        For i = .FixedRows To .Rows - 1
            .RowHeight(i) = GridInf(2)
            .Cell(flexcpBackColor, i, .FixedCols, i, .Cols - 1) = vbWhite
        Next i
        
        .Redraw = True
    End With
    
   '刷新控制数组
    'iFixedCols = rs.RecordCount + iBeginCol + 1
    iFixedCols = maxrows + WglrGrid.FixedCols
    '网格隐藏(非操作显示)列数
     GridInf(1) = iBeginCol                         '起始列值
     With Me.WglrGrid
        ReDim GridBoolean(.Cols - 1, 1 To 6)
        ReDim GridInt(.Cols - 1, 1 To 7)
        ReDim GridStr(.Cols - 1, 1 To 5)
        
    
        For i = 0 To iFixedCols - 1
            GridBoolean(i, 1) = False                           '网格列是否可编辑
            GridBoolean(i, 2) = False                           '网格列是否提供帮助，'如果提供帮组只需调整本行为真
            GridBoolean(i, 3) = False                           '网格列是否列表框录入
            GridBoolean(i, 4) = False                           '网格列是否合计
            GridBoolean(i, 5) = True                            '网格内容为零是否清空
            GridBoolean(i, 6) = False                           '网格列是否为布尔型
            
            GridInt(i, 1) = 6                                   '字段数据类型
            GridInt(i, 2) = 10                                  '字段录入长度
            GridInt(i, 3) = 6                                   '字段整数位长度
            GridInt(i, 4) = 4                                   '字段小数位长度
            GridInt(i, 5) = 0                                   '字段不允许为空或为零
            GridInt(i, 6) = 0                                   '帮助类型
            GridInt(i, 7) = 1                                   '帮助返回值(0-显示返回编码 1-显示返回名称)
    
            GridStr(i, 1) = IIf(i - iBeginCol + 1 > 0, Format(i - iBeginCol + 1, "000"), Format(0, "000"))   '网格列索引值
            GridStr(i, 2) = ""                                  '字段为空提示信息
            GridStr(i, 3) = ""                                  '通用帮助编码
            GridStr(i, 4) = ""                                  '连接字段(通用帮助)
            GridStr(i, 5) = ""                                  '列表框编码
            
            '设置考核指标列上下居中
            If i <= 3 Then
                WglrGrid.ColAlignment(i) = flexAlignCenterCenter
            Else
                WglrGrid.ColAlignment(i) = flexAlignLeftCenter
            End If
            
        Next i
    End With
    
    
    Set rs = Nothing
    Set cn = Nothing
        
    
End Function
Private Sub Sub_QuerySub()                         '生成查询结果,填充评价标准
    Dim Sqlstr As String                           '临时使用字符串
    Dim RecTemp As New ADODB.Recordset             '临时使用动态集
    Dim Jsqte, jsqteh, jsqtel As Long              '临时计数器
    Dim str_Temp As String                         '临时使用字符串
    If NullFlag = False Then Exit Sub
    
    '禁止网格刷新动作,为加快网格显示速度(Fixed)
    WglrGrid.Redraw = False
    
    ReDim Preserve strFactor(UBound(strFactor, 1), 5)
        
        '填充评价标准及分值
        For jsqteh = WglrGrid.FixedRows To WglrGrid.Rows - 1
            jsqtel = WglrGrid.FixedCols
            str_value = ""
            If RecTemp.State = 1 Then RecTemp.Close
            
            If strFactor(jsqteh, 1) = "0" Then
                Sqlstr = " SELECT PointMin,PointMax FROM Kh_Point  " & _
                         " where  PointCode ='" & strFactor(jsqteh, 2) & "'"
                         
                Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                If RecTemp.RecordCount <> 0 Then
                    strFactor(jsqteh, 5) = RecTemp.Fields("PointMax")
                    Do While Not RecTemp.EOF()
                        str_value = "最大值" & Chr(13) & "(" & Trim(RecTemp.Fields("PointMax") & "") & "分)"
                        WglrGrid.TextMatrix(jsqteh, jsqtel) = str_value
                    
                        str_value = "最小值" & Chr(13) & "(" & Trim(RecTemp.Fields("PointMin") & "") & "分)"
                        WglrGrid.TextMatrix(jsqteh, jsqtel + 1) = str_value
                        
                        RecTemp.MoveNext
                        jsqtel = jsqtel + 1
                    Loop
                End If
            Else
                         
                Sqlstr = " SELECT Standard,GauListMark " & _
                         " FROM Kh_v_Standard where FactorCode='" & strFactor(jsqteh, 5) & "'" & _
                         " Order By  FactorCode, GauListCode"
             
                         
                Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                If RecTemp.RecordCount <> 0 Then
                    strFactor(jsqteh, 5) = RecTemp.Fields("GauListMark")
                    Do While Not RecTemp.EOF()
                
                       '为了字符串分行显示
                        If Not IsNull(RecTemp.Fields("Standard")) Then
                            str_Temp = Trim(RecTemp.Fields("Standard"))
                        Else
                            str_Temp = ""
                        End If
                        str_value = ""
'                        Do
'                            str_value = str_value & Mid(str_Temp, 1, 4) + Chr(13)
'                            str_Temp = Mid(str_Temp, 5)
'
'                        Loop While Len(str_Temp) > 0
                        
                        str_value = str_Temp
                                
                        str_value = str_value & "(" & Trim(RecTemp.Fields("GauListMark") & "") & "分)"
                    
                        WglrGrid.TextMatrix(jsqteh, jsqtel) = str_value            '评价标准
                        RecTemp.MoveNext
                        jsqtel = jsqtel + 1
                    Loop
                End If
            End If
            
        Next jsqteh
        
        '以下为添加合计行,考核指标权重*考核要素权重*考核要素对应最大分值
        Dim Sng_total As Single
            Sng_total = 0
        For Jsqte = WglrGrid.FixedRows To WglrGrid.Rows - 1
            Sng_total = Sng_total + Val(strFactor(Jsqte, 3)) * Val(strFactor(Jsqte, 4)) * Val(strFactor(Jsqte, 5))
        Next Jsqte
        WglrGrid.AddItem ""
        WglrGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = "合  计"
        WglrGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Format(Sng_total, "#######.000")
        WglrGrid.RowHeight(Jsqte) = 270
                
    '将网格刷新解禁(Fixed)
    WglrGrid.Redraw = True
       
End Sub
'===================以 下 程 序 为 通 用 部 分 ,一 般 不 需 更 改(程序动作部分)======================='
Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)
    
    Select Case Button.Key
        Case "bcgs"                                       '保存表格格式
            Call Bcwggs(WglrGrid, GridCode, GridStr())
        Case "hfmrgs"                                     '恢复默认格式
            Call Hfmrgs(WglrGrid, GridCode, GridStr())
    End Select
End Sub
Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
    
    Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
    Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
    Bbxbtgs = 2                                          '报 表 小 标 题 行 数
    Bbbwhgs = 2                                          '报 表 表 尾 行 数
    ReDim Bbxbt(1 To Bbxbtgs)
    ReDim bbxbtzzxs(1 To Bbxbtgs)
    If Bbbwhgs <> 0 Then
        ReDim Bbbwh(1 To Bbbwhgs)
        ReDim Bbbwhzzxs(1 To Bbbwhgs)
    End If
    Bbzbt = ReportTitle
    
    '<<以下为自加
    
    Bbxbt(1) = "考核类别:" + GetComboKey(Imgcbo_Title, 1)
    bbxbtzzxs(1) = 0                                    '居左
    Bbxbt(2) = "姓名:          部门:           岗位:        "
    bbxbtzzxs(2) = 0                                    '居左
    
      
    Dim Reportfooter As String
    Dim str_Sqltemp As String
    Dim rst_temp As New ADODB.Recordset
            
    str_Sqltemp = "SELECT Kh_ValList.ValListCode,Kh_ValList.ValListName " & _
                    " FROM Kh_ValList INNER JOIN " & _
                           " Kh_Title ON Kh_ValList.CheckCode = Kh_Title.CheckCode " & _
                    " where  Kh_Title.TitleCode='" & Trim(str_TitleCode) & "'"
    Set rst_temp = Cw_DataEnvi.DataConnect.Execute(str_Sqltemp)
    If rst_temp.RecordCount <> 0 Then
        Reportfooter = ""
        Do While Not rst_temp.EOF
            Reportfooter = Reportfooter & "○" & Trim(rst_temp!ValListName) & Space(3)
            rst_temp.MoveNext
        Loop
    End If
    rst_temp.Close
    Set rst_temp = Nothing
  
    Bbbwh(1) = "考核者所在位置:"
    Bbbwh(2) = Reportfooter
    
  '>>以上为自加
  
    Call Scyxsjb(WglrGrid)                               '生成报表数据
    Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
    If Not bbylte Then
        Unload DY_Tybbyldy
    End If
End Sub

						