📄 frmsetusermode.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form frmSetUserMode
BorderStyle = 1 'Fixed Single
Caption = "用户自定义模式设定"
ClientHeight = 5685
ClientLeft = 45
ClientTop = 330
ClientWidth = 7470
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5685
ScaleWidth = 7470
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton cmdDeleteOne
Caption = "×"
Height = 300
Left = 3990
TabIndex = 10
Top = 1050
Width = 700
End
Begin VB.CommandButton cmdSeleOne
Caption = ">"
Height = 300
Left = 3180
TabIndex = 9
Top = 1050
Width = 700
End
Begin VB.Frame frmSplitter
Height = 4275
Left = 3900
MouseIcon = "Frmsetusermode.frx":0000
MousePointer = 99 'Custom
TabIndex = 8
Top = 1260
Width = 75
End
Begin VB.ListBox lstSeleItem
Height = 79260
Left = 3990
MultiSelect = 2 'Extended
TabIndex = 7
Top = 1350
Width = 3375
End
Begin VB.TextBox txtItem
Height = 315
Left = 120
TabIndex = 6
Text = "txtItem"
Top = 990
Width = 1200
End
Begin MSComctlLib.TreeView tvItem
Height = 4185
Left = 120
TabIndex = 5
Top = 1350
Width = 3765
_ExtentX = 6641
_ExtentY = 7382
_Version = 393217
Style = 6
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.CommandButton cmdCancel
Caption = " 取消(&C)"
Height = 375
Left = 5970
TabIndex = 2
Top = 540
Width = 1400
End
Begin VB.CommandButton cmdSure
Caption = " 确定(&S)"
Height = 375
Left = 5970
TabIndex = 1
Top = 150
Width = 1400
End
Begin VB.TextBox txtName
Height = 315
Left = 120
TabIndex = 0
Text = "txtName"
Top = 330
Width = 3735
End
Begin VB.Image ImgCase
Height = 360
Left = 3900
Picture = "Frmsetusermode.frx":030A
Stretch = -1 'True
Top = 300
Width = 360
End
Begin VB.Image ImgCompany
Height = 360
Left = 3900
Picture = "Frmsetusermode.frx":0A0E
Stretch = -1 'True
Top = 300
Width = 360
End
Begin VB.Label lblSeleItem
AutoSize = -1 'True
Caption = "请选择该方式对应的项目"
Height = 180
Left = 120
TabIndex = 4
Top = 780
Width = 1980
End
Begin VB.Label lblUserModeName
AutoSize = -1 'True
Caption = "请提供该方式的名称"
Height = 180
Left = 150
TabIndex = 3
Top = 120
Width = 1620
End
End
Attribute VB_Name = "frmSetUserMode"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'局部常量定义
Const csCaseSQL As String = "SELECT * FROM sys_Case "
Const csUserModeSQL As String = "SELECT * FROM Operation_UserDefined_Rules"
Dim IsQYBM As Boolean
Dim ModeNameOld As String
Dim mbMoving As Boolean
Const sglSplitLimit As Integer = 2100
Private Sub cmdCancel_Click()
Me.Hide
End Sub
Private Sub cmdDeleteOne_Click()
If lstSeleItem.ListCount = 0 Then
Exit Sub
End If
If IsQYBM Then
If lstSeleItem.ListIndex < 0 Then
MsgBox "请选择一个企业!", vbInformation
Exit Sub
End If
Else
If lstSeleItem.ListIndex < 0 Then
MsgBox "请选择一种文书!", vbInformation
Exit Sub
End If
End If
Call DeleteList(lstSeleItem, lstSeleItem.ListIndex)
End Sub
Private Sub cmdSeleOne_Click()
On Error GoTo ErrorHandler
If IsQYBM Then
If tvItem.SelectedItem.Index < 0 Then
MsgBox "请选择一个企业!", vbInformation
Exit Sub
End If
Call TranceList(tvItem, lstSeleItem, QYBMLength)
Else
If tvItem.SelectedItem.Index < 0 Then
MsgBox "请选择一种文书!", vbInformation
Exit Sub
End If
Call TranceList(tvItem, lstSeleItem, CaseCodeLength)
End If
Exit Sub
ErrorHandler:
If Err Then
Err.Clear
End If
End Sub
Private Sub cmdSure_Click()
If fCenter.ThisMode = "QY Modify" Or fCenter.ThisMode = "Case Modify" Then
If ModifyUserMode(IsQYBM, ModeNameOld, txtName, lstSeleItem) Then
Me.Hide
End If
Else
If SaveUserMode(IsQYBM, txtName, lstSeleItem) Then
Me.Hide
End If
End If
End Sub
Private Sub Form_Initialize()
With fCenter
If .ThisMode = "QY" Or .ThisMode = "QY Modify" Or .ThisMode = "QY Select" Then
Call MakeAllCompanyTree(tvItem)
End If
If .ThisMode = "Case" Or .ThisMode = "Case Modify" Or .ThisMode = "Case Select" Then
Call MakeAllCaseTree(tvItem)
End If
End With
End Sub
Private Sub Form_Load()
txtItem.Text = vbNullString
txtName.Text = vbNullString
End Sub
Private Sub Form_Activate()
ModeNameOld = Trim(txtItem.Text)
If fCenter.ThisMode = "QY" Then
IsQYBM = True
txtItem.Text = vbNullString
txtItem.MaxLength = QYBMLength
lstSeleItem.Clear
End If
If fCenter.ThisMode = "Case" Then
IsQYBM = False
txtItem.Text = vbNullString
txtItem.MaxLength = CaseCodeLength
lstSeleItem.Clear
End If
If fCenter.ThisMode = "QY Select" Then
IsQYBM = True
txtItem.MaxLength = QYBMLength
Call ReadSelection(fCenter.lstSeleCompany)
End If
If fCenter.ThisMode = "Case Select" Then
IsQYBM = False
txtItem.MaxLength = CaseCodeLength
Call ReadSelection(fCenter.lstSeleCase)
End If
If fCenter.ThisMode = "QY Modify" Then
IsQYBM = True
ModeNameOld = txtName.Text
txtItem.MaxLength = QYBMLength
Call ReadExistedMode(txtName.Text)
End If
If fCenter.ThisMode = "Case Modify" Then
IsQYBM = False
ModeNameOld = txtName.Text
txtItem.MaxLength = CaseCodeLength
Call ReadExistedMode(txtName.Text)
End If
If tvItem.Nodes.Count > 0 Then
tvItem.Nodes(1).Expanded = True
End If
If IsQYBM Then
ImgCompany.Visible = True
ImgCase.Visible = False
Else
ImgCompany.Visible = False
ImgCase.Visible = True
End If
End Sub
Private Sub frmSplitter_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
With frmSplitter
frmSplitter.Move .Left, .Top, .Width, .Height
End With
mbMoving = True
End Sub
Private Sub frmSplitter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim sglPos As Single
If mbMoving Then
sglPos = X + frmSplitter.Left
If sglPos < sglSplitLimit Then
frmSplitter.Left = sglSplitLimit
ElseIf sglPos > Me.Width - sglSplitLimit Then
frmSplitter.Left = Me.Width - sglSplitLimit
Else
frmSplitter.Left = sglPos
End If
End If
End Sub
Private Sub frmSplitter_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
SizeControls frmSplitter.Left
mbMoving = False
End Sub
Sub SizeControls(X As Single)
On Error Resume Next
'设置 x
If X < txtItem.Width + 100 Then X = txtItem.Width + 100
If X > Me.Width - sglSplitLimit Then X = Me.Width - sglSplitLimit
'设置 控件的 Left属性
frmSplitter.Left = X
tvItem.Left = txtItem.Left
lstSeleItem.Left = X + frmSplitter.Width + 15
cmdSeleOne.Left = frmSplitter.Left - cmdSeleOne.Width - 15
cmdDeleteOne.Left = frmSplitter.Left + 90
'设置控件的Width属性
tvItem.Width = X - 115
lstSeleItem.Width = Me.Width - X - 290
End Sub
Private Sub lstSeleItem_DblClick()
Call DeleteList(lstSeleItem, lstSeleItem.ListIndex)
End Sub
Private Sub tvItem_DblClick()
If IsQYBM Then
Call TranceList(tvItem, lstSeleItem, QYBMLength)
Else
Call TranceList(tvItem, lstSeleItem, CaseCodeLength)
End If
End Sub
Private Sub tvItem_KeyPress(KeyAscii As Integer)
If KeyAscii <> vbKeyReturn Then
Exit Sub
End If
If IsQYBM Then
Call TranceList(tvItem, lstSeleItem, QYBMLength)
Else
Call TranceList(tvItem, lstSeleItem, CaseCodeLength)
End If
End Sub
Private Sub txtItem_Change()
If IsQYBM Then
Call FindExactNode(txtItem.Text, QYBMLength, tvItem)
Else
Call FindExactNode(txtItem.Text, CaseCodeLength, tvItem)
End If
End Sub
Private Function SaveUserMode(IsQYBM As Boolean, ModeName As TextBox, lstSeleItem As ListBox) As Boolean
'***********************************************
'功能：将用户制作的自定义方法存入数据库CaseMain
' 的表Operation_UserDefined_Rules
'用于：本窗体的cmdSave_Click
'***********************************************
Dim i As Integer
Dim FoundSQL As String
Dim Msg As String
Dim rstUserMode As ADODB.Recordset
'如果自定义类型名称为空,则退出
If Trim(ModeName.Text) = vbNullString Then
MsgBox "自定义集合名称不能为空!", vbExclamation
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -