Form1

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