Liren Large Software Subsidy 10

home *** CD-ROM | disk | FTP | other *** search

/ Liren Large Software Subsidy 10 / 10.iso / l / l406 / 4.ddi / TBLSTRU.FR_ / TBLSTRU.bin

(.txt)

Wrap

Visual Basic Form | 1992-10-21 | 12.9 KB | 472 lines

VERSION 2.00 Begin Form fTblStru BackColor = &H00FFFF80& ControlBox = 0 'False Height = 5955 Icon = 0 Left = 2055 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 5550 ScaleWidth = 5040 Top = 1140 Width = 5160 Begin TextBox cTableName Height = 288 Left = 1560 TabIndex = 0 Top = 120 Width = 1932 End Begin PictureBox IndexBox BackColor = &H00FFFF80& BorderStyle = 0 'None Height = 1692 Left = 120 ScaleHeight = 1695 ScaleWidth = 4815 TabIndex = 9 Top = 3720 Width = 4812 Begin CommandButton PrintButton Caption = "&Print Structure" Height = 375 Left = 600 TabIndex = 14 Top = 1320 Visible = 0 'False Width = 1455 End Begin CommandButton AddTableButton Cancel = -1 'True Caption = "&Build the Table" Enabled = 0 'False Height = 372 Left = 600 TabIndex = 8 Top = 1320 Visible = 0 'False Width = 1452 End Begin CommandButton CloseButton Caption = "&Close" Height = 372 Left = 2760 TabIndex = 3 Top = 1320 Width = 1452 End Begin CommandButton AddIndexButton Caption = "Add &Index" Height = 252 Left = 1080 TabIndex = 5 Top = 120 Width = 1332 End Begin CommandButton DelIndexButton Caption = "&Delete Index" Height = 252 Left = 2520 TabIndex = 6 Top = 120 Width = 1332 End Begin Grid cIndexes Cols = 3 FixedCols = 0 Height = 708 Left = 0 TabIndex = 2 Top = 396 Width = 4812 End Begin Line Line1 BorderWidth = 5 X1 = 0 X2 = 4800 Y1 = 0 Y2 = 0 End Begin Label IndexesLabel BackColor = &H00FFFF80& Caption = "Indexes:" Height = 252 Left = 120 TabIndex = 10 Top = 120 Width = 1092 End End Begin PictureBox FieldBox BackColor = &H00FFFF80& BorderStyle = 0 'None Height = 2892 Left = 120 ScaleHeight = 2895 ScaleWidth = 4815 TabIndex = 11 Top = 600 Width = 4812 Begin CommandButton RemoveFieldButton Caption = "&Remove Field" Height = 252 Left = 2520 TabIndex = 7 Top = 0 Visible = 0 'False Width = 1332 End Begin CommandButton AddFieldButton Caption = "&Add Field" Height = 252 Left = 1080 TabIndex = 4 Top = 0 Width = 1332 End Begin Grid cFields BackColor = &H00FFFFFF& Cols = 3 FixedCols = 0 Height = 2532 Left = 0 TabIndex = 1 Top = 290 Width = 4800 End Begin Label FieldsLabel BackColor = &H00FFFF80& Caption = "Fields:" Height = 252 Left = 120 TabIndex = 12 Top = 0 Width = 732 End End Begin Label TableNameLabel BackColor = &H00FFFF80& Caption = "Table Name:" Height = 252 Left = 360 TabIndex = 13 Top = 120 Width = 1212 End Option Explicit Sub AddFieldButton_Click () MsgBar "Enter New Field Parameters, Press 'Close' when finished", False fAddField.Show MODAL MsgBar "", False End Sub Sub AddIndexButton_Click () MsgBar "Enter New Index Parameters, Press 'Close' when finished", False fIndexAdd.Show MODAL MsgBar "", False End Sub Sub AddTableButton_Click () Dim tbl As New TableDef Dim fld As Field Dim ind As Index Dim i As Integer Dim x As String On Error GoTo ATErr SetHourGlass Me MsgBar "Building New Table", True tbl.Name = cTableName 'search to see if table exists For i = 0 To gCurrentDB.TableDefs.Count - 1 If UCase(gCurrentDB.TableDefs(i).Name) = UCase(tbl.Name) Then If MsgBox(tbl.Name + " already exists, delete it?", 4) = YES Then gCurrentDB.TableDefs.Delete gCurrentDB.TableDefs(tbl.Name) Else Exit Sub End If Exit For End If Next 'add the first field cFields.Row = 1 cFields.Col = 0 If cFields = "" Then Beep MsgBox "No Fields Defined!", 48 Exit Sub End If Set fld = New Field fld.Name = cFields cFields.Col = 1 fld.Type = GetFieldType((cFields)) cFields.Col = 2 fld.Size = Val(cFields) tbl.Fields.Append fld gCurrentDB.TableDefs.Append tbl 'add the rest of the fields For i = 2 To cFields.Rows - 1 Set fld = New Field cFields.Row = i cFields.Col = 0 fld.Name = cFields cFields.Col = 1 fld.Type = GetFieldType((cFields)) cFields.Col = 2 fld.Size = Val(cFields) gCurrentDB.TableDefs(tbl.Name).Fields.Append fld Next 'add the indexes For i = 1 To cIndexes.Rows - 1 Set ind = New Index cIndexes.Row = i cIndexes.Col = 0 If cIndexes = "" Then Exit For ind.Name = cIndexes cIndexes.Col = 1 ind.Fields = cIndexes cIndexes.Col = 2 If cIndexes = "True" Then ind.Unique = True Else ind.Unique = False End If gCurrentDB.TableDefs(tbl.Name).Indexes.Append ind Next fTables.cTableList.AddItem tbl.Name Unload Me GoTo ATEnd ATErr: ResetMouse Me ShowError Resume ATEnd ATEnd: ResetMouse Me MsgBar "", False End Sub Sub CloseButton_Click () Unload Me MsgBar "", False End Sub Sub cTableName_Change () If cTableName = "" Then AddTableButton.Enabled = False Else AddTableButton.Enabled = True End If End Sub Sub DelIndexButton_Click () cIndexes.Row = cIndexes.SelStartRow cIndexes.Col = 0 If cIndexes = "" Then Exit Sub If MsgBox("Delete """ + cIndexes + """ index?", MSGBOX_TYPE) = YES Then If gfAddTableFlag = False Then gCurrentDB.TableDefs(fTables.cTableList).Indexes.Delete gCurrentDB.TableDefs(fTables.cTableList).Indexes(cIndexes) End If 'refresh the list of indexes If cIndexes.Rows = 2 Then cIndexes.Col = 0 cIndexes = "" cIndexes.Col = 1 cIndexes = "" cIndexes.Col = 2 cIndexes = "" Else cIndexes.RemoveItem cIndexes.Row End If End If End Sub Sub Form_Load () Dim tbl As TableDef Dim i As Integer Dim s As String MsgBar "Opening Design Form", True 'setup field grid titles cFields.ColWidth(0) = 2500 cFields.ColWidth(1) = 1500 cFields.ColWidth(2) = 500 cFields.Row = 0 cFields.Col = 0 cFields = "Name" cFields.Col = 1 cFields = "Type" cFields.Col = 2 cFields = "Size" 'setup index grid titles cIndexes.ColWidth(0) = 850 cIndexes.ColWidth(1) = 3012 cIndexes.ColWidth(2) = 650 cIndexes.Row = 0 cIndexes.Col = 0 cIndexes = "Name" cIndexes.Col = 1 cIndexes = "Indexed Fields" cIndexes.Col = 2 cIndexes = "Unique" If gfAddTableFlag = True Then Caption = "Add Table" AddTableButton.Visible = True RemoveFieldButton.Visible = True cFields.Rows = 2 cIndexes.Rows = 2 Else Caption = "View/Modify Structure" PrintButton.Visible = True fTblStru.cTableName = fTables.cTableList 'view / modify Set tbl = gCurrentDB.TableDefs(fTables.cTableList) tbl.Fields.Refresh tbl.Indexes.Refresh cFields.Rows = tbl.Fields.Count + 1 For i = 1 To cFields.Rows - 1 cFields.Row = i cFields.Col = 0 cFields = tbl.Fields(i - 1).Name cFields.Col = 1 Select Case tbl.Fields(i - 1).Type Case FT_TRUEFALSE s = "True/False" Case FT_BYTE s = "Byte" Case FT_INTEGER s = "Integer" Case FT_LONG s = "Long" Case FT_CURRENCY s = "Currency" Case FT_SINGLE s = "Single" Case FT_DOUBLE s = "Double" Case FT_DATETIME s = "Date/Time" Case 9 s = "Reserved/9" Case FT_STRING s = "String" Case 11 s = "Reserved/11" Case FT_MEMO s = "Memo" Case Else s = CStr(tbl.Fields(i - 1).Type) End Select cFields = s cFields.Col = 2 cFields = CStr(tbl.Fields(i - 1).Size) Next If tbl.Indexes.Count = 0 Then cIndexes.Rows = 2 Else cIndexes.Rows = tbl.Indexes.Count + 1 For i = 1 To cIndexes.Rows - 1 cIndexes.Row = i cIndexes.Col = 0 cIndexes = tbl.Indexes(i - 1).Name cIndexes.Col = 1 cIndexes = tbl.Indexes(i - 1).Fields cIndexes.Col = 2 If tbl.Indexes(i - 1).Unique = False Then s = "False" Else s = "True" End If cIndexes = s Next End If End If 'lock the titles row and set the selected cell cFields.Row = 1 cFields.SelStartCol = 0 cFields.SelEndCol = 0 cFields.FixedRows = 1 cIndexes.Row = 1 cIndexes.SelStartCol = 0 cIndexes.SelEndCol = 0 cIndexes.FixedRows = 1 ResizeFieldGrid MsgBar "", False End Sub Sub Form_Resize () If WindowState <> 1 Then If Width < 5190 Then Width = 5190 End If FieldBox.Width = Width - 350 cFields.Width = FieldBox.Width IndexBox.Width = Width - 350 cIndexes.Width = IndexBox.Width End If End Sub Sub PrintButton_Click () 'this routine simply prints the currently 'selected table's definition Dim i As Integer Dim s As String MsgBar "Printing Table Structure", True Printer.Print Printer.Print Printer.Print Printer.Print "DataBase: " + gstDBName Printer.Print Printer.Print Printer.Print "Table Definition for " + cTableName Printer.Print Printer.Print Printer.Print "Fields: (Name - Type - Size)" Printer.Print String(60, "-") For i = 1 To cFields.Rows - 1 cFields.Row = i cFields.Col = 0 s = cFields + " - " cFields.Col = 1 s = s + cFields + " - " cFields.Col = 2 s = s + cFields Printer.Print s Next Printer.Print Printer.Print Printer.Print "Index List (Name - Fields - Unique)" Printer.Print String(60, "-") For i = 1 To cIndexes.Rows - 1 cIndexes.Row = i cIndexes.Col = 0 s = cIndexes + " - " cIndexes.Col = 1 s = s + cIndexes + " - " cIndexes.Col = 2 s = s + cIndexes Printer.Print s Next Printer.NewPage Printer.EndDoc MsgBar "", False End Sub Sub RemoveFieldButton_Click () cFields.Row = cFields.SelStartRow cFields.Col = 0 If cFields = "" Then Exit Sub If MsgBox("Remove """ + cFields + """ field?", MSGBOX_TYPE) = YES Then 'refresh the list of indexes If cFields.Rows = 2 Then cFields.Col = 0 cFields = "" cFields.Col = 1 cFields = "" cFields.Col = 2 cFields = "" Else cFields.RemoveItem cFields.Row ResizeFieldGrid End If End If End Sub Sub ResizeFieldGrid () If cFields.Rows < 12 Then cFields.Height = cFields.Rows * 232 FieldBox.Height = cFields.Height + 360 IndexBox.Top = FieldBox.Top + FieldBox.Height + 250 Height = IndexBox.Top + IndexBox.Height + 500 End If End Sub