📄 tianjia.frm
字号:
TabCaption(1) = "家庭情况"
TabPicture(1) = "tianjia.frx":001C
Tab(1).ControlEnabled= 0 'False
Tab(1).Control(0)= "Text13"
Tab(1).ControlCount= 1
TabCaption(2) = "奖罚情况"
TabPicture(2) = "tianjia.frx":0038
Tab(2).ControlEnabled= -1 'True
Tab(2).Control(0)= "Text14"
Tab(2).Control(0).Enabled= 0 'False
Tab(2).ControlCount= 1
Begin VB.TextBox Text12
Height = 1455
Left = -74880
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 7
Top = 480
Width = 7215
End
Begin VB.TextBox Text13
Height = 1455
Left = -74880
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 6
Top = 480
Width = 7215
End
Begin VB.TextBox Text14
Height = 1455
Left = 120
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 5
Top = 480
Width = 7095
End
End
End
Begin VB.Frame Frame4
Height = 3855
Left = 7800
TabIndex = 0
Top = 2400
Width = 1815
Begin VB.CommandButton Command1
Caption = "上传照片"
Height = 495
Left = 120
TabIndex = 2
Top = 240
Width = 1575
End
Begin VB.CommandButton Command4
Caption = "添 加"
Height = 495
Left = 120
TabIndex = 1
Top = 960
Width = 1575
End
End
Begin VB.Image Image1
BorderStyle = 1 'Fixed Single
Height = 2295
Left = 7800
Stretch = -1 'True
Top = 120
Width = 1815
End
End
Attribute VB_Name = "tianjia"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sql As String
Dim Chunk() As Byte
Dim lngLengh As Long
Dim intChunks As Integer
Dim intFragment As Integer
Dim PicPathName As String '我定义的图片路径和名称变量
Const ChunkSize = 1000
Const lngDataFile = 1
Private Sub Command1_Click()
On Error GoTo errhandler:
CommonDialog1.DialogTitle = "职工照片的选择"
CommonDialog1.Filter = "所有图形文件|*.bmp;*.gif;*.jpg;*.ico|位图文件(*.bmp;*.dib)|*.bmp;*.dib|GIF文件(*.gif)|*.gif|GPEG文件(*.jpg)|*.jpg|图形文件(*.ioc)|*.ioc"
CommonDialog1.ShowOpen
If CommonDialog1.FileName = "" Then Exit Sub
Image1.Picture = LoadPicture(CommonDialog1.FileName)
Exit Sub
errhandler:
MsgBox Err.Description, vbCritical, "错误"
End Sub
Private Sub Command4_Click()
If Trim(Text2.text) = "" Then
MsgBox "请输入职工编号"
Text2.SetFocus
Exit Sub
End If
If Trim(Text1.text) = "" Then
MsgBox "请输入姓名"
Text1.SetFocus
Exit Sub
End If
If Trim(Text3.text) = "" Then
MsgBox "请输入电话"
Text3.SetFocus
Exit Sub
End If
If Trim(Text4.text) = "" Then
MsgBox "请输入民族"
Text4.SetFocus
Exit Sub
End If
If Trim(Text6.text) = "" Then
MsgBox "请输入所学专业"
Text6.SetFocus
Exit Sub
End If
If Trim(Text7.text) = "" Then
MsgBox "请输入毕业院校"
Text7.SetFocus
Exit Sub
End If
If Trim(Text8.text) = "" Then
MsgBox "请输入手机"
Text8.SetFocus
Exit Sub
End If
If Trim(Text9.text) = "" Then
MsgBox "请输入地 址"
Text9.SetFocus
Exit Sub
End If
If Trim(Text10.text) = "" Then
MsgBox "请输入身份证号码"
Text10.SetFocus
Exit Sub
End If
If Trim(Text12.text) = "" Then
MsgBox "请输入个人简历"
Text12.SetFocus
Exit Sub
End If
If Trim(Text13.text) = "" Then
MsgBox "请输入家庭情况"
Text13.SetFocus
Exit Sub
End If
If Trim(Text14.text) = "" Then
MsgBox "请输入奖罚情况"
Text14.SetFocus
Exit Sub
End If
sql = "select * from info where code='" & Trim(Text2.text) & "'"
rs.Open sql
If rs.EOF = False Then
MsgBox "对不起，编号不能重复"
rs.Close
Text1.SetFocus
Exit Sub
End If
rs.Close
If Trim(CommonDialog1.FileName) = "" Then
MsgBox "未选择照片.!!", vbInformation + vbSystemModal, "不能保存"
Exit Sub
End If
If (Dir(Trim(CommonDialog1.FileName)) = "") Then Exit Sub
Open Trim(CommonDialog1.FileName) For Binary Access Read As lngDataFile
lngLengh = LOF(lngDataFile)
intChunks = lngLengh \ ChunkSize
intFragment = lngLengh Mod ChunkSize
sql = "select * from info"
rs.Open sql, conn, adOpenKeyset, adLockPessimistic
rs.AddNew
rs.Fields("code") = Trim(Text2.text)
rs.Fields("name") = Trim(Text1.text)
rs.Fields("sex") = Trim(Combo2.text)
rs.Fields("nation") = Trim(Text4.text)
rs.Fields("government") = Trim(Combo7.text)
rs.Fields("speciality") = Trim(Text6.text)
rs.Fields("department") = Trim(Combo4.text)
rs.Fields("number") = Trim(Text10.text)
rs.Fields("laborage") = Trim(Combo5.text)
rs.Fields("duty") = Trim(Combo3.text)
rs.Fields("zhicheng") = Trim(Combo6.text)
rs.Fields("time") = DTPicker2.Value
rs.Fields("birth") = DTPicker1.Value
rs.Fields("marry") = Trim(Combo1.text)
rs.Fields("family") = Trim(Text13.text)
rs.Fields("phone1") = Trim(Text3.text)
rs.Fields("phone2") = Trim(Text8.text)
rs.Fields("address") = Trim(Text9.text)
rs.Fields("jf") = Trim(Text14.text)
rs.Fields("graduate") = Trim(Text7.text)
rs.Fields("resume") = Trim(Text12.text)
ReDim Chunk(intFragment)
Get lngDataFile, , Chunk()
rs.Fields("photo").AppendChunk Chunk()
ReDim Chunk(ChunkSize)
For i = 1 To intChunks
Get lngDataFile, , Chunk()
rs.Fields("photo").AppendChunk Chunk()
Next i
rs.Update
Close lngDataFile
Call showpicture
rs.Update
rs.Close
If MsgBox("添加成功，是否继续添加", vbOKCancel, "提示") = vbOK Then
sql = "select * from info"
Call grid(rs, system.ListView1, system.StatusBar1, sql)
Text1.text = ""
Text2.text = ""
Text3.text = ""
Text4.text = ""
Text6.text = ""
Text7.text = ""
Text8.text = ""
Text9.text = ""
Text10.text = ""
Text12.text = ""
Text14.text = ""
Text13.text = ""
Combo2.ListIndex = 0
Combo7.ListIndex = 5
Combo4.ListIndex = 0
Combo1.ListIndex = 0
Combo3.ListIndex = 6
Combo6.ListIndex = 3
Combo5.ListIndex = 0
Else
sql = "select * from info"
Call grid(rs, system.ListView1, system.StatusBar1, sql)
Unload Me
End If
End Sub
Private Sub Form_Load()
Combo2.AddItem "男"
Combo2.AddItem "女"
Combo2.ListIndex = 0
Combo7.AddItem "共产党员"
Combo7.AddItem "九三学社"
Combo7.AddItem "国民党"
Combo7.AddItem "无党派"
Combo7.AddItem "团员"
Combo7.AddItem "其它"
Combo7.ListIndex = 5
Combo4.AddItem "人事部"
Combo4.AddItem "财务部"
Combo4.AddItem "保卫处"
Combo4.AddItem "宣传部"
Combo4.ListIndex = 0
Combo1.AddItem "未婚"
Combo1.AddItem "已婚"
Combo1.AddItem "离异"
Combo1.AddItem "丧偶"
Combo1.ListIndex = 0
Combo3.AddItem "总经理"
Combo3.AddItem "经理"
Combo3.AddItem "主任"
Combo3.AddItem "副主任"
Combo3.AddItem "科长"
Combo3.AddItem "副科长"
Combo3.AddItem "职工"
Combo3.AddItem "组长"
Combo3.ListIndex = 6
Combo6.AddItem "工程师"
Combo6.AddItem "高级工程师"
Combo6.AddItem "工程师助理"
Combo6.AddItem "无"
Combo6.ListIndex = 3
Combo5.AddItem "1000以下"
Combo5.AddItem "1000到1500"
Combo5.AddItem "1500到3000"
Combo5.AddItem "3000以上"
Combo5.ListIndex = 0
DTPicker1.Value = Now()
DTPicker2.Value = Now()
Call strsql(connstring)
conn.Open connstring
sql = "select * from info"
rs.Open sql, conn, adOpenKeyset, adLockPessimistic
rs.Close
End Sub
Private Sub Form_Unload(Cancel As Integer)
sql = "select * from info"
Call grid(rs, system.ListView1, system.StatusBar1, sql)
conn.Close
End Sub
Public Sub showpicture()
On Error Resume Next
Open "pictemp" For Binary Access Write As lngDataFile
lngLengh = rs!photo.ActualSize
intChunks = lngLengh \ ChunkSize
intFragment = lngLengh Mod ChunkSize
ReDim Chunk(intFragment)
Chunk() = rs!photo.GetChunk(intFragment)
Put lngDataFile, , Chunk()
For i = 1 To intChunks
ReDim Buffer(ChunkSize)
Chunk() = rs!photo.GetChunk(ChunkSize)
Put lngDataFile, , Chunk()
Next i
Close lngDataFile
FileName = "pictemp"
Image1.Picture = LoadPicture(FileName)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -