📄 frmoption.frm
字号:
End
End
End
Begin ComctlLib.TabStrip TabStrip1
Height = 4230
Left = 90
TabIndex = 6
Top = 120
Width = 6150
_ExtentX = 10848
_ExtentY = 7461
_Version = 327682
BeginProperty Tabs {0713E432-850A-101B-AFC0-4210102A8DA7}
NumTabs = 4
BeginProperty Tab1 {0713F341-850A-101B-AFC0-4210102A8DA7}
Caption = "综合"
Key = "general"
Object.Tag = ""
Object.ToolTipText = "一般选项"
ImageVarType = 2
EndProperty
BeginProperty Tab2 {0713F341-850A-101B-AFC0-4210102A8DA7}
Caption = "物品管理"
Key = "wupin"
Object.Tag = ""
Object.ToolTipText = "配置物品"
ImageVarType = 2
EndProperty
BeginProperty Tab3 {0713F341-850A-101B-AFC0-4210102A8DA7}
Caption = "编辑消息"
Key = "message"
Object.Tag = ""
ImageVarType = 2
EndProperty
BeginProperty Tab4 {0713F341-850A-101B-AFC0-4210102A8DA7}
Caption = "公司名称"
Key = "mc"
Object.Tag = ""
Object.ToolTipText = "公司名称配置"
ImageVarType = 2
EndProperty
EndProperty
End
Begin VB.Line Line5
BorderColor = &H00808080&
Index = 5
X1 = 3195
X2 = 6105
Y1 = 4635
Y2 = 4635
End
Begin VB.Line Line5
BorderColor = &H00808080&
Index = 4
X1 = 3180
X2 = 6090
Y1 = 4560
Y2 = 4560
End
Begin VB.Line Line5
BorderColor = &H00808080&
Index = 3
X1 = 3165
X2 = 6075
Y1 = 4485
Y2 = 4485
End
Begin VB.Line Line5
BorderColor = &H00FFFFFF&
Index = 2
X1 = 3210
X2 = 6120
Y1 = 4650
Y2 = 4650
End
Begin VB.Line Line5
BorderColor = &H00FFFFFF&
Index = 1
X1 = 3195
X2 = 6105
Y1 = 4575
Y2 = 4575
End
Begin VB.Line Line5
BorderColor = &H00FFFFFF&
Index = 0
X1 = 3180
X2 = 6090
Y1 = 4500
Y2 = 4500
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = "温州东化计算机科技有限公司"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808080&
Height = 255
Index = 0
Left = 135
TabIndex = 29
Top = 4455
Width = 3315
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = "温州东化计算机科技有限公司"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808080&
Height = 255
Index = 2
Left = 135
TabIndex = 31
Top = 4455
Width = 3315
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = "温州东化计算机科技有限公司"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Index = 1
Left = 150
TabIndex = 30
Top = 4470
Width = 3315
End
End
Attribute VB_Name = "frmOption"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdAdd_Click()
On Error GoTo Err_Add
'查询Code
If GetCode(Trim(txtCode), "代码", "EatList") = False Then
MsgBox "对不起，该物品的代码已经存在，请修改代码后再添加。", vbOKOnly + vbInformation, "代码重复"
txtCode = ""
txtCode.SetFocus
Exit Sub
End If
'添加记录
AddRecord txtPM, "名称", CCur(txtDJ), "单价", txtDW, "单位", txtCode, "代码", "EatList"
'刷新
ConfigGrid
'恢复
txtPM = "": txtDJ = "": txtDW = "": txtCode = ""
txtPM.SetFocus
Exit Sub
Err_Add:
MsgBox "添加记录错误! " & vbCrLf & vbCrLf & Err.Description, vbCritical
End Sub
Private Sub cmdAddLine_Click()
' 添加到列表框
listLine.AddItem txtAddLine
txtAddLine.Text = ""
txtAddLine.SetFocus
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub cmdCloseLine_Click()
On Error GoTo Err_Line
' 保存
' 设定系统路径
Dim sFileBuffer As String * 250, retVal As Long, sSystemInI As String
retVal = GetSystemDirectory(sFileBuffer, 251)
If retVal = 0 Then
sSystemInI = "C:\Windows\System\Message.InI"
Else
sSystemInI = left(sFileBuffer, InStr(1, sFileBuffer, Chr(0), vbBinaryCompare) - 1)
sSystemInI = sSystemInI & "\Message.InI"
End If
Dim sTemp As String, lFile As Long
lFile = FreeFile
Open sSystemInI For Output As #lFile
Dim x As Long
For x = 0 To listLine.ListCount
If listLine.List(x) <> "" Then Print #lFile, listLine.List(x)
Next
Close lFile
Unload Me
Exit Sub
Err_Line:
MsgBox "添加行错误! " & vbCrLf & vbCrLf & Err.Description, vbCritical
End Sub
Private Sub cmdDel_Click()
On Error GoTo Err_del
If Grid1.Text = "" Then
MsgBox "请先选择一种物品后,再按删除按钮。 ", vbExclamation
End If
' 删除
If MsgBox("真的删除 [ " & Grid1.Text & " ] 吗？ ", vbYesNo + vbCritical) = vbNo Then
Exit Sub
End If
DelRecord Grid1.Text, "名称", "EatList"
' 刷新数据
Grid1.RemoveItem Grid1.Row
txtPM.SetFocus
Exit Sub
Err_del:
MsgBox "记录删除错误! " & vbCrLf & vbCrLf & Err.Description, vbCritical
End Sub
Private Sub cmdDelLine_Click()
On Error GoTo Err_lineDel
If listLine.ListIndex = -1 Then
MsgBox "请先选择需要删除的语句,然后按删除按钮。 ", vbExclamation
txtAddLine.SetFocus
Exit Sub
End If
' 删除
listLine.RemoveItem listLine.ListIndex
txtAddLine.SetFocus
Exit Sub
Err_lineDel:
MsgBox "行删除错误! " & vbCrLf & vbCrLf & Err.Description, vbCritical
End Sub
Private Sub cmdOK_Click()
On Error GoTo Err_Save
' 保存选项======================================================
AppName = "Option"
KeyName = "JE"
Value = txtJE
WriteInI '1/写金额数据
KeyName = "JS"
Value = txtJS
WriteInI '2/写计算机数
KeyName = "JFNotify"
Value = chkNotifyClient.Value
WriteInI '3/写计费时通知客户机
KeyName = "DXNotify"
Value = chkNotifyNoConnect.Value
WriteInI '4/写断线时通知
' 结束===========================================================
MsgBox "所有配置下次启动时生效！ ", vbInformation
Unload Me
Exit Sub
Err_Save:
MsgBox "保存选项错误! " & vbCrLf & vbCrLf & Err.Description, vbCritical
End Sub
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command3_Click()
If txtCompany = "" Then
txtCompany = "东化科技"
End If
If Val(txtCompanyLen) < 2 Then
txtCompanyLen = 8
End If
SaveSetting App.EXEName, "Option", "Company", txtCompany
SaveSetting App.EXEName, "Option", "CompanyLen", txtCompanyLen
sCompany = txtCompany
lCompany = Val(txtCompanyLen)
Unload Me
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If pic2.Visible = True Then
If KeyCode = 46 Then 'Del
If Shift = 1 Then
DelRecord Grid1.Text, "名称", "EatList"
' 刷新数据
Grid1.RemoveItem Grid1.Row
Else
cmdDel.Value = True
End If
End If
Exit Sub
End If
If pic3.Visible = True Then
If KeyCode = 46 Then 'Del
cmdDelLine.Value = True
End If
Exit Sub
End If
End Sub
Private Sub Form_Load()
FO = True
On Error GoTo Err_Load
Dim L As Long, T As Long
L = Val(GetSetting(App.EXEName, "Option", "Option_L", 2000))
T = Val(GetSetting(App.EXEName, "Option", "Option_T", 2000))
Me.left = L
Me.tOp = T
Screen.MousePointer = 11
' 安装原来数据
' 保存选项======================================================
AppName = "Option"
KeyName = "JE"
ReadInI '1/读 金额数据
txtJE = Result
KeyName = "JS"
ReadInI '2/读 计算机数
txtJS = Result
KeyName = "JFNotify"
ReadInI '3/读 计费时通知客户机
chkNotifyClient.Value = Result
KeyName = "DXNotify"
ReadInI '4/读 断线时通知
chkNotifyNoConnect.Value = Result
' 结束===========================================================
' 配置网格
ConfigGrid
' 配置消息
ConfigMessage
' 配置名称
txtCompany = sCompany
txtCompanyLen = lCompany
Screen.MousePointer = 0
Exit Sub
Err_Load:
MsgBox "表单加载错误! " & vbCrLf & vbCrLf & Err.Description, vbCritical
End Sub
Private Sub Form_Unload(Cancel As Integer)
FO = False
SaveSetting App.EXEName, "Option", "Option_L", Me.left
SaveSetting App.EXEName, "Option", "Option_T", Me.tOp
End Sub
Private Sub TabStrip1_Click()
If TabStrip1.SelectedItem.Key = "general" Then
pic1.Visible = True
Else
pic1.Visible = False
End If
If TabStrip1.SelectedItem.Key = "wupin" Then
pic2.Visible = True
txtPM.SetFocus
Else
pic2.Visible = False
End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -