|
Building blocks
for better software ...
|
 |
|
|
|
|
|
 |
 |
 |
 |
 |
 |
 |
|
||||
Visual Basic Create, Read Update and Delete (CRUD) Form Screen Shot:
Visual Basic Create, Read Update and Delete (CRUD) Cursor Form Screen Shot:
Visual Basic Create, Read Update and Delete (CRUD) Form Source:
VERSION 5.00
Begin VB.Form frmCode
BorderStyle = 1
Caption = "Code CRUD"
ClientHeight = 6210
ClientLeft = 45
ClientTop = 330
ClientWidth = 11010
LinkTopic = "Code CRUD"
MaxButton = 0
MinButton = 0
ScaleHeight = 6210
ScaleWidth = 11010
StartUpPosition = 3
MDIChild = -1
Begin VB.Label labQuery
Caption = "Query"
Height = 255
Left = 4200
TabIndex = 900
Top = 360
Width = 2415
End
Begin VB.Label labUpdateFields
Caption = "Update Fields"
Height = 255
Left = 7560
TabIndex = 901
Top = 360
Width = 2415
End
Begin VB.Label labComment
Caption = "* Key field "
Height = 255
Left = 120
TabIndex = 903
Top = 3960
Width = 735
End
Begin VB.CommandButton cmdAdd
Caption = "&Add"
Height = 375
Left = 120
TabIndex = 0
Top = 120
Width = 1455
End
Begin VB.CommandButton cmdGetUnique
Caption = "&Get Unique"
Height = 375
Left = 120
TabIndex = 1
Top = 600
Width = 1455
End
Begin VB.CommandButton cmdUpdate
Caption = "&Update"
Height = 375
Left = 120
TabIndex = 2
Top = 1080
Width = 1455
End
Begin VB.CommandButton cmdDelete
Caption = "&Delete"
Height = 375
Left = 120
TabIndex = 3
Top = 1560
Width = 1455
End
Begin VB.CommandButton cmdOpenCursor
Caption = "&Cursor"
Height = 375
Left = 120
TabIndex = 4
Top = 2040
Width = 1455
End
Begin VB.CommandButton cmdCount
Caption = "C&ount"
Height = 375
Left = 120
TabIndex = 5
Top = 2520
Width = 1455
End
Begin VB.CommandButton cmdClear
Caption = "&Clear"
Height = 375
Left = 120
TabIndex = 6
Top = 3000
Width = 1455
End
Begin VB.CommandButton cmdExit
Caption = "E&xit"
Height = 375
Left = 120
TabIndex = 7
Top = 3480
Width = 1455
End
Begin VB.Label labCodeType
Caption = "Code Type*"
Height = 255
Left = 1800
TabIndex = 8
Top = 600
Width = 3015
End
Begin VB.Label labCode
Caption = "Code*"
Height = 255
Left = 1800
TabIndex = 9
Top = 960
Width = 3015
End
Begin VB.Label labDecode
Caption = "Decode"
Height = 255
Left = 1800
TabIndex = 10
Top = 1320
Width = 3015
End
Begin VB.Label labDescription
Caption = "Description"
Height = 255
Left = 1800
TabIndex = 11
Top = 1680
Width = 3015
End
Begin VB.Label labUserid
Caption = "Userid"
Height = 255
Left = 1800
TabIndex = 12
Top = 2040
Width = 3015
End
Begin VB.Label labUpdateTimestamp
Caption = "Update Timestamp"
Height = 255
Left = 1800
TabIndex = 13
Top = 2400
Width = 3015
End
Begin VB.TextBox txtCodeType
Height = 285
Left = 4200
TabIndex = 14
Top = 600
Width = 3255
End
Begin VB.TextBox txtUpdCodeType
Height = 285
Left = 7560
TabIndex = 15
Top = 600
Width = 3255
End
Begin VB.TextBox txtCode
Height = 285
Left = 4200
TabIndex = 16
Top = 960
Width = 3255
End
Begin VB.TextBox txtUpdCode
Height = 285
Left = 7560
TabIndex = 17
Top = 960
Width = 3255
End
Begin VB.TextBox txtDecode
Height = 285
Left = 4200
TabIndex = 18
Top = 1320
Width = 3255
End
Begin VB.TextBox txtUpdDecode
Height = 285
Left = 7560
TabIndex = 19
Top = 1320
Width = 3255
End
Begin VB.TextBox txtDescription
Height = 285
Left = 4200
TabIndex = 20
Top = 1680
Width = 3255
End
Begin VB.TextBox txtUpdDescription
Height = 285
Left = 7560
TabIndex = 21
Top = 1680
Width = 3255
End
Begin VB.TextBox txtUserid
Height = 285
Left = 4200
TabIndex = 22
Top = 2040
Width = 3255
End
Begin VB.TextBox txtUpdUserid
Height = 285
Left = 7560
TabIndex = 23
Top = 2040
Width = 3255
End
Begin VB.TextBox txtUpdateTimestamp
Height = 285
Left = 4200
TabIndex = 24
Top = 2400
Width = 3255
End
Begin VB.TextBox txtUpdUpdateTimestamp
Height = 285
Left = 7560
TabIndex = 25
Top = 2400
Width = 3255
End
End
Attribute VB_Name = "frmCode"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Private Sub cmdAdd_Click()
Dim strMessage, strTitle As String
Dim intReturn As Integer
Dim objCode As Code
Set objCode = New Code
With objCode
If Len(txtCodeType) > 0 Then
.CodeType = txtCodeType
End If
If Len(txtCode) > 0 Then
.Code = txtCode
End If
If Len(txtDecode) > 0 Then
.Decode = txtDecode
End If
If Len(txtDescription) > 0 Then
.Description = txtDescription
End If
If Len(txtUserid) > 0 Then
.Userid = txtUserid
End If
If Len(txtUpdateTimestamp) > 0 Then
.UpdateTimestamp = txtUpdateTimestamp
End If
intReturn = .AddCode
If intReturn <> 0 Then
strMessage = "Error Code: " & intReturn
strTitle = "Error"
intReturn = MsgBox(strMessage, , strTitle)
Else
strMessage = "Success!"
strTitle = "Success"
intReturn = MsgBox(strMessage, , strTitle)
End If
End With
End Sub
Private Sub cmdClear_Click()
txtCodeType = ""
txtUpdCodeType = ""
txtCode = ""
txtUpdCode = ""
txtDecode = ""
txtUpdDecode = ""
txtDescription = ""
txtUpdDescription = ""
txtUserid = ""
txtUpdUserid = ""
txtUpdateTimestamp = ""
txtUpdUpdateTimestamp = ""
End Sub
Private Sub cmdDelete_Click()
Dim strMessage, strTitle As String
Dim intReturn As Integer
Dim objCode As Code
Set objCode = New Code
With objCode
If Len(txtCodeType) > 0 Then
.CodeType = txtCodeType
End If
If Len(txtCode) > 0 Then
.Code = txtCode
End If
If Len(txtDecode) > 0 Then
.Decode = txtDecode
End If
If Len(txtDescription) > 0 Then
.Description = txtDescription
End If
If Len(txtUserid) > 0 Then
.Userid = txtUserid
End If
If Len(txtUpdateTimestamp) > 0 Then
.UpdateTimestamp = txtUpdateTimestamp
End If
intReturn = .DelCode
If intReturn <> 0 Then
strMessage = "Error Code: " & intReturn
strTitle = "Error"
intReturn = MsgBox(strMessage, , strTitle)
Else
strMessage = "Success!"
strTitle = "Success"
intReturn = MsgBox(strMessage, , strTitle)
End If
End With
End Sub
Private Sub cmdGetUnique_Click()
Dim strMessage, strTitle As String
Dim intReturn As Integer
Dim objCode As Code
Set objCode = New Code
With objCode
If Len(txtCodeType) > 0 Then
.CodeType = txtCodeType
End If
If Len(txtCode) > 0 Then
.Code = txtCode
End If
intReturn = .GetUniqueCode
If intReturn <> 0 Then
strMessage = "Error Code: " & intReturn
strTitle = "Error"
intReturn = MsgBox(strMessage, , strTitle)
Else
txtDecode = .Decode
txtDescription = .Description
txtUserid = .Userid
txtUpdateTimestamp = .UpdateTimestamp
End If
End With
End Sub
Private Sub cmdOpenCursor_Click()
frmCode_Cursor.Show
End Sub
Private Sub cmdCount_Click()
Dim strMessage, strTitle As String
Dim intReturn As Integer
Dim objCode As Code
Set objCode = New Code
With objCode
If Len(txtCodeType) > 0 Then
.CodeType = txtCodeType
End If
If Len(txtCode) > 0 Then
.Code = txtCode
End If
If Len(txtDecode) > 0 Then
.Decode = txtDecode
End If
If Len(txtDescription) > 0 Then
.Description = txtDescription
End If
If Len(txtUserid) > 0 Then
.Userid = txtUserid
End If
If Len(txtUpdateTimestamp) > 0 Then
.UpdateTimestamp = txtUpdateTimestamp
End If
intReturn = .CntCode
If intReturn <> 0 Then
strMessage = "Error Code: " & intReturn
strTitle = "Error"
intReturn = MsgBox(strMessage, , strTitle)
Else
strMessage = "Rows Found: " & .RowsAffected
strTitle = "Rows Found"
intReturn = MsgBox(strMessage, , strTitle)
End If
End With
End Sub
Private Sub cmdUpdate_Click()
Dim strMessage, strTitle As String
Dim intReturn As Integer
Dim objCode As Code
Set objCode = New Code
With objCode
If Len(txtCodeType) > 0 Then
.CodeType = txtCodeType
End If
If Len(txtUpdCodeType) > 0 Then
.CodeTypeUpdVal = txtUpdCodeType
End If
If Len(txtCode) > 0 Then
.Code = txtCode
End If
If Len(txtUpdCode) > 0 Then
.CodeUpdVal = txtUpdCode
End If
If Len(txtDecode) > 0 Then
.Decode = txtDecode
End If
If Len(txtUpdDecode) > 0 Then
.DecodeUpdVal = txtUpdDecode
End If
If Len(txtDescription) > 0 Then
.Description = txtDescription
End If
If Len(txtUpdDescription) > 0 Then
.DescriptionUpdVal = txtUpdDescription
End If
If Len(txtUserid) > 0 Then
.Userid = txtUserid
End If
If Len(txtUpdUserid) > 0 Then
.UseridUpdVal = txtUpdUserid
End If
If Len(txtUpdateTimestamp) > 0 Then
.UpdateTimestamp = txtUpdateTimestamp
End If
If Len(txtUpdUpdateTimestamp) > 0 Then
.UpdateTimestampUpdVal = txtUpdUpdateTimestamp
End If
intReturn = .UpdCode
If intReturn <> 0 Then
strMessage = "Error Code: " & intReturn
strTitle = "Error"
intReturn = MsgBox(strMessage, , strTitle)
Else
strMessage = "Success!"
strTitle = "Success"
intReturn = MsgBox(strMessage, , strTitle)
End If
End With
End Sub
Private Sub cmdExit_Click()
End
End Sub
|
Copyright
© 2002 - 2007, Donald R. Warth Jr.
|
|
All
rights reserved.
|