📄 涨幅调整.frm
字号:
VERSION 5.00
Begin VB.Form 涨幅调整
BorderStyle = 1 'Fixed Single
Caption = "涨幅调整"
ClientHeight = 2280
ClientLeft = 2820
ClientTop = 2910
ClientWidth = 6060
ControlBox = 0 'False
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
Moveable = 0 'False
ScaleHeight = 2280
ScaleWidth = 6060
Begin VB.TextBox Text2
Alignment = 1 'Right Justify
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 2310
TabIndex = 6
Top = 660
Visible = 0 'False
Width = 2535
End
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 285
Left = 240
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "涨幅调整"
Top = 1770
Visible = 0 'False
Width = 1725
End
Begin VB.TextBox Text3
Alignment = 1 'Right Justify
DataField = "涨幅调整"
DataSource = "Data1"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 2310
TabIndex = 4
Top = 60
Visible = 0 'False
Width = 2535
End
Begin VB.CommandButton Command2
Caption = "确 认"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4020
TabIndex = 3
Top = 1620
Width = 1425
End
Begin VB.CommandButton Command1
Caption = "取 消"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2580
TabIndex = 2
Top = 1620
Width = 1425
End
Begin VB.TextBox Text1
Alignment = 1 'Right Justify
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
IMEMode = 3 'DISABLE
Left = 2310
PasswordChar = "*"
TabIndex = 1
Top = 660
Width = 2535
End
Begin VB.Label Label2
Caption = "票价调整率："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 570
TabIndex = 5
Top = 690
Visible = 0 'False
Width = 1965
End
Begin VB.Label Label1
Caption = "请输入密码："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 570
TabIndex = 0
Top = 690
Width = 1455
End
End
Attribute VB_Name = "涨幅调整"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const REG_SZ = 1
'Const YaoWei = 3 ' Free form binary
Const HKEY_CURRENT_USER = &H80000001
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Dim Total As Integer, M As String
Private Sub Form_Load()
Data1.DatabaseName = App.Path + "\" + "列车客票.mdb"
M = GetString(HKEY_CURRENT_USER, "RegData\AA", "")
End Sub
Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
On Error GoTo A1
Dim lResult As Long, lValueType As Long, strBuf As String, lDataBufSize As Long
RegQueryValueEx hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize
strBuf = String(lDataBufSize, Chr$(0))
RegQueryValueEx hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize
RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
Exit Function
A1:
MsgBox " 注册表中没有数据，请输入数据 ！ "
Text1.Text = ""
Text1.SetFocus
End Function
Function GetString(hKey As Long, strPath As String, strValue As String)
Dim Ret
RegOpenKey hKey, strPath, Ret
GetString = RegQueryStringValue(Ret, strValue)
RegCloseKey Ret
End Function
Private Sub Text1_KeyPress(KeyAscii As Integer)
Dim X As Integer
If KeyAscii = 13 Then
If Text1 <> M Then
Total = Total + 1
If Total > 2 Then
X = MsgBox("您不能做票价调整 ！", vbExclamation, "提示信息")
If X = 1 Then
工作选项.Enabled = True
Unload Me
Exit Sub
End If
End If
MsgBox "您输入的密码不正确，请重新输入密码 ！ ", vbExclamation, "提示信息"
Text1 = ""
Else
Text1.Visible = False
Label1.Visible = False
Text2.Visible = True
Text2.SetFocus
Label2.Visible = True
End If
End If
End Sub
Private Sub Command1_Click()
工作选项.Enabled = True
Unload Me
End Sub
Private Sub Command2_Click()
工作选项.Enabled = True
Text3 = Val(Text2) / 100
Unload Me
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If IsNumeric(Text2) = False Then
MsgBox "请输入数据 ！ ", vbExclamation + vbOKOnly, "提示信息"
Text2 = ""
Text2.SetFocus
Else
Command2.Enabled = True
Command2.SetFocus
End If
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -