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