home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Software Sampler / Visual_Basic_Software_Sampler_Visual_Basic_Programmers_Journal_June_1996.iso / issues / 04apr96 / code / fpage61.txt < prev    next >
Text File  |  1996-04-24  |  8KB  |  377 lines
  1. Listing 1
  2.  
  3. Option Explicit                        ' global vars
  4. Global db As Database                ' single db object
  5. Global ds() As Dynaset                ' data set object array
  6. Global frmList() As Form            ' display form array
  7. Global cDynaset() As String        ' data set name array
  8. Global nFrmCount As Integer        ' for forms array
  9. Global nDBOpen As Integer            ' open db flag
  10. Global nErr As Integer                ' error flag
  11. Global Const DB_FIXEDFIELD = &H1        ' Field Attributes
  12. Global Const DB_VARIABLEFIELD = &H2    
  13. Global Const DB_AUTOINCRFIELD = &H10    
  14. Global Const DB_UPDATABLEFIELD = &H20    
  15. Global Const DB_BOOLEAN = 1        ' Field Data Types
  16. Global Const DB_BYTE = 2
  17. Global Const DB_INTEGER = 3
  18. Global Const DB_LONG = 4
  19. Global Const DB_CURRENCY = 5
  20. Global Const DB_SINGLE = 6
  21. Global Const DB_DOUBLE = 7
  22. Global Const DB_DATE = 8
  23. Global Const DB_TEXT = 10
  24. Global Const DB_LONGBINARY = 11
  25. Global Const DB_MEMO = 12
  26. Function GenForm (cDB As String, cRS As String, nMode As _
  27.     Integer) As Integer
  28.     On Error GoTo GenFormErr
  29.     nErr = False
  30.     GenForm = -1                    ' assume an error occurs
  31.     If nDBOpen = False Then
  32.         OpenDB cDB                ' open database
  33.     End If
  34.     If nErr = False Then
  35.         GenForm = LoadForm(cRS, nMode)     ' load recordset
  36.     End If
  37.     GoTo GenFormExit
  38. GenFormErr:
  39.     MsgBox "Err:" & Str(Err) & "[" & Error(Err) & "]", 0, _
  40.         "GenMain Error"
  41.     nErr = True
  42.     nDBOpen = False
  43.     GenForm = -1
  44.     Resume Next
  45. GenFormExit:
  46. End Function
  47. Function LoadForm (cRecordSource As String, nMode As Integer) As Integer
  48.     On Error GoTo LoadFormErr
  49.     ' get recordsource and start a new form
  50.     nFrmCount = nFrmCount + 1
  51.     ReDim Preserve frmList(nFrmCount) As Form
  52.     ReDim Preserve cDynaset(nFrmCount) As String
  53.     ReDim Preserve ds(nFrmCount) As Dynaset
  54.     cDynaset(nFrmCount) = cRecordSource
  55.     Set frmList(nFrmCount) = New frmGenForm
  56.     Load frmList(nFrmCount)
  57.     frmList(nFrmCount).Show nMode
  58.     LoadForm = nFrmCount
  59.     GoTo LoadFormExit
  60. LoadFormErr:
  61.     MsgBox "Err:" & Str(Err) & "[" & Error(Err) & "]", 0, _
  62.         "LoadForm Error"
  63.     nErr = True
  64.     LoadForm = -1
  65.     Resume Next
  66. LoadFormExit:
  67. End Function
  68. Sub OpenDB (cDBF As String)
  69.     On Error GoTo OpenDBErr
  70. Set db = OpenDatabase(cDBF, False, False)    ' open new db
  71.     If nErr = False Then
  72.         nDBOpen = True
  73.     Else
  74.         nDBOpen = False
  75.     End If
  76.     GoTo OpenDBExit
  77. OpenDBErr:
  78.     MsgBox "Err:" & Str(Err) & "[" & Error(Err) & "]", 0, _
  79.         "OpenDB Error"
  80.     nErr = True
  81.     Resume Next
  82. OpenDBExit:
  83. End Sub
  84.  
  85.  
  86.  
  87. Listing 2
  88.  
  89.  
  90. Option Explicit
  91. Dim InpFld() As Control    ' form/field stuff
  92. Dim InpLbl() As Control
  93. Dim btnText(9) As String
  94. Dim nFlds As Integer
  95. Dim nTop As Integer
  96. Dim nAdd As Integer
  97. Dim nForm As Integer
  98. Const nLblLeft = 120        ' constants for form
  99. Const nLblHigh = 300
  100. Const nLblWide = 1200
  101. Const nTxtLeft = 1400
  102. Const nTxtWide = 3600
  103. Const nTxtHigh = 300
  104. Const nMmoWide = 3600
  105. Const nMmoHigh = 1200
  106. Const nMmoLeft = 1400
  107. Const nBtnWide = 600
  108. Const nBtnHigh = 300
  109. Const nBtnSpace = 60
  110. Sub Form_Activate ()
  111.     If nErr = True Then
  112.         Unload Me
  113.     End If
  114. End Sub
  115. Sub Form_Load ()
  116.     On Error GoTo FormLoadErr
  117.     nErr = False            ' create a dynaset
  118.     nForm = nFrmCount
  119.     nTop = 600
  120.     MakeData                ' load dataset
  121.     MakeFields            ' load input controls
  122.     MakeForm                ' finish off form
  123.     LayoutLoad            ' get old layout
  124.     RecRead                ' read first record
  125.     GoTo FormLoadExit
  126. FormLoadErr:
  127.     MsgBox "Err:" & Str(Err) & " [" & Error(Err) & "]", 0, _
  128.         "FormLoad Error"
  129.     nErr = True
  130.     Resume Next
  131. FormLoadExit:
  132. End Sub
  133. Sub Form_Unload (Cancel As Integer)
  134.     On Error Resume Next
  135.     Me.WindowState = 0
  136.     LayoutSave
  137.     ds(nForm).Close
  138.     Unload Me
  139. End Sub
  140.  
  141.  
  142. Listing 3
  143.  
  144.  
  145. Sub MakeFields ()
  146.     Dim x As Integer
  147.     Dim lDbType As Long
  148.     On Error GoTo MakeFieldsErr
  149.     ReDim InpFld(nFlds) As Control
  150.     ReDim InpLbl(nFlds) As Control
  151.     For x = 0 To nFlds
  152.         lDbType = ds(nForm).Fields(x).Type
  153.         Select Case lDbType
  154.             Case Is = DB_BOOLEAN
  155.                 FldBoolean x
  156.             Case Is = DB_MEMO
  157.                 FldMemo x
  158.             Case Is = DB_SINGLE
  159.                 FldNumber x
  160.             Case Is = DB_DOUBLE
  161.                 FldNumber x
  162.             Case Is = DB_LONG
  163.                 FldNumber x
  164.             Case Is = DB_INTEGER
  165.                 FldNumber x
  166.             Case Is = DB_CURRENCY
  167.                 FldCurrency x
  168.             Case Is = DB_BYTE
  169.                 FldNumber x
  170.             Case Is = DB_DATE
  171.                 FldDate x
  172.             Case Else
  173.                 FldText x
  174.         End Select
  175.         InpFld(x).Visible = True
  176.         InpFld(x).TabIndex = x
  177.         If ds(nForm).Fields(x).Attributes And _
  178.             DB_UPDATABLEFIELD Then
  179.             InpFld(x).Enabled = True
  180.         Else
  181.             InpFld(x).Enabled = False
  182.         End If
  183.     Next x
  184.     GoTo MakeFieldsExit
  185. MakeFieldsErr:
  186.     MsgBox "Err:" & Str(Err) & "[" & Error$ & "]", 0, _
  187.         "MakeFields Error"
  188.     nErr = True
  189.     Resume Next
  190. MakeFieldsExit:
  191. End Sub
  192. Sub MakeLabels (x As Integer, nHigh As Integer)
  193.     If x <> 0 Then            ' set up label for field
  194.         Load Label1(x)
  195.     End If
  196.     Set InpLbl(x) = Label1(x)
  197.     InpLbl(x).Top = nTop
  198.     InpLbl(x).Height = nHigh
  199.     InpLbl(x).Left = nLblLeft
  200.     InpLbl(x).Width = nLblWide
  201.     InpLbl(x).Alignment = 1
  202.     InpLbl(x).Visible = True
  203.     InpLbl(x).FontBold = False
  204.     InpLbl(x).BackStyle = 0
  205.     InpLbl(x).Caption = ds(nForm).Fields(x).Name & ":"
  206. End Sub
  207. Sub FldText (x As Integer)
  208.     If x <> 0 Then
  209.         Load Text1(x)
  210.     End If
  211.     Set InpFld(x) = Text1(x)
  212.     InpFld(x).Top = nTop
  213.     InpFld(x).Height = nTxtHigh
  214.     InpFld(x).Left = nTxtLeft
  215.     InpFld(x).Width = nTxtWide
  216.     InpFld(x).FontBold = False
  217.     InpFld(x).MaxLength = ds(nForm).Fields(x).Size
  218.     InpFld(x).Tag = ds(nForm).Fields(x).Name
  219.     MakeLabels x, nTxtHigh
  220.     nTop = nTop + nTxtHigh + 90
  221. End Sub
  222.  
  223.  
  224.  
  225.  
  226. Listing 4
  227.  
  228. Sub MakeBtns ()
  229.     btnText(0) = "&Top"        ' load text for command buttons
  230.     btnText(1) = "&Next"
  231.     btnText(2) = "&Back"
  232.     btnText(3) = "&Last"
  233.     btnText(4) = "&Find"
  234.     btnText(5) = "&Add"
  235.     btnText(6) = "&Del"
  236.     btnText(7) = "&Save"
  237.     btnText(8) = "&Undo"
  238. End Sub
  239. Sub MakeForm ()
  240.     Dim x As Integer
  241.     Me.Width = (9 * nBtnWide) + (9 * nBtnSpace) + 240
  242.     ' set up form
  243.     Me.Height = nTop + 600
  244.     Me.Caption = db.Name & "[" & ds(nForm).Name & "]"
  245.     MakeBtns
  246.     ' load button captions
  247.     For x = 0 To 8
  248.     ' place buttons on form
  249.         cmdBtn(x).Top = 120
  250.         cmdBtn(x).Width = nBtnWide
  251.         cmdBtn(x).Height = 300
  252.         cmdBtn(x).Left = 120 + (nBtnWide * x) + (nBtnSpace * x)
  253.         cmdBtn(x).Caption = btnText(x)
  254.         cmdBtn(x).TabIndex = x + nFlds + 1
  255.     Next x
  256.     Me.Top = (Screen.Height - Me.Height) / 2
  257. ' center form on screen
  258.     Me.Left = (Screen.Width - Me.Width) / 2
  259. End Sub
  260.  
  261.  
  262.  
  263. Listing 5
  264.  
  265.  
  266. Sub cmdBtn_click (Index As Integer)
  267.     Dim x As Integer
  268.     Dim cMsg As String
  269.     On Error GoTo cmdBtnErr
  270.     Select Case Index        ' handle button pushers
  271.         Case Is = 0            ' top
  272.             RecWrite
  273.             ds(nForm).MoveFirst
  274.             RecInit
  275.             RecRead
  276.         Case Is = 1            ' next
  277.             RecWrite
  278.             If ds(nForm).EOF Then
  279.                 ds(nForm).MoveLast
  280.             Else
  281.                 ds(nForm).MoveNext
  282.             End If
  283.             RecInit
  284.             RecRead
  285.         Case Is = 2            ' previous
  286.             RecWrite
  287.             If ds(nForm).BOF Then
  288.                 ds(nForm).MoveFirst
  289.             Else
  290.                 ds(nForm).MovePrevious
  291.             End If
  292.             RecInit
  293.             RecRead
  294.         Case Is = 3            ' last
  295.             RecWrite
  296.             ds(nForm).MoveLast
  297.             RecInit
  298.             RecRead
  299.         Case Is = 4            ' find
  300.             RecFind
  301.             RecInit
  302.             RecRead
  303.         Case Is = 5            ' add new
  304.             RecWrite
  305.             nAdd = True
  306.             ds(nForm).AddNew
  307.             RecInit
  308.         Case Is = 6            ' delete
  309.             ds(nForm).Delete
  310.             If Not ds(nForm).EOF Then
  311.                 ds(nForm).MoveNext
  312.             Else
  313.                 ds(nForm).MoveLast
  314.             End If
  315.             RecInit
  316.             RecRead
  317.         Case Is = 7            ' update
  318.             RecWrite
  319.             RecInit
  320.             RecRead
  321.         Case Is = 8            ' restore
  322.             nAdd = False
  323.             If Not ds(nForm).EOF And Not ds(nForm).BOF Then
  324.                 RecInit
  325.                 RecRead
  326.             End If
  327.     End Select
  328.     Select Case Index        ' handle button enable/disable stuff
  329.         Case Is = 5
  330.             For x = 0 To 6
  331.                 cmdBtn(x).Enabled = False
  332.             Next x
  333.             cmdBtn(7).Enabled = True
  334.             cmdBtn(8).Enabled = True
  335.         Case Else
  336.             For x = 0 To 8
  337.                 cmdBtn(x).Enabled = True
  338.             Next x
  339.     End Select
  340.     GoTo cmdBtnExit
  341. cmdBtnErr:
  342.     cMsg = "err:" & Str(Err) & "[" & Error$ & "]"
  343.     MsgBox cMsg, 0, "cmdBtn Error"
  344.     nErr = True
  345.     Resume Next
  346. cmdBtnExit:
  347. End Sub
  348.  
  349.  
  350.  
  351. Listing 6
  352.  
  353. Form.Title=D:\VB3\BIBLIO.MDB[Authors]
  354. Form.Top= 3975
  355. Form.Left= 3375
  356. Form.Height= 1980
  357. Form.Width= 6180
  358. Au_ID.Number= 0
  359. Au_ID.FldLeft= 1400
  360. Au_ID.FldTop= 600
  361. Au_ID.FldHeight= 300
  362. Au_ID.FldWidth= 800
  363. Au_ID.FldVisible=-1
  364. Au_ID.FldEnabled=-1
  365. Au_ID.LblCaption=Au_ID:
  366. Au_ID.LblLeft= 120
  367. Au_ID.LblTop= 600
  368. Au_ID.LblHeight= 300
  369. Au_ID.LblWidth= 1200
  370. Au_ID.LblVisible=-1
  371. Robison     9    1/31/96 3:25 PM
  372.  
  373.  
  374. Amundsen listings, page 6
  375.  
  376.  
  377.