Visual Basic 5.0 Sample Code

This pages contains sample Visual Basic 5.0 Code used by Mr. Patrick Hetherington for in-class demonstration purposes. In all, there are five forms and one code module. Note that the code at the beginning of each form defines properties for the form and for each object that appears on the form.

Form1
Form2
Form3
Form4
Form5
Module1

Form1

VERSION 5.00
Object = "{FAEEE763-117E-101B-8933-08002B2F4F5A}#1.1#0"; "DBLIST32.OCX"

Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 3915
ClientLeft = 60
ClientTop = 345
ClientWidth = 7365
LinkTopic = "Form1"
ScaleHeight = 3915
ScaleWidth = 7365
StartUpPosition = 3 'Windows Default

Begin MSDBCtls.DBList DBList1
Bindings = "Form1.frx":0000
Height = 1815
Left = 4080
TabIndex = 1
Top = 540
Width = 3015
_ExtentX = 5318
_ExtentY = 3201
_Version = 327680
ListField = "description"
BoundColumn = ""
End

Begin MSDBCtls.DBCombo DBCombo1
Bindings = "Form1.frx":0010
DataField = "description"
DataSource = "Data1"
Height = 315
Left = 1500
TabIndex = 0
Top = 540
Width = 2535
_ExtentX = 4471
_ExtentY = 556
_Version = 327680
ListField = "description"
BoundColumn = ""
Text = "DBCombo1"
End

Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = "C:\user\hetherington\Samples\sample.mdb"
DefaultCursorType= 0 'DefaultCursor
DefaultType = 2 'UseODBC
Exclusive = 0 'False
Height = 345
Left = 1440
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "type"
Top = 2940
Width = 4755
End
End

Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Form2

VERSION 5.00
Object = "{FAEEE763-117E-101B-8933-08002B2F4F5A}#1.1#0"; "DBLIST32.OCX"

Begin VB.Form Form2
Caption = "Form2"
ClientHeight = 3195
ClientLeft = 60
ClientTop = 345
ClientWidth = 6915
LinkTopic = "Form2"
ScaleHeight = 3195
ScaleWidth = 6915
StartUpPosition = 3 'Windows Default

Begin MSDBCtls.DBList DBList1
Bindings = "Form2.frx":0000
DataField = "id_type"
DataSource = "Data1"
Height = 1035
Left = 4140
TabIndex = 4
Top = 600
Width = 2475
_ExtentX = 4366
_ExtentY = 1826
_Version = 327680
ListField = "description"
BoundColumn = "id_type"
End

Begin MSDBCtls.DBCombo DBCombo1
Bindings = "Form2.frx":0010
DataField = "id_type"
DataSource = "Data1"
Height = 315
Left = 1920
TabIndex = 3
Top = 600
Width = 2175
_ExtentX = 3836
_ExtentY = 556
_Version = 327680
ListField = "description"
BoundColumn = "id_type"
Text = "DBCombo1"
End

Begin VB.Data Data2
Caption = "Data2"
Connect = "Access"
DatabaseName = "C:\user\hetherington\Samples\sample.mdb"
DefaultCursorType= 0 'DefaultCursor
DefaultType = 2 'UseODBC
Exclusive = 0 'False
Height = 345
Left = 4200
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "type"
Top = 1800
Width = 1920
End

Begin VB.TextBox Text1
DataField = "middle_ini"
DataSource = "Data1"
Height = 375
Index = 2
Left = 2880
TabIndex = 2
Text = "Text1"
Top = 120
Width = 1335
End

Begin VB.TextBox Text1
DataField = "firstname"
DataSource = "Data1"
Height = 375
Index = 1
Left = 1500
TabIndex = 1
Text = "Text1"
Top = 120
Width = 1335
End

Begin VB.TextBox Text1
DataField = "lastname"
DataSource = "Data1"
Height = 375
Index = 0
Left = 120
TabIndex = 0
Text = "Text1"
Top = 120
Width = 1335
End

Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = "C:\user\hetherington\Samples\sample.mdb"
DefaultCursorType= 0 'DefaultCursor
DefaultType = 2 'UseODBC
Exclusive = 0 'False
Height = 375
Left = 300
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "user"
Top = 2700
Width = 2415
End
End

Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Form3

VERSION 5.00

Begin VB.Form Form3
Caption = "Form3"
ClientHeight = 3195
ClientLeft = 60
ClientTop = 345
ClientWidth = 6075
LinkTopic = "Form3"
ScaleHeight = 3195
ScaleWidth = 6075
StartUpPosition = 3 'Windows Default

Begin VB.ListBox List2
Height = 1425
Left = 3660
TabIndex = 2
Top = 240
Width = 2235
End

Begin VB.CommandButton Command1
Caption = ">"
Height = 735
Left = 3060
TabIndex = 1
Top = 300
Width = 495
End

Begin VB.ListBox List1
Height = 1425
Left = 180
MultiSelect = 1 'Simple
TabIndex = 0
Top = 240
Width = 2715
End
End

Attribute VB_Name = "Form3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim dbSample As Database
Dim snpSnapshot As Recordset

Private Sub Command1_Click()
Dim iRow As Integer, iOrgRow As Integer
iOrgRow = List1.ListIndex
List2.Clear
Dim sSQL As String
sSQL = "SELECT * FROM type WHERE description in (" & Chr(34)
For iRow = 0 To List1.ListCount - 1
List1.ListIndex = iRow
If List1.Selected(List1.ListIndex) = True Then
List2.AddItem List1 '(List1.ListIndex)
sSQL = sSQL & List1 & Chr(34) & "," & Chr(34)
End If
Next iRow
sSQL = sSQL & Chr(34) & ")"
List1.ListIndex = iOrgRow
End Sub

Private Sub Form_Load()
Dim sSQL As String
'Call OpenMydatabase
Set gdbSample = Opendatabase(App.Path & "\sample.mdb")
'sSQL = "SELECT * FROM type"
Set snpSnapshot = gdbSample.OpenRecordset(sSQL, dbOpenSnapshot)
While Not snpSnapshot.EOF
List1.AddItem snpSnapshot.Fields("description")
snpSnapshot.MoveNext
Wend
snpSnapshot.Close
End Sub

Private Sub List2_DblClick()
List2.RemoveItem (List2.ListIndex)
End Sub

Form4

VERSION 5.00
Object = "{8E27C92E-1264-101C-8A2F-040224009C02}#7.0#0"; "MSCAL.OCX"

Begin VB.Form Form4
Caption = "Form4"
ClientHeight = 4410
ClientLeft = 60
ClientTop = 345
ClientWidth = 5835
LinkTopic = "Form4"
ScaleHeight = 4410
ScaleWidth = 5835
StartUpPosition = 3 'Windows Default

Begin VB.TextBox Text1
DataField = "middle_ini"
DataSource = "Data1"
Height = 315
Index = 2
Left = 4140
TabIndex = 3
Text = "Text1"
Top = 240
Width = 615
End

Begin VB.TextBox Text1
DataField = "lastname"
DataSource = "Data1"
Height = 315
Index = 1
Left = 1920
TabIndex = 2
Text = "Text1"
Top = 240
Width = 2055
End

Begin VB.TextBox Text1
DataField = "firstname"
DataSource = "Data1"
Height = 315
Index = 0
Left = 180
TabIndex = 1
Text = "Text1"
Top = 240
Width = 1575
End

Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = "C:\user\hetherington\Samples\sample.mdb"
DefaultCursorType= 0 'DefaultCursor
DefaultType = 2 'UseODBC
Exclusive = 0 'False
Height = 375
Left = 600
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "user"
Top = 3900
Width = 2295
End

Begin MSACAL.Calendar Calendar1
DataField = "dob"
DataSource = "Data1"
Height = 2355
Left = 720
TabIndex = 0
Top = 1260
Width = 3855
_Version = 524288
_ExtentX = 6800
_ExtentY = 4154
_StockProps = 1
BackColor = 12632256
Year = 1997
Month = 7
Day = 7
DayLength = 1
MonthLength = 2
DayFontColor = 0
FirstDay = 1
GridCellEffect = 1
GridFontColor = 10485760
GridLinesColor = -2147483632
ShowDateSelectors= -1 'True
ShowDays = -1 'True
ShowHorizontalGrid= -1 'True
ShowTitle = -1 'True
ShowVerticalGrid= -1 'True
TitleFontColor = 10485760
ValueIsNull = -1 'True

BeginProperty DayFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty

BeginProperty GridFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty

BeginProperty TitleFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End

Begin VB.Label Label1
Caption = "Label1"
Height = 375
Left = 960
TabIndex = 4
Top = 720
Width = 3495
End
End

Attribute VB_Name = "Form4"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim miOrgMM As Integer
Dim miOrgDD As Integer
Dim miOrgYYYY As Integer

Private Sub Calendar1_AfterUpdate()
' Debug.Print Calendar1.Month
' Debug.Print Calendar1.Day
' Debug.Print Calendar1.Year
Label1.Caption = Format(Calendar1.Day, "DDDD")
End Sub

Private Sub Data1_Reposition()
' Calendar1.Month = Val(Format(Data1.Recordset.Fields("dob"), "MM"))
' Calendar1.Day = Val(Format(Data1.Recordset.Fields("dob"), "dd"))
' Calendar1.Year = Val(Format(Data1.Recordset.Fields("dob"), "yyyy"))
' miOrgMM = Calendar1.Month
' miOrgDD = Calendar1.Day
' miOrgYYYY = Calendar1.Year
End Sub

Form5

VERSION 5.00
Object = "{C932BA88-4374-101B-A56C-00AA003668DC}#1.1#0"; "MSMASK32.OCX"

Begin VB.Form Form5
Caption = "Form5"
ClientHeight = 3195
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form5"
ScaleHeight = 3195
ScaleWidth = 4680
StartUpPosition = 3 'Windows Default

Begin VB.CommandButton Command1
Caption = "Command1"
Height = 495
Left = 3240
TabIndex = 3
Top = 1320
Width = 1095
End

Begin MSMask.MaskEdBox MaskEdBox1
Height = 375
Left = 360
TabIndex = 2
Top = 1320
Width = 2535
_ExtentX = 4471
_ExtentY = 661
_Version = 327680
MaxLength = 1
Format = "dd-mmm-yy"
Mask = "#"
PromptChar = "_"
End

Begin VB.TextBox Text1
Height = 375
Index = 1
Left = 1440
TabIndex = 1
Text = "Text1"
Top = 480
Width = 735
End

Begin VB.TextBox Text1
Height = 375
Index = 0
Left = 720
TabIndex = 0
Text = "Text1"
Top = 480
Width = 735
End
End

Attribute VB_Name = "Form5"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
MsgBox Trim$(MaskEdBox1)
sSQL = "select * from user where ssn = " & Chr(34) & Trim$(MaskEdBox1) & Chr(34)
End Sub

Private Sub Form_Load()
MaskEdBox1.Mask = "###-##-####"
End Sub

Module1

Attribute VB_Name = "Module1"
Global gdbSample As Database
Global gsnpSnapshot As Recordset

Sub OpenMydatabase()
Set gdbSample = Opendatabase(App.Path & "\sample.mdb")
End Sub

Go to Top