Listing 1

Option Explicit						' global vars
Global db As Database				' single db object
Global ds() As Dynaset				' data set object array
Global frmList() As Form			' display form array
Global cDynaset() As String		' data set name array
Global nFrmCount As Integer		' for forms array
Global nDBOpen As Integer			' open db flag
Global nErr As Integer				' error flag
Global Const DB_FIXEDFIELD = &H1		' Field Attributes
Global Const DB_VARIABLEFIELD = &H2	
Global Const DB_AUTOINCRFIELD = &H10	
Global Const DB_UPDATABLEFIELD = &H20	
Global Const DB_BOOLEAN = 1		' Field Data Types
Global Const DB_BYTE = 2
Global Const DB_INTEGER = 3
Global Const DB_LONG = 4
Global Const DB_CURRENCY = 5
Global Const DB_SINGLE = 6
Global Const DB_DOUBLE = 7
Global Const DB_DATE = 8
Global Const DB_TEXT = 10
Global Const DB_LONGBINARY = 11
Global Const DB_MEMO = 12
Function GenForm (cDB As String, cRS As String, nMode As _
	Integer) As Integer
	On Error GoTo GenFormErr
	nErr = False
	GenForm = -1					' assume an error occurs
	If nDBOpen = False Then
		OpenDB cDB				' open database
	End If
	If nErr = False Then
		GenForm = LoadForm(cRS, nMode)	 ' load recordset
	End If
	GoTo GenFormExit
GenFormErr:
	MsgBox "Err:" & Str(Err) & "[" & Error(Err) & "]", 0, _
		"GenMain Error"
	nErr = True
	nDBOpen = False
	GenForm = -1
	Resume Next
GenFormExit:
End Function
Function LoadForm (cRecordSource As String, nMode As Integer) As Integer
	On Error GoTo LoadFormErr
	' get recordsource and start a new form
	nFrmCount = nFrmCount + 1
	ReDim Preserve frmList(nFrmCount) As Form
	ReDim Preserve cDynaset(nFrmCount) As String
	ReDim Preserve ds(nFrmCount) As Dynaset
	cDynaset(nFrmCount) = cRecordSource
	Set frmList(nFrmCount) = New frmGenForm
	Load frmList(nFrmCount)
	frmList(nFrmCount).Show nMode
	LoadForm = nFrmCount
	GoTo LoadFormExit
LoadFormErr:
	MsgBox "Err:" & Str(Err) & "[" & Error(Err) & "]", 0, _
		"LoadForm Error"
	nErr = True
	LoadForm = -1
	Resume Next
LoadFormExit:
End Function
Sub OpenDB (cDBF As String)
	On Error GoTo OpenDBErr
Set db = OpenDatabase(cDBF, False, False)	' open new db
	If nErr = False Then
		nDBOpen = True
	Else
		nDBOpen = False
	End If
	GoTo OpenDBExit
OpenDBErr:
	MsgBox "Err:" & Str(Err) & "[" & Error(Err) & "]", 0, _
		"OpenDB Error"
	nErr = True
	Resume Next
OpenDBExit:
End Sub



Listing 2


Option Explicit
Dim InpFld() As Control	' form/field stuff
Dim InpLbl() As Control
Dim btnText(9) As String
Dim nFlds As Integer
Dim nTop As Integer
Dim nAdd As Integer
Dim nForm As Integer
Const nLblLeft = 120		' constants for form
Const nLblHigh = 300
Const nLblWide = 1200
Const nTxtLeft = 1400
Const nTxtWide = 3600
Const nTxtHigh = 300
Const nMmoWide = 3600
Const nMmoHigh = 1200
Const nMmoLeft = 1400
Const nBtnWide = 600
Const nBtnHigh = 300
Const nBtnSpace = 60
Sub Form_Activate ()
	If nErr = True Then
		Unload Me
	End If
End Sub
Sub Form_Load ()
	On Error GoTo FormLoadErr
	nErr = False			' create a dynaset
	nForm = nFrmCount
	nTop = 600
	MakeData				' load dataset
	MakeFields			' load input controls
	MakeForm				' finish off form
	LayoutLoad			' get old layout
	RecRead				' read first record
	GoTo FormLoadExit
FormLoadErr:
	MsgBox "Err:" & Str(Err) & " [" & Error(Err) & "]", 0, _
		"FormLoad Error"
	nErr = True
	Resume Next
FormLoadExit:
End Sub
Sub Form_Unload (Cancel As Integer)
	On Error Resume Next
	Me.WindowState = 0
	LayoutSave
	ds(nForm).Close
	Unload Me
End Sub


Listing 3


Sub MakeFields ()
	Dim x As Integer
	Dim lDbType As Long
	On Error GoTo MakeFieldsErr
	ReDim InpFld(nFlds) As Control
	ReDim InpLbl(nFlds) As Control
	For x = 0 To nFlds
		lDbType = ds(nForm).Fields(x).Type
		Select Case lDbType
			Case Is = DB_BOOLEAN
				FldBoolean x
			Case Is = DB_MEMO
				FldMemo x
			Case Is = DB_SINGLE
				FldNumber x
			Case Is = DB_DOUBLE
				FldNumber x
			Case Is = DB_LONG
				FldNumber x
			Case Is = DB_INTEGER
				FldNumber x
			Case Is = DB_CURRENCY
				FldCurrency x
			Case Is = DB_BYTE
				FldNumber x
			Case Is = DB_DATE
				FldDate x
			Case Else
				FldText x
		End Select
		InpFld(x).Visible = True
		InpFld(x).TabIndex = x
		If ds(nForm).Fields(x).Attributes And _
			DB_UPDATABLEFIELD Then
			InpFld(x).Enabled = True
		Else
			InpFld(x).Enabled = False
		End If
	Next x
	GoTo MakeFieldsExit
MakeFieldsErr:
	MsgBox "Err:" & Str(Err) & "[" & Error$ & "]", 0, _
		"MakeFields Error"
	nErr = True
	Resume Next
MakeFieldsExit:
End Sub
Sub MakeLabels (x As Integer, nHigh As Integer)
	If x <> 0 Then			' set up label for field
		Load Label1(x)
	End If
	Set InpLbl(x) = Label1(x)
	InpLbl(x).Top = nTop
	InpLbl(x).Height = nHigh
	InpLbl(x).Left = nLblLeft
	InpLbl(x).Width = nLblWide
	InpLbl(x).Alignment = 1
	InpLbl(x).Visible = True
	InpLbl(x).FontBold = False
	InpLbl(x).BackStyle = 0
	InpLbl(x).Caption = ds(nForm).Fields(x).Name & ":"
End Sub
Sub FldText (x As Integer)
	If x <> 0 Then
		Load Text1(x)
	End If
	Set InpFld(x) = Text1(x)
	InpFld(x).Top = nTop
	InpFld(x).Height = nTxtHigh
	InpFld(x).Left = nTxtLeft
	InpFld(x).Width = nTxtWide
	InpFld(x).FontBold = False
	InpFld(x).MaxLength = ds(nForm).Fields(x).Size
	InpFld(x).Tag = ds(nForm).Fields(x).Name
	MakeLabels x, nTxtHigh
	nTop = nTop + nTxtHigh + 90
End Sub




Listing 4

Sub MakeBtns ()
	btnText(0) = "&Top"		' load text for command buttons
	btnText(1) = "&Next"
	btnText(2) = "&Back"
	btnText(3) = "&Last"
	btnText(4) = "&Find"
	btnText(5) = "&Add"
	btnText(6) = "&Del"
	btnText(7) = "&Save"
	btnText(8) = "&Undo"
End Sub
Sub MakeForm ()
	Dim x As Integer
	Me.Width = (9 * nBtnWide) + (9 * nBtnSpace) + 240
	' set up form
	Me.Height = nTop + 600
	Me.Caption = db.Name & "[" & ds(nForm).Name & "]"
	MakeBtns
	' load button captions
	For x = 0 To 8
	' place buttons on form
		cmdBtn(x).Top = 120
		cmdBtn(x).Width = nBtnWide
		cmdBtn(x).Height = 300
		cmdBtn(x).Left = 120 + (nBtnWide * x) + (nBtnSpace * x)
		cmdBtn(x).Caption = btnText(x)
		cmdBtn(x).TabIndex = x + nFlds + 1
	Next x
	Me.Top = (Screen.Height - Me.Height) / 2
' center form on screen
	Me.Left = (Screen.Width - Me.Width) / 2
End Sub



Listing 5


Sub cmdBtn_click (Index As Integer)
	Dim x As Integer
	Dim cMsg As String
	On Error GoTo cmdBtnErr
	Select Case Index		' handle button pushers
		Case Is = 0			' top
			RecWrite
			ds(nForm).MoveFirst
			RecInit
			RecRead
		Case Is = 1			' next
			RecWrite
			If ds(nForm).EOF Then
				ds(nForm).MoveLast
			Else
				ds(nForm).MoveNext
			End If
			RecInit
			RecRead
		Case Is = 2			' previous
			RecWrite
			If ds(nForm).BOF Then
				ds(nForm).MoveFirst
			Else
				ds(nForm).MovePrevious
			End If
			RecInit
			RecRead
		Case Is = 3			' last
			RecWrite
			ds(nForm).MoveLast
			RecInit
			RecRead
		Case Is = 4			' find
			RecFind
			RecInit
			RecRead
		Case Is = 5			' add new
			RecWrite
			nAdd = True
			ds(nForm).AddNew
			RecInit
		Case Is = 6			' delete
			ds(nForm).Delete
			If Not ds(nForm).EOF Then
				ds(nForm).MoveNext
			Else
				ds(nForm).MoveLast
			End If
			RecInit
			RecRead
		Case Is = 7			' update
			RecWrite
			RecInit
			RecRead
		Case Is = 8			' restore
			nAdd = False
			If Not ds(nForm).EOF And Not ds(nForm).BOF Then
				RecInit
				RecRead
			End If
	End Select
	Select Case Index		' handle button enable/disable stuff
		Case Is = 5
			For x = 0 To 6
				cmdBtn(x).Enabled = False
			Next x
			cmdBtn(7).Enabled = True
			cmdBtn(8).Enabled = True
		Case Else
			For x = 0 To 8
				cmdBtn(x).Enabled = True
			Next x
	End Select
	GoTo cmdBtnExit
cmdBtnErr:
	cMsg = "err:" & Str(Err) & "[" & Error$ & "]"
	MsgBox cMsg, 0, "cmdBtn Error"
	nErr = True
	Resume Next
cmdBtnExit:
End Sub



Listing 6

Form.Title=D:\VB3\BIBLIO.MDB[Authors]
Form.Top= 3975
Form.Left= 3375
Form.Height= 1980
Form.Width= 6180
Au_ID.Number= 0
Au_ID.FldLeft= 1400
Au_ID.FldTop= 600
Au_ID.FldHeight= 300
Au_ID.FldWidth= 800
Au_ID.FldVisible=-1
Au_ID.FldEnabled=-1
Au_ID.LblCaption=Au_ID:
Au_ID.LblLeft= 120
Au_ID.LblTop= 600
Au_ID.LblHeight= 300
Au_ID.LblWidth= 1200
Au_ID.LblVisible=-1
Robison 	9	1/31/96 3:25 PM


Amundsen listings, page 6