Programming Tool Box/SIMS_2.iso/code/database/dbinf/datainfo.frm

Visual Basic Form | 1995-02-27 | 9.2 KB | 292 lines

VERSION 2.00
Begin Form Form1
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Database Informatter"
   ClientHeight    =   4230
   ClientLeft      =   1095
   ClientTop       =   1560
   ClientWidth     =   7590
   ControlBox      =   0   'False
   Height          =   4635
   Left            =   1035
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   4230
   ScaleWidth      =   7590
   Top             =   1215
   Width           =   7710
   Begin SSPanel Panel3D1
      BevelOuter      =   1  'Inset
      Height          =   555
      Index           =   4
      Left            =   120
      TabIndex        =   11
      Top             =   120
      Width           =   3615
      Begin DriveListBox Drive1
         BackColor       =   &H00C0C0C0&
         Height          =   315
         Left            =   120
         TabIndex        =   12
         Top             =   120
         Width           =   3375
      End
   End
   Begin SSPanel Panel3D1
      BevelOuter      =   1  'Inset
      Height          =   555
      Index           =   2
      Left            =   3780
      TabIndex        =   10
      Top             =   3540
      Width           =   3675
      Begin CommandButton Command3
         Caption         =   "&Help"
         Height          =   315
         Left            =   1320
         TabIndex        =   6
         Top             =   120
         Width           =   1035
      End
      Begin CommandButton Command2
         Caption         =   "&Quit"
         Height          =   315
         Left            =   2520
         TabIndex        =   7
         Top             =   120
         Width           =   1035
      End
      Begin CommandButton Command1
         Caption         =   "&Print"
         Enabled         =   0   'False
         Height          =   315
         Left            =   120
         TabIndex        =   5
         Top             =   120
         Width           =   1035
      End
   End
   Begin SSPanel Panel3D1
      BevelOuter      =   1  'Inset
      Height          =   555
      Index           =   3
      Left            =   120
      TabIndex        =   9
      Top             =   3540
      Width           =   3615
      Begin ComboBox Combo1
         BackColor       =   &H00C0C0C0&
         Height          =   300
         Left            =   120
         Style           =   2  'Dropdown List
         TabIndex        =   4
         Top             =   120
         Width           =   3375
      End
   End
   Begin SSPanel Panel3D1
      BevelOuter      =   1  'Inset
      Height          =   3375
      Index           =   1
      Left            =   3780
      TabIndex        =   8
      Top             =   120
      Width           =   3675
      Begin Outline Outline1
         BackColor       =   &H00C0C0C0&
         Height          =   3135
         Left            =   120
         PictureClosed   =   DATAINFO.FRX:0000
         PictureLeaf     =   DATAINFO.FRX:01A6
         PictureMinus    =   DATAINFO.FRX:034C
         PictureOpen     =   DATAINFO.FRX:04F2
         PicturePlus     =   DATAINFO.FRX:0698
         Style           =   4  'Treelines and Text
         TabIndex        =   3
         Top             =   120
         Width           =   3435
      End
   End
   Begin SSPanel Panel3D1
      BevelOuter      =   1  'Inset
      Height          =   2775
      Index           =   0
      Left            =   120
      TabIndex        =   0
      Top             =   720
      Width           =   3615
      Begin FileListBox File1
         BackColor       =   &H00C0C0C0&
         Height          =   2565
         Left            =   1860
         TabIndex        =   2
         Top             =   120
         Width           =   1635
      End
      Begin DirListBox Dir1
         BackColor       =   &H00C0C0C0&
         Height          =   2505
         Left            =   120
         TabIndex        =   1
         Top             =   120
         Width           =   1695
      End
   End
Option Explicit
Dim db As database
Sub Combo1_Click ()
   Dim c As String
   c = combo1.Text
   c = Left$(c, InStr(c, ",") - 1)
   file1.Pattern = c
   file1.Refresh
End Sub
Sub Command2_Click ()
   Unload form1
   End
End Sub
Sub Command3_Click ()
   Dim cMsg As String
   cMsg = "DataInformatter" + Chr$(10) + Chr$(10)
   cMsg = cMsg + "Yup, this is a first attempt at a VB app." + Chr$(10) + Chr$(10)
   cMsg = cMsg + "If you try it, the PRINT option doesn't work.  This" + Chr$(10)
   cMsg = cMsg + "is a RoundToit control, that is, _i'll get around to it_" + Chr$(10)
   cMsg = cMsg + "sometime.  Also, the only selection from the file type" + Chr$(10)
   cMsg = cMsg + "that works is the access/vb selection.  Again, this is another" + Chr$(10)
   cMsg = cMsg + "RoundToit control." + Chr$(10) + Chr$(10)
   cMsg = cMsg + "If you find it useful, have a good scotch for me," + Chr$(10)
   cMsg = cMsg + "if you don't find it useful, waddya want for nothing??" + Chr$(10) + Chr$(10)
   cMsg = cMsg + "I know it's sloppy, but you try and break a world record" + Chr$(10)
   cMsg = cMsg + "while learning to walk. <insert emoticron of choice here>" + Chr$(10) + Chr$(10)
   cMsg = cMsg + "D Roussos, 75000,720"
   MsgBox cMsg
End Sub
Sub Dir1_Change ()
   file1.Path = dir1.Path
End Sub
Sub Drive1_Change ()
   dir1.Path = drive1.Drive
End Sub
Function FieldType (nFT As Integer, nDB As Integer) As String
' nFt is numeric field type
' nDB is numeric database type
' returns field typa as string
   Dim c As String
   c = "undefined"
   Select Case nDB
      Case 1   ' access/vb
         Select Case nFT
         Case DB_BOOLEAN
            c = "boolean"
         Case DB_BYTE
            c = "byte"
         Case DB_INTEGER
            c = "integer"
         Case DB_LONG
            c = "long"
         Case DB_CURRENCY
            c = "currency"
         Case DB_SINGLE
            c = "single"
         Case DB_DOUBLE
            c = "double"
         Case DB_DATE
            c = "date"
         Case DB_TEXT
            c = "text"
         Case DB_LONGBINARY
            c = "binary"
         Case DB_MEMO
            c = "memo"
         End Select
      'Case 2   ' dbase
   End Select
   FieldType = c
End Function
Sub File1_DblClick ()
   Dim c As String
   c = dir1.Path + "\"
   c = c + file1.List(file1.ListIndex)
   ' fill the outline with tables and fields
   FillOutline c
   command1.Enabled = True
End Sub
Sub File1_PathChange ()
   outline1.Clear
   command1.Enabled = False
End Sub
Sub File1_PatternChange ()
   outline1.Clear
   command1.Enabled = False
End Sub
Sub FillOutline (cDB As String)
   Dim n1 As Integer
   Dim n3 As Integer
   Dim nAttr As Long
   Dim nType As Integer
   Dim nSize As Integer
   Dim c1 As String
   Dim c2 As String
   ' open db
   Set db = OpenDatabase(cDB, False, True)
   ' clear outline
   outline1.Clear
   ' add db title to outline
   outline1.AddItem file1.List(file1.ListIndex), 0
   ' go through list of tables
   For n1 = 0 To db.TableDefs.Count - 1
      ' get table name and attribs
      c1 = db.TableDefs(n1).Name
      nAttr = db.TableDefs(n1).Attributes

      ' if isn't system db...
      If nAttr And DB_SYSTEMOBJECT Then
      Else
         ' then add db name to outline using -1 to place at indent 1
         outline1.AddItem c1
         outline1.Indent(outline1.ListCount - 1) = 1
         ' set location so following additions will be at right level
         outline1.AddItem "Fields"
         outline1.Indent(outline1.ListCount - 1) = 2

         For n3 = 0 To db.TableDefs(n1).Fields.Count - 1
            nType = db.TableDefs(n1).Fields(n3).Type
            nSize = db.TableDefs(n1).Fields(n3).Size
            c2 = db.TableDefs(n1).Fields(n3).Name + ", "
            c2 = c2 + FieldType(nType, 1) + Str$(nSize)
            outline1.AddItem c2
            outline1.Indent(outline1.ListCount - 1) = 3

         Next n3

         outline1.AddItem "Indexes"
         outline1.Indent(outline1.ListCount - 1) = 2
         For n3 = 0 To db.TableDefs(n1).Indexes.Count - 1
            c2 = db.TableDefs(n1).Indexes(n3).Name + ","
            c2 = c2 + db.TableDefs(n1).Indexes(n3).Fields
            outline1.AddItem c2
            outline1.Indent(outline1.ListCount - 1) = 3
         Next n3
      End If
   Next n1
   db.Close
End Sub
Sub Form_Load ()
   Dim c As String
   combo1.AddItem "*.mdb, Access\VB"
   combo1.AddItem "*.dbf, xBase"
   combo1.AddItem "*.*, all files"
   combo1.ListIndex = 0
   c = combo1.List(combo1.ListIndex)
   c = Left$(c, InStr(c, ",") - 1)
   file1.Pattern = c
End Sub
Sub Outline1_DblClick ()
   If outline1.Expand(outline1.ListIndex) Then
      outline1.Expand(outline1.ListIndex) = False
   Else
      outline1.Expand(outline1.ListIndex) = True
   End If
End Sub