📄 zc.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form zcform
BackColor = &H0080C0FF&
BorderStyle = 1 'Fixed Single
Caption = "注册"
ClientHeight = 2925
ClientLeft = 4155
ClientTop = 2580
ClientWidth = 4050
Icon = "zc.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2925
ScaleWidth = 4050
Begin MSComCtl2.MonthView MonthView
Height = 2220
Left = 0
TabIndex = 15
Top = 0
Width = 4095
_ExtentX = 7223
_ExtentY = 3916
_Version = 393216
ForeColor = -2147483630
BackColor = -2147483633
BorderStyle = 1
Appearance = 1
MultiSelect = -1 'True
StartOfWeek = 24641537
CurrentDate = 36897
End
Begin VB.CommandButton Cmd
Appearance = 0 'Flat
Height = 375
Left = 2760
Picture = "zc.frx":0442
Style = 1 'Graphical
TabIndex = 14
Top = 240
Width = 375
End
Begin VB.TextBox sj
Appearance = 0 'Flat
ForeColor = &H00FF0000&
Height = 375
Left = 1440
TabIndex = 13
Top = 240
Width = 1455
End
Begin VB.TextBox qrmmtxt
Appearance = 0 'Flat
ForeColor = &H00FF0000&
Height = 330
IMEMode = 3 'DISABLE
Left = 1440
PasswordChar = "*"
TabIndex = 12
Top = 1920
Width = 1455
End
Begin VB.TextBox xmmtxt
Appearance = 0 'Flat
ForeColor = &H00FF0000&
Height = 330
IMEMode = 3 'DISABLE
Left = 1440
PasswordChar = "*"
TabIndex = 10
Top = 1440
Width = 1455
End
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 345
Left = 3480
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 0
Visible = 0 'False
Width = 1140
End
Begin VB.CheckBox chkmm
Appearance = 0 'Flat
BackColor = &H0080C0FF&
Caption = "修改密码"
ForeColor = &H00FF0000&
Height = 375
Left = 3000
TabIndex = 8
Top = 960
Width = 1095
End
Begin VB.CommandButton CmdOK
Caption = "确定"
Default = -1 'True
Height = 375
Left = 360
Picture = "zc.frx":05CC
Style = 1 'Graphical
TabIndex = 7
Top = 2400
Width = 975
End
Begin VB.CommandButton CmdNO
Caption = "取消"
Height = 375
Left = 2760
Picture = "zc.frx":08D6
Style = 1 'Graphical
TabIndex = 6
Top = 2400
Width = 975
End
Begin VB.PictureBox Picture1
BackColor = &H0080C0FF&
BorderStyle = 0 'None
Height = 615
Left = 3240
Picture = "zc.frx":0BE0
ScaleHeight = 615
ScaleWidth = 495
TabIndex = 5
Top = 120
Width = 495
End
Begin VB.ComboBox cmbname
Appearance = 0 'Flat
ForeColor = &H00FF0000&
Height = 300
ItemData = "zc.frx":1022
Left = 1440
List = "zc.frx":1024
Style = 2 'Dropdown List
TabIndex = 2
Top = 720
Width = 1455
End
Begin VB.TextBox txtmm
Appearance = 0 'Flat
ForeColor = &H00FF0000&
Height = 330
IMEMode = 3 'DISABLE
Left = 1440
PasswordChar = "*"
TabIndex = 0
Top = 1080
Width = 1455
End
Begin VB.Label qrmmlb
BackColor = &H0080C0FF&
Caption = "确认密码："
ForeColor = &H00FF0000&
Height = 255
Left = 480
TabIndex = 11
Top = 2040
Width = 975
End
Begin VB.Label xmmlb
BackColor = &H0080C0FF&
Caption = "新密码："
ForeColor = &H00FF0000&
Height = 255
Left = 480
TabIndex = 9
Top = 1560
Width = 975
End
Begin VB.Label Label3
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "时间："
ForeColor = &H00FF0000&
Height = 255
Left = 480
TabIndex = 4
Top = 240
Width = 975
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "操作员："
ForeColor = &H00FF0000&
Height = 255
Left = 480
TabIndex = 3
Top = 720
Width = 975
End
Begin VB.Label Label2
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "密码："
ForeColor = &H00FF0000&
Height = 255
Left = 480
TabIndex = 1
Top = 1080
Width = 975
End
End
Attribute VB_Name = "zcform"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Download by http://www.codefans.net
Public dbs As Database
Public rec As Recordset
Public czy As String
Public filename As String
Private Sub chkmm_Click()
If chkmm.Value = 1 Then
zcform.Height = 3210
xmmlb.Visible = True
qrmmlb.Visible = True
xmmtxt.Visible = True
qrmmtxt.Visible = True
CmdOK.Move 240, 2440
CmdNO.Move 2760, 2440
Else
xmmlb.Visible = False
qrmmlb.Visible = False
xmmtxt.Visible = False
qrmmtxt.Visible = False
CmdOK.Move 240, 1440
CmdNO.Move 2760, 1440
zcform.Height = 2250
End If
End Sub
Private Sub cmbname_Change()
r = MsgBox("非法用户,拒绝操作！", 0 + 16, "个人股票管理")
End
End Sub
Private Sub Cmd_Click()
MonthView.Visible = True
End Sub
Private Sub CmdOK_Click()
czy = cmbname.Text
filename = App.Path & "\股票.mdb"
Set dbs = OpenDatabase(filename)
Set rec = dbs.OpenRecordset("操作员")
If chkmm.Value = 1 Then
If cmbname.Text = "" Then
r = MsgBox("操作员没选！拒绝访问", 0 + 16, "个人股票管理")
Exit Sub
End If
rec.MoveFirst
'判断密码
Do While Not rec.EOF
If rec.Fields("姓名") = cmbname.Text Then
Let mm = Trim(rec.Fields("密码"))
End If
rec.MoveNext
Loop
If Trim(txtmm.Text) = mm Then
If xmmtxt.Text <> qrmmtxt.Text Then
r = MsgBox("新密码不一致，请重填！", 0 + 16, "个人股票管理")
xmmtxt.Text = ""
qrmmtxt.Text = ""
xmmtxt.Text = ""
Else
rec.Index = "PrimaryKey"
rec.Seek "=", cmbname.Text
rec.edit
rec.Fields(1) = xmmtxt.Text
rec.Update
r = MsgBox("密码修改成功！", 0 + 64, "个人股票管理")
Unload Me
jm.Show
frmgu.Show
Unload frmgu
End If
Else
r = MsgBox("旧密码出错！拒绝访问", 0 + 16, "个人股票管理")
txtmm.Text = ""
txtmm.SetFocus
Exit Sub
End If
Else
If cmbname.Text = "" Then
r = MsgBox("操作员没选！拒绝访问", 0 + 16, "个人股票管理")
Exit Sub
End If
rec.MoveFirst
'判断密码
Do While Not rec.EOF
If rec.Fields("姓名") = cmbname.Text Then
Let mm = Trim(rec.Fields("密码"))
End If
rec.MoveNext
Loop
If Trim(txtmm.Text) = mm Then
czy = cmbname.Text
Unload Me
jm.Show
frmgu.Show
Unload frmgu
Else
r = MsgBox("操作员密码出错！拒绝访问", 0 + 16, "个人股票管理")
txtmm.Text = ""
txtmm.SetFocus
End If
End If
jm.sbrDB.Panels(1).Text = czy
jm.sbrDB.Panels(2).Text = sj.Text
dbs.Close
End Sub
Private Sub CmdNO_Click()
Unload Me
End Sub
Private Sub Command3_Click()
d.Visible = True
End Sub
Private Sub Form_Load()
MonthView.Visible = False
xmmlb.Visible = False
qrmmlb.Visible = False
xmmtxt.Visible = False
qrmmtxt.Visible = False
CmdOK.Move 240, 1440
CmdNO.Move 2760, 1440
zcform.Height = 2250
On Error GoTo NoFind
filename = App.Path & "\股票.mdb"
Set dbs = OpenDatabase(filename)
Set rec = dbs.OpenRecordset("操作员")
Do While Not rec.EOF
cmbname.AddItem rec.Fields(0)
rec.MoveNext
Loop
sj.Text = Date
cmbname.ListIndex = 0
NoFind:
If Err.Number = 3044 Then
MsgBox "数据文件丢失,请检查后在使用！", 16, "登录"
End
End If
End Sub
Private Sub MonthView_DateClick(ByVal DateClicked As Date)
sj.Text = MonthView.Value
MonthView.Visible = False
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -