📄 edks1.frm
字号:
Left = 2910
TabIndex = 13
Top = 1560
Width = 2235
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "姓 名*"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 210
Index = 0
Left = 540
TabIndex = 12
Top = 1050
Width = 825
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "通信地址"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 210
Index = 1
Left = 465
TabIndex = 11
Top = 2040
Width = 915
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "邮政编码"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 210
Index = 2
Left = 435
TabIndex = 10
Top = 2520
Width = 915
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "准考证号"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 210
Index = 4
Left = 405
TabIndex = 9
Top = 3000
Width = 915
End
End
Begin VB.CommandButton comm1
Caption = "确定"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 510
Left = 2220
TabIndex = 6
Top = 4590
Width = 960
End
Begin VB.CommandButton comm2
Caption = "取消"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 510
Left = 3705
TabIndex = 7
Top = 4590
Width = 960
End
End
Attribute VB_Name = "edks1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const BlockSize = 100000
Dim NumBlocks As Integer
Dim FileLength As Long
Dim LeftOver As Long
Dim i As Integer
Dim n As Integer
Dim ByteData() As Byte
Dim FileName As String
Dim FileNum As Integer
Dim DiskFile As String
Private Sub Form_Load()
sel = False
DiskFile = App.Path & "\image1.bmp" '设置临时文件名
If flag = 2 Then '修改操作
Text1(0).Text = Trim(edks.Adodc1.Recordset.Fields("报名号"))
Text1(1).Text = Trim(edks.Adodc1.Recordset.Fields("姓名")) & ""
If edks.Adodc1.Recordset.Fields("性别") = "男" Then
Opt1.Value = True
ElseIf edks.Adodc1.Recordset.Fields("性别") = "女" Then
Opt2.Value = True
End If
Text1(2).Text = Trim(edks.Adodc1.Recordset.Fields("出生日期")) & ""
Text1(3).Text = Trim(edks.Adodc1.Recordset.Fields("通信地址")) & ""
Text1(4).Text = Trim(edks.Adodc1.Recordset.Fields("邮政编码")) & ""
Text1(5).Text = Trim(edks.Adodc1.Recordset.Fields("准考证号")) & ""
If edks.Adodc1.Recordset.Fields("照片长度") > 0 Then
'将当前记录的照片数据存放到临时文件image1.bmp中
Me.MousePointer = vbHourglass
FileLength = edks.Adodc1.Recordset("照片长度")
If FileLength > 10000 Then
n = 5
Else
n = 10
End If
If Len(Dir$(DiskFile)) > 0 Then
Kill DiskFile '删除原来存在的临时文件
End If
FileNum = FreeFile()
Open DiskFile For Binary Access Write As FileNum '打开文件
NumBlocks = FileLength \ (BlockSize \ n)
LeftOver = FileLength Mod (BlockSize \ n) '余下的长度
ReDim ByteData(BlockSize \ n)
For i = 1 To NumBlocks
ByteData() = edks.Adodc1.Recordset("照片").GetChunk(BlockSize \ n)
Put FileNum, , ByteData
Next i
If LeftOver > 0 Then
ReDim ByteData(LeftOver)
ByteData() = edks.Adodc1.Recordset("照片").GetChunk(LeftOver)
Put FileNum, , ByteData
End If
Close FileNum '关闭文件
Image1.Picture = LoadPicture(DiskFile)
Me.MousePointer = vbNormal
Else
Image1.Picture = LoadPicture()
End If
Else '添加操作
Image1.Picture = LoadPicture()
Num = Num + 1
Text1(0).Text = Trim(Str(Num))
End If
End Sub
Private Sub Comm1_Click()
If Trim(Text1(1).Text) = "" Then
MsgBox "加*数据项不能为空,请重新设置", vbOKOnly, "信息提示"
Text1(1).SetFocus
Exit Sub
End If
If Trim(Text1(2).Text) <> "" Then
If Not IsDate(Trim(Text1(2).Text)) Then
MsgBox "出生日期输入不正确,重新输入", vbOKOnly, "信息提示"
Text1(1).SetFocus
Exit Sub
End If
End If
If flag = 1 Then '添加操作
recs = recs + 1
edks.Adodc1.Recordset.AddNew
End If
edks.Adodc1.Recordset.Fields("报名号") = Trim(Text1(0).Text)
edks.Adodc1.Recordset.Fields("姓名") = Trim(Text1(1).Text)
If Opt1.Value = True Then
edks.Adodc1.Recordset.Fields("性别") = "男"
ElseIf Opt2.Value = True Then
edks.Adodc1.Recordset.Fields("性别") = "女"
Else
edks.Adodc1.Recordset.Fields("性别") = ""
End If
If Trim(Text1(2).Text) <> "" Then
edks.Adodc1.Recordset.Fields("出生日期") = Format(Trim(Text1(2).Text), "yyyy-mm-dd")
End If
edks.Adodc1.Recordset.Fields("通信地址") = Trim(Text1(3).Text)
edks.Adodc1.Recordset.Fields("邮政编码") = Trim(Text1(4).Text)
edks.Adodc1.Recordset.Fields("合格否") = False
edks.Adodc1.Recordset.Fields("数学") = 0
edks.Adodc1.Recordset.Fields("外语") = 0
edks.Adodc1.Recordset.Fields("政治") = 0
edks.Adodc1.Recordset.Fields("专业课") = 0
edks.Adodc1.Recordset.Fields("总分") = 0
FileName = Trim(CommonDialog1.FileName) '将图像文件数据写到照片字段中
If sel = True Then '用户指定了新图像
Image1.Picture = LoadPicture(FileName)
Me.MousePointer = vbHourglass
FileNum = FreeFile()
Open FileName For Binary Access Read As FileNum '打开临时文件
FileLength = LOF(FileNum)
If FileLength = 0 Then
Close FileNum
MsgBox "指定的图像文件不存在", 0, "信息提示"
Else
NumBlocks = FileLength \ BlockSize '块数
LeftOver = FileLength Mod BlockSize '余下的长度
ReDim ByteData(LeftOver)
Get FileNum, , ByteData()
edks.Adodc1.Recordset("照片").AppendChunk ByteData()
ReDim ByteData(BlockSize)
For i = 1 To NumBlocks
Get FileNum, , ByteData()
edks.Adodc1.Recordset("照片").AppendChunk ByteData()
Next i
edks.Adodc1.Recordset("照片长度") = FileLength
End If
Close FileNum
Me.MousePointer = vbNormal
End If
edks.Adodc1.Recordset.Update
Unload Me
End Sub
Private Sub Comm2_Click()
Unload Me
End Sub
Private Sub SelCom_Click()
With CommonDialog1
.Filter = "pictures(*.bmp;*.jpg|*.bmp;*.jpg"
.ShowOpen
End With
If CommonDialog1.FileName <> "" Then
Image1.Picture = LoadPicture(CommonDialog1.FileName)
sel = True
End If
End Sub
Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
Call endata(KeyAscii)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -