📄 frmcyzc.frm
字号:
VERSION 5.00
Object = "{F0D2F211-CCB0-11D0-A316-00AA00688B10}#1.0#0"; "MSDATLST.OCX"
Begin VB.Form frmCyzc
BorderStyle = 3 'Fixed Dialog
Caption = "家庭成员登记"
ClientHeight = 7230
ClientLeft = 465
ClientTop = 1635
ClientWidth = 7245
HelpContextID = 1
Icon = "frmCyzc.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7230
ScaleWidth = 7245
ShowInTaskbar = 0 'False
StartUpPosition = 1 '所有者中心
WhatsThisButton = -1 'True
WhatsThisHelp = -1 'True
Begin VB.CommandButton cmdExit
Cancel = -1 'True
Caption = "关闭"
Height = 360
Left = 5280
TabIndex = 8
Tag = "确定"
Top = 6720
Width = 1380
End
Begin VB.Frame Frame1
Height = 6375
Left = 120
TabIndex = 9
Top = 120
Width = 6975
Begin MSDataListLib.DataList dblCyqd
Height = 2370
Left = 240
TabIndex = 14
Top = 480
Width = 2055
_ExtentX = 3625
_ExtentY = 4180
_Version = 393216
ListField = ""
BoundColumn = ""
End
Begin VB.CommandButton cmdSaveZp
Caption = "照片存档"
Height = 300
Left = 360
TabIndex = 5
Top = 5880
Width = 1815
End
Begin VB.CheckBox chkQx
Caption = "管理家庭帐务"
Enabled = 0 'False
Height = 255
Left = 3360
TabIndex = 13
TabStop = 0 'False
Top = 1320
Width = 1575
End
Begin VB.TextBox txtName
Height = 300
Left = 3240
MaxLength = 8
TabIndex = 0
Top = 360
Width = 1935
End
Begin VB.TextBox txtPassword
Height = 300
IMEMode = 3 'DISABLE
Left = 3240
MaxLength = 8
PasswordChar = "*"
TabIndex = 1
Top = 840
Width = 1935
End
Begin VB.CommandButton cmdOpenzp
Caption = "从文件取照片"
Height = 300
Left = 360
TabIndex = 4
Top = 5520
Width = 1815
End
Begin VB.CommandButton cmdAdd
Caption = "添加(&A)"
Height = 375
Left = 5400
TabIndex = 6
Top = 600
Width = 1275
End
Begin VB.CommandButton cmdDel
Caption = "删除(&D)"
Height = 375
Left = 5400
TabIndex = 7
Top = 1080
Width = 1275
End
Begin VB.TextBox txtBz
Height = 3855
Left = 2640
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 3
Top = 2280
Width = 4095
End
Begin VB.CheckBox chkZt
Caption = "暂停使用"
Height = 255
Left = 3360
TabIndex = 2
Top = 1680
Width = 1215
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "家庭成员:"
Height = 180
Index = 2
Left = 240
TabIndex = 15
Top = 240
Width = 810
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "姓名:"
Height = 180
Index = 0
Left = 2640
TabIndex = 12
Top = 360
Width = 450
End
Begin VB.Image imgZp
BorderStyle = 1 'Fixed Single
Height = 2415
Left = 240
Stretch = -1 'True
Top = 3000
Width = 2055
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "密码:"
Height = 180
Index = 1
Left = 2640
TabIndex = 11
Top = 840
Width = 450
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "备注:"
Height = 180
Index = 3
Left = 2640
TabIndex = 10
Top = 2040
Width = 450
End
End
End
Attribute VB_Name = "frmCyzc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim WithEvents rs As ADODB.Recordset
Attribute rs.VB_VarHelpID = -1
Dim mstrZpFile As String
Private Sub cmdAdd_Click()
'追加新记录
rs.AddNew
rs("姓名") = ""
rs("管理权") = 0
rs("停用状态") = 1
txtName.SetFocus
End Sub
Private Sub cmdDel_Click()
'删除记录
If Not (rs.EOF Or rs.BOF) Then
rs.Delete
rs.MoveNext
End If
End Sub
Private Sub cmdExit_Click()
On Error Resume Next
rs.Update
Unload Me
End Sub
Private Sub cmdOpenzp_Click()
On Error Resume Next
'调用过程取得图片文件路径
mstrZpFile = fMain.File_Open("*.BMP;*.JPG;*.GIF|*.BMP;*.JPG;" _
& "*.GIF|*.BMP|*.BMP|*.JPG|*.JPG|*.GIF|*.GIF|*.*|*.*", "从文件取照片")
If mstrZpFile = "" Then Exit Sub
imgZp.Picture = LoadPicture(mstrZpFile)
End Sub
Private Sub cmdSaveZp_Click()
SaveZp '调用过程保存图片
End Sub
Private Sub dblCyqd_Click()
Dim strName As String
strName = dblCyqd.Text
rs.MoveFirst
rs.Find "姓名='" & strName & "'"
End Sub
Private Sub Form_Load()
On Error Resume Next
DbeJcgl.rsCYDJ.Open
Set rs = DbeJcgl.rsCYDJ
Set dblCyqd.RowSource = rs
dblCyqd.ListField = "姓名"
Set txtName.DataSource = rs
txtName.DataField = "姓名"
Set txtPassword.DataSource = rs
txtPassword.DataField = "密码"
Set txtBz.DataSource = rs
txtBz.DataField = "备注"
Set chkZt.DataSource = rs
chkZt.DataField = "停用状态"
Set chkQx.DataSource = rs
chkQx.DataField = "管理权"
Set imgZp.DataSource = rs
imgZp.DataField = "照片"
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
On Error Resume Next
If rs.EditMode = adEditAdd Or rs.EditMode = adEditInProgress Then
Cancel = 1
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
rs.Close
Set rs = Nothing
End Sub
Private Sub imgZp_Click()
Dim frmNewWin As New frmZp
frmNewWin.Image1.Picture = imgZp.Picture
frmNewWin.Show vbModal
Set frmNewWin = Nothing
End Sub
Private Sub rs_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
If rs.AbsolutePosition < 1 Then
txtName.Enabled = False
txtPassword.Enabled = False
chkZt.Enabled = False
txtBz.Enabled = False
cmdOpenzp.Enabled = False
cmdSaveZp.Enabled = False
cmdDel.Enabled = False
Else
txtName.Enabled = True
txtPassword.Enabled = True
txtBz.Enabled = True
cmdOpenzp.Enabled = True
cmdSaveZp.Enabled = True
If rs("管理权") Then
cmdDel.Enabled = False
chkZt.Enabled = False
Else
cmdDel.Enabled = True
chkZt.Enabled = True
End If
End If
End Sub
Private Sub txtName_LostFocus()
'检验数据
On Error GoTo errBar
rs.Update
If Trim(rs("姓名")) = "" Then
rs.Delete
rs.MoveNext
End If
errBar:
If Err = -2147467259 Then
MsgBox "姓名发生冲突", vbExclamation
txtName.SetFocus
End If
End Sub
Private Sub SaveZp()
'保存图片到数据库
On Error Resume Next
Dim DataFile As Integer, FileLong As Long, Chunks As Integer
Dim Fragment As Integer, Chunk() As Byte, I As Integer
Const ChunkSize As Integer = 16384
Dim strName As String
If mstrZpFile = "" Then Exit Sub
strName = rs("姓名")
DataFile = 1
Open mstrZpFile For Binary Access Read As DataFile
FileLong = LOF(DataFile) ' 文件中数据长度
If FileLong = 0 Then
Close DataFile
Exit Sub
End If
Chunks = FileLong \ ChunkSize
Fragment = FileLong Mod ChunkSize
ReDim Chunk(Fragment)
Get DataFile, , Chunk()
rs("照片").AppendChunk Chunk()
ReDim Chunk(ChunkSize)
For I = 1 To Chunks
Get DataFile, , Chunk()
rs("照片").AppendChunk Chunk()
Next I
Close DataFile
rs.Update
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -