📄 frmsxh.frm
字号:
VERSION 5.00
Object = "{90F3D7B3-92E7-44BA-B444-6A8E2A3BC375}#1.0#0"; "actskin4.ocx"
Begin VB.Form frmsxh
BorderStyle = 3 'Fixed Dialog
Caption = "三项之和设置"
ClientHeight = 2520
ClientLeft = 45
ClientTop = 435
ClientWidth = 6045
Icon = "frmsxh.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2520
ScaleWidth = 6045
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command2
Caption = "退出设置"
Height = 525
Left = 4890
TabIndex = 7
Top = 1770
Width = 1065
End
Begin VB.CommandButton Command1
Caption = "确 定"
Height = 525
Left = 4890
TabIndex = 3
Top = 990
Width = 1065
End
Begin VB.Frame Frame1
Caption = "设置"
Height = 1635
Left = 90
TabIndex = 6
Top = 780
Width = 4665
Begin VB.TextBox Text3
Alignment = 2 'Center
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 345
Left = 3420
TabIndex = 2
Top = 1110
Width = 525
End
Begin VB.TextBox Text2
Alignment = 2 'Center
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 345
Left = 1950
TabIndex = 1
Top = 1110
Width = 525
End
Begin VB.TextBox Text1
Alignment = 2 'Center
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 345
Left = 420
TabIndex = 0
Top = 1110
Width = 525
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel4
Height = 375
Index = 2
Left = 390
OleObjectBlob = "frmsxh.frx":030A
TabIndex = 8
Top = 270
Width = 945
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel4
Height = 375
Index = 3
Left = 3270
OleObjectBlob = "frmsxh.frx":0365
TabIndex = 9
Top = 270
Width = 945
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel4
Height = 375
Index = 4
Left = 1830
OleObjectBlob = "frmsxh.frx":03C0
TabIndex = 10
Top = 270
Width = 945
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel4
Height = 255
Index = 5
Left = 690
OleObjectBlob = "frmsxh.frx":041B
TabIndex = 11
Top = 690
Width = 225
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel4
Height = 255
Index = 6
Left = 3600
OleObjectBlob = "frmsxh.frx":0473
TabIndex = 12
Top = 720
Width = 225
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel4
Height = 255
Index = 7
Left = 2100
OleObjectBlob = "frmsxh.frx":04CB
TabIndex = 13
Top = 720
Width = 225
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel4
Height = 555
Index = 8
Left = 1380
OleObjectBlob = "frmsxh.frx":0523
TabIndex = 14
Top = 540
Width = 285
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel4
Height = 555
Index = 9
Left = 2850
OleObjectBlob = "frmsxh.frx":057B
TabIndex = 15
Top = 540
Width = 285
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel4
Height = 555
Index = 10
Left = 1080
OleObjectBlob = "frmsxh.frx":05D3
TabIndex = 16
Top = 1050
Width = 285
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel4
Height = 555
Index = 11
Left = 4080
OleObjectBlob = "frmsxh.frx":062A
TabIndex = 17
Top = 1050
Width = 285
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel4
Height = 555
Index = 12
Left = 2610
OleObjectBlob = "frmsxh.frx":0681
TabIndex = 18
Top = 1050
Width = 285
End
End
Begin ACTIVESKINLibCtl.Skin Skin1
Left = 4680
OleObjectBlob = "frmsxh.frx":06D8
Top = 1170
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel4
Height = 285
Index = 0
Left = 375
OleObjectBlob = "frmsxh.frx":104499
TabIndex = 4
Top = 120
Width = 5295
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel4
Height = 285
Index = 1
Left = 180
OleObjectBlob = "frmsxh.frx":104526
TabIndex = 5
Top = 420
Width = 5685
End
End
Attribute VB_Name = "frmsxh"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command2_Click()
On Error Resume Next
Unload Me
End Sub
'下面的代码可以关闭所有打开的 DAO workspace，并释放所占的内存。
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
MAIN.Enabled = True
Dim ws As Workspace
Dim db As Database
Dim rs As Recordset
For Each ws In Workspaces
For Each db In ws.Databases
For Each rs In db.Recordsets
rs.Close
Set rs = Nothing
Next
db.Close
Set db = Nothing
Next
ws.Close
Set ws = Nothing
Next
End Sub
Function ValiText(KeyIn As Integer, ValidateString As String, _
Editable As Boolean) As Integer
Dim ValidateList As String
Dim KeyOut As Integer
If Editable = True Then
ValidateList = UCase(ValidateString) & Chr(8)
Else
ValidateList = UCase(ValidateString)
End If
If InStr(1, ValidateList, UCase(Chr(KeyIn)), 1) > 0 Then
KeyOut = KeyIn
Else
KeyOut = 0
Beep
End If
ValiText = KeyOut
End Function
Private Sub Command1_Click()
On Error GoTo 32755
Dim success As Long
If Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Or Text1.Text > 100 Or Text2.Text > 100 Or Text3.Text > 100 Or Val(Text3) + Val(Text2) + Val(Text1) > 100 Then
MsgBox "输入值有误,请输入正确数值", 64, "请输入有误"
Exit Sub
Else
success = WritePrivateProfileString("三项之和", "平均", Text1.Text, App.Path & "\SET.ini")
success = WritePrivateProfileString("三项之和", "优秀", Text2.Text, App.Path & "\SET.ini")
success = WritePrivateProfileString("三项之和", "及格", Text3.Text, App.Path & "\SET.ini")
Unload Me
End If
32755:
Select Case Err.Number
Case 13
MsgBox "输入值有误,请输入正确数值", 64, "请输入有误"
End Select
End Sub
Private Sub Form_Load()
On Error Resume Next
Dim ret As Long
Dim buff As String
buff = String(255, 0)
ret = GetPrivateProfileString("三项之和", "平均", Text1.Text, buff, 256, App.Path & "\SET.ini")
'若.ini MyApp中无text1，则采用叁数三的值
Text1.Text = buff
Dim retA As Long
Dim buffA As String
buffA = String(255, 0)
retA = GetPrivateProfileString("三项之和", "优秀", Text2.Text, buffA, 256, App.Path & "\SET.ini")
'若.ini MyApp中无text1，则采用叁数三的值
Text2.Text = buffA
Dim retV As Long
Dim buffV As String
buffV = String(255, 0)
retV = GetPrivateProfileString("三项之和", "及格", Text3.Text, buffV, 256, App.Path & "\SET.ini")
'若.ini MyApp中无text1，则采用叁数三的值
Text3.Text = buffV
prevWndProc = GetWindowLong(Text1.hwnd, GWL_WNDPROC)
SetWindowLong Text1.hwnd, GWL_WNDPROC, AddressOf WndProc
prevWndProc = GetWindowLong(Text2.hwnd, GWL_WNDPROC)
SetWindowLong Text2.hwnd, GWL_WNDPROC, AddressOf WndProc
prevWndProc = GetWindowLong(Text3.hwnd, GWL_WNDPROC)
SetWindowLong Text3.hwnd, GWL_WNDPROC, AddressOf WndProc
' Skin1.LoadSkin App.Path & "\SKIN\4.sk"
Skin1.ApplySkin Me.hwnd
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
On Error Resume Next
KeyAscii = ValiText(KeyAscii, "0123456789.", True)
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
On Error Resume Next
KeyAscii = ValiText(KeyAscii, "0123456789.", True)
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
On Error Resume Next
KeyAscii = ValiText(KeyAscii, "0123456789.", True)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -