home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD1257312112000.psc / frmCreateTable.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2000-11-28  |  8.1 KB  |  246 lines
  1. VERSION 5.00
  2. Begin VB.Form frmCreateTable 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "Create Table"
  5.    ClientHeight    =   2610
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   6225
  9.    LinkTopic       =   "Form1"
  10.    MaxButton       =   0   'False
  11.    MDIChild        =   -1  'True
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   2610
  14.    ScaleWidth      =   6225
  15.    ShowInTaskbar   =   0   'False
  16.    Begin VB.ComboBox cmbType 
  17.       Height          =   315
  18.       Left            =   1200
  19.       TabIndex        =   12
  20.       Top             =   1200
  21.       Width           =   1575
  22.    End
  23.    Begin VB.CommandButton cmdClose 
  24.       Caption         =   "Close"
  25.       Height          =   375
  26.       Left            =   1680
  27.       TabIndex        =   10
  28.       Top             =   2160
  29.       Width           =   1335
  30.    End
  31.    Begin VB.CommandButton cmdBuildTable 
  32.       Caption         =   "Build Table"
  33.       Height          =   375
  34.       Left            =   240
  35.       TabIndex        =   9
  36.       Top             =   2160
  37.       Width           =   1335
  38.    End
  39.    Begin VB.CommandButton cmdRemoveField 
  40.       Caption         =   "Remove Field"
  41.       Height          =   375
  42.       Left            =   1680
  43.       TabIndex        =   8
  44.       Top             =   1680
  45.       Width           =   1335
  46.    End
  47.    Begin VB.CommandButton cmdADDField 
  48.       Caption         =   "Add Field"
  49.       Height          =   375
  50.       Left            =   240
  51.       TabIndex        =   7
  52.       Top             =   1680
  53.       Width           =   1335
  54.    End
  55.    Begin VB.ListBox lstFields 
  56.       Height          =   2400
  57.       Left            =   3360
  58.       TabIndex        =   6
  59.       Top             =   120
  60.       Width           =   2775
  61.    End
  62.    Begin VB.TextBox txtSize 
  63.       Height          =   285
  64.       Left            =   1200
  65.       TabIndex        =   5
  66.       Top             =   840
  67.       Width           =   1575
  68.    End
  69.    Begin VB.TextBox txtFieldName 
  70.       Height          =   285
  71.       Left            =   1200
  72.       TabIndex        =   3
  73.       Top             =   480
  74.       Width           =   2055
  75.    End
  76.    Begin VB.TextBox txtTableName 
  77.       Height          =   285
  78.       Left            =   1200
  79.       TabIndex        =   1
  80.       Top             =   120
  81.       Width           =   2055
  82.    End
  83.    Begin VB.Label Label4 
  84.       Caption         =   "Type"
  85.       Height          =   255
  86.       Left            =   120
  87.       TabIndex        =   11
  88.       Top             =   1200
  89.       Width           =   975
  90.    End
  91.    Begin VB.Label Label3 
  92.       Caption         =   "Size"
  93.       Height          =   255
  94.       Left            =   120
  95.       TabIndex        =   4
  96.       Top             =   840
  97.       Width           =   855
  98.    End
  99.    Begin VB.Label Label2 
  100.       Caption         =   "FieldName"
  101.       Height          =   255
  102.       Left            =   120
  103.       TabIndex        =   2
  104.       Top             =   480
  105.       Width           =   1095
  106.    End
  107.    Begin VB.Label Label1 
  108.       Caption         =   "Table Name"
  109.       Height          =   255
  110.       Left            =   120
  111.       TabIndex        =   0
  112.       Top             =   120
  113.       Width           =   975
  114.    End
  115. Attribute VB_Name = "frmCreateTable"
  116. Attribute VB_GlobalNameSpace = False
  117. Attribute VB_Creatable = False
  118. Attribute VB_PredeclaredId = True
  119. Attribute VB_Exposed = False
  120. Option Explicit
  121. Dim FieldProp() As FieldProperties
  122. Private Sub cmbType_Click()
  123.    Select Case cmbType.ListIndex
  124.           Case 0: txtSize.Text = "1" 'Boolean
  125.                           txtSize.Enabled = False
  126.           Case 1: txtSize.Text = "1" 'Byte
  127.                           txtSize.Enabled = False
  128.           Case 2: txtSize.Text = "2" 'Integer
  129.                           txtSize.Enabled = False
  130.           Case 3: txtSize.Text = "4" 'Long
  131.                           txtSize.Enabled = False
  132.           Case 4: txtSize.Text = "8" '"Currency"
  133.                           txtSize.Enabled = False
  134.           Case 5: txtSize.Text = "4" '"Single"
  135.                           txtSize.Enabled = False
  136.           Case 6: txtSize.Text = "8" '"Double"
  137.                           txtSize.Enabled = False
  138.           Case 7: txtSize.Text = "8" '"Date/Time
  139.                           txtSize.Enabled = False
  140.           Case 8: txtSize.Text = "50" '"Text"
  141.                           txtSize.Enabled = True
  142.           Case 9: txtSize.Text = "0"  '"Binary"
  143.                           txtSize.Enabled = False
  144.           Case 10: txtSize.Text = "0" '"Memo"
  145.                           txtSize.Enabled = False
  146.     End Select
  147. End Sub
  148. Private Sub cmdADDField_Click()
  149. Dim I As Integer
  150.    On Error GoTo cmdADDFieldError
  151.    If txtFieldName.Text = "" Then
  152.       MsgBox "Inccorect Data", vbCritical, "Quarantine Error"
  153.       txtFieldName.SetFocus
  154.       Exit Sub
  155.    End If
  156.    'Check is the Field Size Type correct (only if Type is vbText)
  157.    If Val(txtSize.Text) > 50 Or Val(txtSize.Text) < 1 Then
  158.       MsgBox "Inccorect Data", vbCritical, "Quarantine Error"
  159.       txtSize.SetFocus
  160.       Exit Sub
  161.    End If
  162.    'Check is the field awready created
  163.    For I = 0 To lstFields.ListCount - 1
  164.        If lstFields.List(I) = txtFieldName.Text Then
  165.           MsgBox "The Field: " & txtFieldName.Text & " - awready exist", vbInformation + vbOKOnly, "Quarantine"
  166.           txtFieldName.SetFocus
  167.           Exit Sub
  168.        End If
  169.    Next I
  170.    'If is not add the new field
  171.    lstFields.AddItem txtFieldName.Text
  172.    'Add the field in the temporary array
  173.     ReDim Preserve FieldProp(lstFields.ListCount)
  174.         FieldProp(lstFields.ListCount).FieldName = txtFieldName.Text
  175.         FieldProp(lstFields.ListCount).Size = Val(txtSize)
  176.         FieldProp(lstFields.ListCount).Type = FindTypeConstant(cmbType.Text)
  177.         
  178.    'Prepare txtFieldName for next input
  179.    txtFieldName.Text = ""
  180.    txtFieldName.SetFocus
  181.    Exit Sub
  182. cmdADDFieldError:
  183. MsgBox Err.Description, vbCritical, "QuarantineDB : Error Num." & Err.Number
  184. End Sub
  185. Private Sub cmdBuildTable_Click()
  186. Dim I As Integer
  187.     On Error GoTo cmdBuildTableError
  188.     'proverka dali e vuvedeno ime za tablicata
  189.     If txtTableName.Text = "" Then
  190.        MsgBox "Invalid Table Name", vbCritical, "Quarantine"
  191.        txtTableName.SetFocus
  192.        Exit Sub
  193.     End If
  194.     'Create the table
  195.     Set dbTableDef = dbDataBase.CreateTableDef(txtTableName.Text)
  196.     'Add the fields to the table
  197.     For I = 1 To lstFields.ListCount
  198.         'Set dbFieldDef = dbTableDef.CreateField(lstFields.Text, cmbType.Text, txtSize.Text)
  199.         Set dbFieldNew = dbTableDef.CreateField(FieldProp(I).FieldName, FieldProp(I).Type, FieldProp(I).Size)
  200.         dbTableDef.Fields.Append dbFieldNew
  201.     Next I
  202.     'Add the table in the database
  203.     dbDataBase.TableDefs.Append dbTableDef
  204.     If InputTheNewTable = True Then
  205.        InputTheNewTable = False
  206.        Call InputTablesToListBox(frmDBControl.List1)
  207.     End If
  208.     Exit Sub
  209. cmdBuildTableError:
  210. MsgBox Err.Description, vbCritical, "QuarantineDB : Error Num." & Err.Number
  211. End Sub
  212. Private Sub cmdClose_Click()
  213.     Unload Me
  214. End Sub
  215. Private Sub cmdRemoveField_Click()
  216. Dim I As Integer
  217.    'premahva Item lstFields
  218.    If lstFields.ListIndex > -1 Then
  219.       FieldProp(lstFields.ListIndex + 1).FieldName = lstFields.List(lstFields.ListIndex)
  220.       For I = lstFields.ListIndex + 1 To lstFields.ListCount - 1
  221.           If I < lstFields.ListCount - 1 Then
  222.              FieldProp(I) = FieldProp(I)
  223.           End If
  224.       Next I
  225.       ReDim Preserve FieldProp(lstFields.ListCount - 1)
  226.       
  227.       lstFields.RemoveItem lstFields.ListIndex
  228.    End If
  229. End Sub
  230. Private Sub Form_Load()
  231.    'indecsite se izpolzvat za opredelqne na typa pri suzdavane na poleto
  232.    't.e. vseki indeks otgovarq na suotvetniqt tip
  233.    cmbType.AddItem "Boolean"
  234.    cmbType.AddItem "Byte"
  235.    cmbType.AddItem "Integer"
  236.    cmbType.AddItem "Long"
  237.    cmbType.AddItem "Currency"
  238.    cmbType.AddItem "Single"
  239.    cmbType.AddItem "Double"
  240.    cmbType.AddItem "Date/Time"
  241.    cmbType.AddItem "Text"
  242.    cmbType.AddItem "Bynary"
  243.    cmbType.AddItem "Memo"
  244.    cmbType.ListIndex = 8 'Text
  245. End Sub
  246.