📄 -
字号:
EndProperty
BeginProperty ListImage34 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "他评要素分析.frx":2973E
Key = "ys"
EndProperty
BeginProperty ListImage35 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "他评要素分析.frx":29AD8
Key = "tx"
EndProperty
EndProperty
End
Begin VSFlex8Ctl.VSFlexGrid CxbbGrid
Height = 5595
Left = 2820
TabIndex = 3
Top = 1380
Width = 8235
_ExtentX = 14526
_ExtentY = 9869
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 = 13826538
ForeColorFixed = -2147483630
BackColorSel = -2147483635
ForeColorSel = -2147483634
BackColorBkg = 8421504
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 = 5000
Cols = 10
FixedRows = 1
FixedCols = 0
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
Begin MSComctlLib.TreeView TreeView
Height = 5595
Left = 0
TabIndex = 7
Top = 1380
Width = 2775
_ExtentX = 4895
_ExtentY = 9869
_Version = 393217
Indentation = 617
LabelEdit = 1
Style = 7
ImageList = "ImageList2"
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Image imgSplitter
Height = 6465
Left = 2820
MousePointer = 9 'Size W E
Top = 630
Width = 90
End
End
Attribute VB_Name = "Khgl_FactorAnalyze"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*******************************************************
'* 模 块 名 称 :他评要素分析
'* 功 能 描 述 :
'* 程序员姓名 :张洪军
'* 最后修改人 :张洪军
'* 最后修改时间:2001/12/19
'* 备 注:封版
'*******************************************************
Dim str_TitleCode As String '考核类别编码
Dim str_titleRoot As String '考核类别根结点编码
Dim str_format As String '考核数据显示格式
Dim int_EmpID As Integer '职工id号
Dim int_titleRootlen As Integer '考核类别根结点长度
Dim CheckFactor() As New CCheckFactor '考核指标、考核要素、指标权重、要素权重、考核得分
Dim mbMoving As Boolean
Const sglSplitLimit = 1000
Dim Rec_CodeSet As New ADODB.Recordset '编码设置表
Dim jdzygs As Integer '控件焦点转移个数
Dim Lrzt As Integer '录入状态标志(0-非录入状态 1-增加 2-修改)
Dim ReportTitle As String '报表主标题
'以下为固定使用变量(网格)
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)
Dim nodX As Node
Private Sub Form_KeyPress(KeyAscii As Integer) '控 制 焦 点 转 移
jdzygs = 10
Select Case KeyAscii
Case vbKeyReturn
If Kjjdzy(jdzygs) Then
KeyAscii = 0
End If
Case 39 '屏蔽"'"
KeyAscii = 0
End Select
End Sub
Private Sub Form_Load()
SizeControls imgSplitter.Left
str_format = "########"
'填充考核类别列表框
Call AddTitleCode
Call ShowFormat
int_EmpID = -1
Add_Tree
'打印报表标题信息
ReportTitle = "他评要素分析"
'调入打印页面设置窗体
XtReportCode = "Khgl_FactorAnalyze"
Load Dyymctbl
'调 入 网 格
GridCode = "Khgl_FactorAnalyze"
Call BzWgcsh(CxbbGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
Qslz = GridInf(1)
Sjhgd = GridInf(2)
Sfxshjwg = GridInf(7)
Szzls = CxbbGrid.Cols - 1
'加快显示速度
CxbbGrid.Redraw = False
'添加列标题
Call Sub_AddCol
If int_EmpID > 0 Then
'填 充 网 格
Call Sub_Query
End If
Imgcbo_Title.Refresh
End Sub
Private Sub Sub_AddCol() '添加列标题
Dim Rec_Query As New ADODB.Recordset '查询结果动态集
Dim Sqlstr As String '查询字符串
Dim Jsqte As Integer '临时动态计数器
'以下为自定义部分[
CxbbGrid.Redraw = False
'填 充 网 格 标 题
CxbbGrid.Cols = Sydz("001", GridStr(), Szzls) + 2
CxbbGrid.TextMatrix(0, Sydz("001", GridStr(), Szzls)) = "测评规则编码"
CxbbGrid.TextMatrix(0, Sydz("002", GridStr(), Szzls)) = "测评规则名称"
CxbbGrid.TextMatrix(1, Sydz("001", GridStr(), Szzls)) = "测评规则编码"
CxbbGrid.TextMatrix(1, Sydz("002", GridStr(), Szzls)) = "测评规则名称"
'取考核类别编码方案
Sqlstr = "select * from Gy_CodeScheme where ItemCode='" & Trim("Khgl_Title") & "'"
Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
'取考核类别编码的根结点编码
int_titleRootlen = Val(Mid(Rec_Query.Fields("CodeScheme"), 1, 1))
str_titleRoot = Mid(str_TitleCode, 1, int_titleRootlen)
Rec_Query.Close
'添加列标题
ReDim CheckFactor(2)
'本张单据查询字符串,填充考核要素编码、考核指标、考核要素名称
Sqlstr = " SELECT FactorCode,FactorName,CheckName" & _
" FROM Kh_v_ValMark where TitleCode='" & str_titleRoot & "'" & _
" Order By ValMarkID"
Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With CxbbGrid
.Cols = .FixedCols + Rec_Query.RecordCount
For Jsqte = .FixedCols To .Cols - 1
ReDim Preserve CheckFactor(UBound(CheckFactor) + 1)
CheckFactor(Jsqte).FactorCode = Trim("" & Rec_Query!FactorCode)
CheckFactor(Jsqte).FactorValues = 0
.TextMatrix(0, Jsqte) = Trim("" & Rec_Query!CheckName)
.TextMatrix(1, Jsqte) = Trim("" & Rec_Query!FactorName)
.ColWidth(Jsqte) = 1000
.ColAlignment(Jsqte) = flexAlignRightCenter
Rec_Query.MoveNext
Next Jsqte
End With
CxbbGrid.Cols = CxbbGrid.Cols + 2
CxbbGrid.TextMatrix(0, CxbbGrid.Cols - 2) = "有效票数"
CxbbGrid.TextMatrix(1, CxbbGrid.Cols - 2) = "有效票数"
CxbbGrid.TextMatrix(0, CxbbGrid.Cols - 1) = "合 计"
CxbbGrid.TextMatrix(1, CxbbGrid.Cols - 1) = "合 计"
For Jsqte = 0 To CxbbGrid.Cols - 1
CxbbGrid.FixedAlignment(Jsqte) = 4 '列标题居中
Next Jsqte
'查询测评规则，添加行标题
Sqlstr = " SELECT Kh_Appraise.ValListCode , Kh_ValList.ValListName " & _
" From Kh_Appraise" & _
" left outer join Kh_ValList on Kh_Appraise.ValListCode = Kh_ValList.ValListCode " & _
" where Kh_Appraise.TitleCode='" & str_titleRoot & "'" & _
" order by Kh_Appraise.ValListCode"
Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With Rec_Query
CxbbGrid.Rows = CxbbGrid.FixedRows + .RecordCount
For Jsqte = CxbbGrid.FixedRows To CxbbGrid.Rows - 1
CxbbGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Trim("" & !ValListCode) '测评规则编码
CxbbGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim("" & !ValListName) '测评规则名称
CxbbGrid.RowHeight(Jsqte) = Sjhgd
.MoveNext
Next Jsqte
End With
'添加合计行
CxbbGrid.Rows = CxbbGrid.Rows + 1
CxbbGrid.TextMatrix(CxbbGrid.Rows - 1, Sydz("002", GridStr(), Szzls)) = "合计"
CxbbGrid.Redraw = True
End Sub
Private Sub Sub_Query() '生成查询结果
Dim Rec_Query As New ADODB.Recordset '查询结果动态集
Dim Sqlstr As String '查询字符串
Dim Jsqte As Integer '临时动态计数器
Dim int_row As Integer '临时动态计数器,实际网格行
'以下为自定义部分[
Xt_Wait.Show
Xt_Wait.Refresh
CxbbGrid.Redraw = False
'清空表格数据
CxbbGrid.Clear 1
For int_row = CxbbGrid.FixedRows To CxbbGrid.Rows - 2
For Jsqte = CxbbGrid.FixedCols To CxbbGrid.Cols - 1 - 2
'读取考核要素分值
Sqlstr = " SELECT sum(ObjectTotal) as ObjectTotal From Kh_BaseTotal " & _
" Where TitleCode='" & str_TitleCode & "'" & _
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -