📄 frmsysoption.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{E95A2510-F3D1-416D-823B-4F840FE98091}#3.0#0"; "Command.ocx"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form frmSysOption
BorderStyle = 3 'Fixed Dialog
Caption = "系统设置"
ClientHeight = 6645
ClientLeft = 45
ClientTop = 435
ClientWidth = 9735
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 6645
ScaleWidth = 9735
ShowInTaskbar = 0 'False
Begin RichTextLib.RichTextBox rtxtMemo
Height = 1245
Left = 990
TabIndex = 10
Top = 450
Width = 7095
_ExtentX = 12515
_ExtentY = 2196
_Version = 393217
Appearance = 0
TextRTF = $"frmSysOption.frx":0000
End
Begin VB.TextBox txtSys
Appearance = 0 'Flat
BackColor = &H00FFFFFF&
Height = 300
Index = 0
Left = 990
TabIndex = 3
Top = 120
Width = 3585
End
Begin VB.TextBox txtSys
Appearance = 0 'Flat
Height = 300
Index = 1
Left = 5520
TabIndex = 1
Top = 120
Width = 2565
End
Begin MSComctlLib.ListView lstSystem
Height = 4845
Left = 30
TabIndex = 0
Top = 1770
Width = 9645
_ExtentX = 17013
_ExtentY = 8546
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
End
Begin CSCommand.Command cmdOK
Height = 375
Left = 8220
TabIndex = 2
Top = 90
Width = 1335
_ExtentX = 2355
_ExtentY = 661
Icon = "frmSysOption.frx":009D
Caption = "确定(&S)"
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 CSCommand.Command cmdback
Height = 375
Left = 8220
TabIndex = 4
Top = 1350
Width = 1335
_ExtentX = 2355
_ExtentY = 661
Icon = "frmSysOption.frx":0637
Caption = "返回(&B)"
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 CSCommand.Command cmdPrint
Height = 375
Left = 8220
TabIndex = 5
Top = 930
Width = 1335
_ExtentX = 2355
_ExtentY = 661
Icon = "frmSysOption.frx":0BD1
Caption = "打印(&P)"
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 CSCommand.Command cmdQuery
Height = 375
Left = 8220
TabIndex = 6
Top = 510
Width = 1335
_ExtentX = 2355
_ExtentY = 661
Icon = "frmSysOption.frx":116B
Caption = "查询(&Q)"
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.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "设置类型："
Height = 180
Index = 3
Left = 90
TabIndex = 9
Top = 180
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "设置值："
Height = 180
Index = 1
Left = 4650
TabIndex = 8
Top = 180
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "备注："
Height = 180
Index = 2
Left = 450
TabIndex = 7
Top = 540
Width = 540
End
End
Attribute VB_Name = "frmSysOption"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdBack_Click()
'返回
tBackMain Me
End Sub
Private Sub cmdOK_Click()
On Error GoTo ErrInfo
If txtSys(0).Text = "" Then
MsgBox "设置信息错误！", vbInformation, "提示："
txtSys(0).SetFocus
SendKeys "{Home}+{End}"
Exit Sub
End If
If txtSys(1).Text = "" Then
MsgBox "设置信息错误！", vbInformation, "提示："
txtSys(1).SetFocus
SendKeys "{Home}+{End}"
Exit Sub
End If
With uShareInfo
.strName = txtSys(0).Text
.strShare = txtSys(1).Text
.strType = rtxtMemo.Text
End With
If tSystem(uShareInfo, iAdd_Update) = False Then
MsgBox "信息处理失败！", vbInformation, "提示："
Exit Sub
End If
txtSys(0).Text = ""
txtSys(1).Text = ""
rtxtMemo.Text = ""
iAdd_Update = 0
getSystemData ""
Exit Sub
ErrInfo:
MsgBox Err.Description, vbInformation, "提示："
End Sub
Private Sub cmdQuery_Click()
getSystemData Trim(txtSys(0).Text)
End Sub
Private Sub Form_Load()
'计算窗体显示位置
tFormSpace frmMain, Me, uWindows
strOpr_Update = 0
'显示
getHead
getSystemData ""
End Sub
'显示列头
Private Sub getHead()
With lstSystem
.ListItems.Clear
.FullRowSelect = True
.GridLines = True
.LabelEdit = lvwManual
.View = lvwReport
With .ColumnHeaders
.Clear
.Add , , "@", 0
.Add , , " 编码", 1200
.Add , , " 设定类型", 1800
.Add , , " 设定值", 1400
.Add , , " 备注", 3400
End With
End With
End Sub
'显示数据
Private Function getSystemData(strInfo As String)
Dim iIndex As Integer
Dim strSQL As String
Dim rsTemp As New ADODB.Recordset
strSQL = "Select * from tbSysset Where Sys_para Like '" & strInfo & "%' Or Sys_value Like '" & strInfo & "%' Or Sys_Remark Like '" & strInfo & "%' Order By Sys_id"
Set rsTemp = DBCN.Execute(strSQL)
If rsTemp.EOF = False Then
iIndex = 1
lstSystem.ListItems.Clear
Do Until rsTemp.EOF
lstSystem.ListItems.Add iIndex, , iIndex
With lstSystem.ListItems(iIndex)
.SubItems(1) = IIf(IsNull(rsTemp.Fields(0)), 0, rsTemp.Fields(0))
.SubItems(2) = IIf(IsNull(rsTemp.Fields(1)), 0, rsTemp.Fields(1))
.SubItems(3) = IIf(IsNull(rsTemp.Fields(2)), 0, rsTemp.Fields(2))
.SubItems(4) = IIf(IsNull(rsTemp.Fields(3)), 0, rsTemp.Fields(3))
End With
rsTemp.MoveNext
iIndex = iIndex + 1
Loop
Else
'没有基本信息
MsgBox "没有设置信息！", vbInformation, "提示："
End If
End Function
Private Sub lstSystem_DblClick()
iAdd_Update = 1
uShareInfo.strCode = lstSystem.SelectedItem.SubItems(1)
txtSys(0).Text = lstSystem.SelectedItem.SubItems(2)
txtSys(1).Text = lstSystem.SelectedItem.SubItems(3)
rtxtMemo.Text = lstSystem.SelectedItem.SubItems(4)
txtSys(1).SetFocus
SendKeys "{Home}+{End}"
End Sub
Private Sub rtxtMemo_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
cmdOK.SetFocus
End If
End Sub
Private Sub txtSys_GotFocus(Index As Integer)
txtSys(Index).BackColor = &HC0FFC0
txtSys(Index).ForeColor = vbRed
End Sub
Private Sub txtSys_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyDown
If Index = txtSys.Count - 1 Then Exit Sub
txtSys(Index + 1).SetFocus
SendKeys "{Home}+{End}"
Exit Sub
Case vbKeyUp
If Index = 0 Then Exit Sub
txtSys(Index - 1).SetFocus
SendKeys "{Home}+{End}"
Exit Sub
Case Else
Exit Sub
End Select
End Sub
Private Sub txtSys_KeyPress(Index As Integer, KeyAscii As Integer)
Select Case KeyAscii
Case vbKeyReturn
Select Case Index
Case 0
If txtSys(Index).Text = "" Then
txtSys(Index).SetFocus
SendKeys "{Home}+{End}"
Exit Sub
End If
If tWhileCode("tbSysset", "Sys_para", Trim(txtSys(Index).Text)) = False Then
MsgBox "信息重复！请检查您的输入是否正确？", vbInformation, "提示："
txtSys(Index).SetFocus
SendKeys "{Home}+{End}"
Exit Sub
Else
txtSys(Index + 1).SetFocus
SendKeys "{Home}+{End}"
Exit Sub
End If
Case 1
rtxtMemo.SetFocus
SendKeys "{Home}+{End}"
Exit Sub
End Select
Case Else
Exit Sub
End Select
End Sub
Private Sub txtSys_LostFocus(Index As Integer)
txtSys(Index).BackColor = vbWhite
txtSys(Index).ForeColor = vbBlack
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -