home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / code / database / dbprn / browse.txt < prev   
Encoding:
Text File  |  1995-02-27  |  8.7 KB  |  258 lines
  1. 'Copyright⌐ 1993 by Charles Gallo. All Rights Reserved
  2. Dim db As DataBase
  3. Dim td As TableDefs
  4.  
  5. Sub ChooseDatabase ()
  6. 'Copyright⌐ 1993 by Charles Gallo. All Rights Reserved
  7. '************************************************************
  8. ' Maintenance Header
  9. ' Version   Date        Coder                   Action
  10. '   1       07/13/93    C. Gallo(74020,3224)    Initial keyin
  11.  
  12. ' Calls:Nothing
  13.  
  14. ' Is Called By:Form_Load, mnu_OpenDB
  15.  
  16. ' Purpose:To Choose and open a database and add it's tables to
  17. ' the listbox
  18.  
  19.  
  20. '************************************************************
  21.     'Call the Common Dialog Routine to get the database name
  22.     On Error Resume Next                'This is here if there is no DB Open
  23.     db.Close
  24.     On Error GoTo 0
  25.     lst_Tables.Clear                    'clear the listbox
  26.     mnu_Print.Enabled = False
  27. Retrydatabase:
  28.     On Error GoTo DatabaseError
  29.     CmDialog1.CancelError = True
  30.     CmDialog1.Flags = OFN_FILEMUSTEXIST + OFN_HIDEREADONLY
  31.     CmDialog1.Action = 1
  32.     'Open the database
  33.     Set db = OpenDatabase(CmDialog1.Filetitle)
  34.     On Error GoTo 0
  35.  
  36.     Dim snap As Snapshot
  37.     'Take a snapshot of the tables (And Queries in the database)
  38.     Set snap = db.ListTables()
  39.     lst_Tables.AddItem "--TABLES--"
  40.     'loop thru the tables in the database
  41.     'first add all the NON query objects
  42.     While Not snap.EOF
  43.         If (snap!Attributes And DB_SYSTEMOBJECT) = 0 Then
  44.             If (snap!TableType = DB_TABLE) Then
  45.                 lst_Tables.AddItem snap!Name
  46.                 mnu_Print.Enabled = True                        'there is something in the listbox so enable print
  47.             End If
  48.         End If
  49.         snap.MoveNext
  50.     Wend
  51.     'yes I KNOW this is slower, but it gives better output
  52.     snap.MoveFirst
  53.     lst_Tables.AddItem "--QUERIES--"
  54.     While Not snap.EOF
  55.         If (snap!Attributes And DB_SYSTEMOBJECT) = 0 Then
  56.             If (snap!TableType = DB_QUERYDEF) And (snap!Attributes And 5) = 0 Then
  57.                 lst_Tables.AddItem snap!Name
  58.                 mnu_Print.Enabled = True                        'there is something in the listbox so enable print
  59.             End If
  60.         End If
  61.         snap.MoveNext
  62.     Wend
  63.     
  64.     
  65.     snap.Close
  66. Exit Sub
  67. DatabaseError:
  68.     If Err = 32755 Then             'The user pressed cancel in the cmdialog box
  69.         Exit Sub
  70.     End If
  71.     MsgBox "This is Not a Valid Access Database, or the Database is Corrupt!", MB_ICONEXCLAMATION, "Cagney Systems Inc."
  72.     Resume Retrydatabase
  73.  
  74. End Sub
  75.  
  76. Sub Form_Load ()
  77.     'Copyright⌐ 1993 by Charles Gallo. All Rights Reserved
  78.     Call Formcenter(Me)
  79.     Me.Show
  80.     x% = DoEvents()
  81.     Call ChooseDatabase
  82. End Sub
  83.  
  84. Sub Formcenter (dummy As Form)
  85.     Move (screen.Width - dummy.Width) \ 2, (screen.Height - dummy.Height) \ 2
  86. End Sub
  87.  
  88. Sub lst_Tables_DblClick ()
  89.     'Copyright⌐ 1993 by Charles Gallo. All Rights Reserved
  90.     mnu_Print_Click
  91. End Sub
  92.  
  93. Sub mnu_About_Click ()
  94.     'Copyright⌐ 1993 by Charles Gallo. All Rights Reserved
  95.     Temp$ = "Access Database Table Structure Printer" + Chr$(13) + Chr$(10)
  96.     Temp$ = Temp$ + "Copyright⌐ by 1993 Charles Gallo. All Rights Reserved" + Chr$(13) + Chr$(10)
  97.     Temp$ = Temp$ + "Charles Gallo (CIS ID 74020,3224)" + Chr$(13) + Chr$(10)
  98.     Temp$ = Temp$ + "This program may be distributed without charge" + Chr$(13) + Chr$(10)
  99.     Temp$ = Temp$ + "As long as the source code, and this statement" + Chr$(13) + Chr$(10)
  100.     Temp$ = Temp$ + "are included"
  101.     MsgBox Temp$, MB_ICONEXCLAMATION, "Cagney Systems Inc."
  102. End Sub
  103.  
  104. Sub mnu_Exit_Click ()
  105.     'Copyright⌐ 1993 by Charles Gallo. All Rights Reserved
  106.     End
  107. End Sub
  108.  
  109. Sub mnu_OpenDB_Click ()
  110. 'Copyright⌐ 1993 by Charles Gallo. All Rights Reserved
  111.     Call ChooseDatabase
  112. End Sub
  113.  
  114. Sub mnu_Print_Click ()
  115.     'Copyright⌐ 1993 by Charles Gallo. All Rights Reserved
  116. '************************************************************
  117. ' Maintenance Header
  118. ' Version   Date        Coder                   Action
  119. '   1       07/13/93    C. Gallo(74020,3224)    Initial keyin
  120. '   2       07/27/93    C. Gallo(74020,3224)    Added code to print Queries
  121.  
  122. ' Calls:QueryPrint
  123.  
  124. ' Is Called By:mnu_Print
  125.  
  126. ' Purpose:To print the stucture of an Access database table or call the Query print routine
  127.  
  128.  
  129. '************************************************************
  130.     'First Make sure the user did'nt pick the tables or Queries header
  131.     If (lst_Tables.Text = "--TABLES--") Or (lst_Tables.Text = "--QUERIES--") Then
  132.         'Yep, the user selected one of the headers
  133.         MsgBox "You Have selected one of the message headers, Please select one of the Tables or Queries", MB_ICONEXCLAMATION
  134.         Exit Sub
  135.     End If
  136.     'get the tabledef object of the open database
  137.     Set td = db.TableDefs
  138.     On Error GoTo PrintError
  139. 'Put a line label here because if the user selects a query we'll get an error in the next line
  140. QueryError:
  141.     td(lst_Tables.Text).Fields.Refresh
  142.     Temp$ = "Table = " + lst_Tables.Text
  143.  
  144.     'setup the printer and print the header info
  145.     Printer.FontName = "Arial"
  146.     Printer.FontBold = True
  147.     Printer.Print Tab(40 - Len(Temp$) / 2); Temp$
  148.     Printer.FontBold = False
  149.     Printer.Print
  150.     Printer.Print "Date = "; Format$(Now, "MM/DD/YYYY")
  151.     Printer.Print
  152.     Printer.Print "Field Name"; Tab(40); "Field Type"; Tab(60); "Field Size"
  153.     Printer.Print
  154.  
  155.     For i% = 0 To td(lst_Tables.Text).Fields.Count - 1               'for all the fields in this table (The table name is form the listbox)
  156.         Printer.Print td(lst_Tables.Text).Fields(i%).Name;           'Print the field name
  157.         Printer.Print Tab(40);                                  'tab to the type column
  158.  
  159.         'print the field type
  160.         Select Case td(lst_Tables.Text).Fields(i%).Type
  161.             Case DB_BOOLEAN
  162.                 Printer.Print "Boolean";
  163.             Case DB_BYTE
  164.                 Printer.Print "Byte";
  165.             Case DB_INTEGER
  166.                 Printer.Print "Integer";
  167.             Case DB_LONG
  168.                 Printer.Print "Long";
  169.             Case DB_CURRENCY
  170.                 Printer.Print "Currency";
  171.             Case DB_SINGLE
  172.                 Printer.Print "Single";
  173.             Case DB_DOUBLE
  174.                 Printer.Print "Double";
  175.             Case DB_DATE
  176.                 Printer.Print "Date";
  177.             Case DB_Binary
  178.                 Printer.Print "Binary";
  179.             Case DB_TEXT
  180.                 Printer.Print "Text";
  181.             Case DB_LONGBINARY
  182.                 Printer.Print "BLOB";
  183.             Case DB_MEMO
  184.                 Printer.Print "Memo";
  185.             Case Else
  186.                 Printer.Print "Error";
  187.         End Select
  188.         Printer.Print Tab(60);                                      'tab to the field size column
  189.         Printer.Print td(lst_Tables.Text).Fields(i%).Size           'and print the field size
  190.     Next
  191.     Printer.Print
  192.     Printer.Print "Primary Key"
  193.     'Print the primary key
  194.     Printer.Print
  195.     On Error Resume Next
  196.     Printer.Print td(lst_Tables.Text).Indexes("PrimaryKey").Fields
  197.     On Error GoTo 0
  198.     
  199.     
  200.     Printer.EndDoc                              'end the printer doc
  201. 'Note: It would be VERY easy to add screen display to this app.
  202. 'Just add a second form, put a grid control on the form, and stuff the grid in the loop!
  203. Exit Sub
  204. PrintError:
  205.     If Err = 3265 Then
  206.         'we are trying to print a Query
  207.         Temp$ = lst_Tables.Text
  208.         Call PrintQuery(Temp$)
  209.         Exit Sub
  210.     End If
  211. End Sub
  212.  
  213. Sub PrintQuery (WhichQuery$)
  214. '******************************************************
  215. ' Maintenance Header
  216. ' Version   Date        Coder       Action
  217. '   1       07/27/93    C. Gallo    Initial keyin
  218.  
  219. ' Calls:
  220.  
  221. ' Is Called By:
  222.  
  223. ' Purpose:To print the SQL string of the defined query
  224.  
  225.  
  226. '*******************************************************
  227.     Dim qd As Querydef
  228.  
  229.     'setup the printer and print the header info
  230.     Printer.FontName = "Arial"
  231.     Printer.FontBold = True
  232.     Printer.Print Tab(40 - Len(WhichQuery$) / 2); WhichQuery$
  233.     Printer.FontBold = False
  234.     Printer.Print
  235.     Printer.Print "Date = "; Format$(Now, "MM/DD/YYYY")
  236.     Printer.Print
  237.     Printer.Print "Query Name = ";
  238.     Printer.Print WhichQuery$
  239.     Printer.Print
  240.     Debug.Print Printer.FontSize
  241.     Printer.FontSize = 10
  242.  
  243.     Set qd = db.OpenQueryDef(WhichQuery$)
  244.     Temp$ = qd.SQL
  245.     qd.Close
  246.     For StringPointer% = 1 To Len(Temp$)
  247.         Printer.Print Mid$(Temp$, StringPointer%, 1);
  248.         If (Printer.CurrentX >= Printer.ScaleWidth * .7) And (Mid$(Temp$, StringPointer%, 1) = " ") Then
  249.             'if we're more than 70% of the way accross the printer
  250.             Printer.Print
  251.         End If
  252.     Next
  253.     
  254.     Printer.EndDoc                              'end the printer doc
  255.  
  256. End Sub
  257.  
  258.