📄 form1.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1
BorderStyle = 3 'Fixed Dialog
Caption = "Form1"
ClientHeight = 7350
ClientLeft = 45
ClientTop = 435
ClientWidth = 7890
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7350
ScaleWidth = 7890
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin MSComDlg.CommonDialog CommonDialog1
Left = 3720
Top = 3480
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton cmdClear
Caption = "Clear"
Height = 495
Left = 5160
TabIndex = 17
Top = 6720
Width = 1215
End
Begin VB.CommandButton cmdSave
Caption = "Save"
Height = 495
Left = 3840
TabIndex = 10
Top = 6720
Width = 1215
End
Begin VB.CommandButton cmdFirst
Caption = "<<"
Height = 495
Left = 1920
TabIndex = 11
Top = 6720
Width = 375
End
Begin VB.CommandButton cmdPrevious
Caption = "<"
Height = 495
Left = 2400
TabIndex = 12
Top = 6720
Width = 375
End
Begin VB.CommandButton cmdNext
Caption = ">"
Height = 495
Left = 2880
TabIndex = 13
Top = 6720
Width = 375
End
Begin VB.CommandButton cmdLast
Caption = ">>"
Height = 495
Left = 3360
TabIndex = 14
Top = 6720
Width = 375
End
Begin VB.TextBox txtFName
Height = 495
Left = 1920
TabIndex = 1
Text = "Text1"
Top = 360
Width = 3015
End
Begin VB.TextBox txtMName
Height = 495
Left = 1920
TabIndex = 3
Text = "Text2"
Top = 960
Width = 3015
End
Begin VB.TextBox txtLName
Height = 495
Left = 1920
TabIndex = 5
Text = "Text3"
Top = 1560
Width = 3015
End
Begin VB.TextBox txtSSN
Height = 495
Left = 1920
TabIndex = 7
Text = "Text5"
Top = 2160
Width = 3015
End
Begin VB.TextBox txtNotes
Height = 3855
Left = 1920
MultiLine = -1 'True
OLEDropMode = 1 'Manual
TabIndex = 9
Text = "Form1.frx":0000
Top = 2760
Width = 5775
End
Begin VB.CommandButton cmdClose
Caption = "Exit"
Height = 495
Left = 6480
TabIndex = 16
Top = 6720
Width = 1215
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "&Notes"
BeginProperty Font
Name = "Verdana"
Size = 9
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 1110
TabIndex = 8
Top = 2760
Width = 570
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "&SSN"
BeginProperty Font
Name = "Verdana"
Size = 9
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 1260
TabIndex = 6
Top = 2310
Width = 420
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "&Last Name"
BeginProperty Font
Name = "Verdana"
Size = 9
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 630
TabIndex = 4
Top = 1710
Width = 1050
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "&Middle Name"
BeginProperty Font
Name = "Verdana"
Size = 9
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 405
TabIndex = 2
Top = 1110
Width = 1275
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "&First Name"
BeginProperty Font
Name = "Verdana"
Size = 9
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 600
TabIndex = 0
Top = 510
Width = 1080
End
Begin VB.Image Image1
BorderStyle = 1 'Fixed Single
Height = 2295
Left = 5160
OLEDropMode = 1 'Manual
Stretch = -1 'True
Top = 360
Width = 2535
End
Begin VB.Label Label3
Caption = $"Form1.frx":0007
Height = 1455
Left = 5520
TabIndex = 15
Top = 840
Width = 1695
WordWrap = -1 'True
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'***********************************************************************************
' Store and Retrive Images from Access DB
' --Illustrates how to store and retrive images from an Access DB
'
' Version Info
' ------------
' v1.0 08/14/2001 Pyash Origination
' v1.1 02/22/2006 Pyash Add OLE Drag and Drop capability to assign an image to
' the Employee
' v1.2 02/25/2006 Pyash Added Name and Note fields to the DB and form
' v1.3 10/11/2006 Pyash Modified the ReadPictureData routine to create the temp
' directory in the app.path
'***********************************************************************************
Option Explicit
Const BLOCK_SIZE As Long = 100000 'bytes
Dim cnnEmp As ADODB.Connection
Dim rsEMP As ADODB.Recordset
Dim fileSize As Long
Dim fileName As String
Private Sub Form_Load()
Set cnnEmp = New ADODB.Connection
Set rsEMP = New ADODB.Recordset
'Open the Database connection
With cnnEmp
.Provider = "microsoft.jet.oledb.4.0"
.CursorLocation = adUseClient
.Open App.Path & "\BLOB.mdb"
End With
' Open the EMP table.
Dim sSQL As String
sSQL = "select * " & _
" from employee"
With rsEMP
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Open sSQL, cnnEmp
End With
ClearFields
End Sub
'*****************************************************************************
'* ClearFields()
'* --Clears the Form
'*****************************************************************************
Private Sub ClearFields()
Dim con As Control
For Each con In Controls
If TypeOf con Is TextBox Then
con.Text = ""
ElseIf TypeOf con Is Image Then
con.Picture = Nothing
End If
Next
End Sub
'*****************************************************************************
'* ValidateData()
'* --Validates the employee information
'*****************************************************************************
Private Function ValidateData() As Boolean
If Trim(txtFName) = "" Then
ValidateData = False
MsgBox "Employee's First Name can't be Null"
ElseIf Trim(txtMName) = "" Then
ValidateData = False
MsgBox "Employee's Middle Name can't be Null"
ElseIf Trim(txtLName) = "" Then
ValidateData = False
MsgBox "Employee's Last Name can't be Null"
ElseIf Trim(txtSSN) = "" Then
ValidateData = False
MsgBox "Employee's SSN can't be Null"
ElseIf Len(Dir(fileName)) = 0 Or fileName = "" Then
ValidateData = False
MsgBox "Couldn't locate Employee's Photo"
Else
ValidateData = True
End If
End Function
'*****************************************************************************
'* Fillfields()
'* --Retrives the employee information including the Photo from the DB
'*****************************************************************************
Private Sub FillFields()
Me.MousePointer = vbHourglass
txtFName = "" & rsEMP("FirstName")
txtLName = "" & rsEMP("LastName")
txtMName = "" & rsEMP("MiddleName")
txtSSN = "" & rsEMP("SSN")
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -