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