📄
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form Hp_Dept_Frm
AutoRedraw = -1 'True
BorderStyle = 1 'Fixed Single
Caption = "部门选择"
ClientHeight = 5520
ClientLeft = 45
ClientTop = 330
ClientWidth = 4275
Icon = "帮助_部门帮助.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5520
ScaleWidth = 4275
StartUpPosition = 1 '所有者中心
Begin VB.CommandButton Cmd_Cancel
Cancel = -1 'True
Caption = "取消(&C)"
Height = 300
Left = 3075
TabIndex = 4
Top = 5145
Width = 1120
End
Begin VB.CommandButton Cmd_OK
Caption = "确定(&O)"
Default = -1 'True
Height = 300
Left = 1890
TabIndex = 3
Top = 5145
Width = 1120
End
Begin MSComctlLib.TreeView TV_Dept
Height = 4500
Left = 45
TabIndex = 2
Top = 540
Width = 4170
_ExtentX = 7355
_ExtentY = 7938
_Version = 393217
HideSelection = 0 'False
Style = 7
Appearance = 1
End
Begin VB.TextBox Txt_Dept
Height = 315
Left = 525
TabIndex = 1
Top = 120
Width = 3690
End
Begin VB.Label Lab_Mark
AutoSize = -1 'True
Caption = "部门:"
Height = 180
Index = 3
Left = 60
TabIndex = 0
Top = 195
Width = 450
End
End
Attribute VB_Name = "Hp_Dept_Frm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'************************************************************************
'* 功 能 描 述 :按树状结构显示部门,根据参数确定是否可选非末级部门
'* 程序员姓名 :苗 鹏
'* 最后修改人 :苗 鹏
'* 最后修改时间:2002/01/03
'* 备 注:程序中所有依实际情况自定义部分均用[>> <<]括起
'*********************************************************************
Option Explicit
Public bMinLvl As Boolean
Public sDept As String
Public sDeptName As String
Private Sub Cmd_Cancel_Click()
sDept = ""
Unload Me
End Sub
Private Sub Cmd_OK_Click()
'选择部门
With Me.TV_Dept
If Not .SelectedItem Is Nothing Then
If Me.bMinLvl = True Then
If .SelectedItem.Children <> 0 Then
MsgBox "请选择末级部门!", vbOKOnly + vbCritical
Exit Sub
Else
sDept = .SelectedItem.Tag
sDeptName = .SelectedItem.Text
End If
End If
Else
sDept = ""
End If
End With
Unload Me
End Sub
Private Sub Form_Load()
On Error GoTo ErrCtrl
'初始化部门树
FillDept2TV "RsPmFlag", Me.TV_Dept, Cw_DataEnvi.DataConnect
Exit Sub
ErrCtrl:
Unload Me
End Sub
Private Sub TV_Dept_BeforeLabelEdit(Cancel As Integer)
Cancel = 1
End Sub
Private Sub TV_Dept_NodeCheck(ByVal Node As MSComctlLib.Node)
'点击节点
Dim i As Integer
With Me.TV_Dept
For i = 1 To .Nodes.count
If .Nodes(i).Parent Is Node Then
.Nodes(i).Checked = Node.Checked
Call TV_Dept_NodeCheck(.Nodes(i))
End If
Next i
End With
End Sub
Private Sub Txt_Dept_Change()
'通过文本框选择节点
Dim i As Integer
Dim s As String
s = Trim(Me.Txt_Dept.Text)
With Me.TV_Dept
For i = 1 To .Nodes.count
If .Nodes(i).Tag = s Then
.Nodes(i).EnsureVisible
.SelectedItem = .Nodes(i)
Exit Sub
End If
Next i
End With
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -