home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 26 / CD_ASCQ_26_1295.iso / vrac / z1dbf.zip / MAKEDBF.FRM < prev    next >
Text File  |  1995-07-02  |  14KB  |  436 lines

  1. VERSION 2.00
  2. Begin Form fMain 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   3  'Fixed Double
  5.    Caption         =   "Create DBF"
  6.    ClientHeight    =   4335
  7.    ClientLeft      =   1485
  8.    ClientTop       =   1650
  9.    ClientWidth     =   6540
  10.    Height          =   4740
  11.    Left            =   1425
  12.    LinkTopic       =   "Form1"
  13.    ScaleHeight     =   4335
  14.    ScaleWidth      =   6540
  15.    Top             =   1305
  16.    Width           =   6660
  17.    Begin CommandButton Command2 
  18.       Caption         =   "&Close"
  19.       Height          =   375
  20.       Left            =   1320
  21.       TabIndex        =   16
  22.       Top             =   3840
  23.       Width           =   975
  24.    End
  25.    Begin CommandButton Command1 
  26.       Caption         =   "&Ok"
  27.       Height          =   375
  28.       Left            =   240
  29.       TabIndex        =   15
  30.       Top             =   3840
  31.       Width           =   975
  32.    End
  33.    Begin Frame Frame1 
  34.       BackColor       =   &H00C0C0C0&
  35.       Caption         =   "Table Structure"
  36.       Height          =   3015
  37.       Left            =   240
  38.       TabIndex        =   2
  39.       Top             =   720
  40.       Width           =   6015
  41.       Begin CommandButton Command5 
  42.          Caption         =   "&Delete"
  43.          FontBold        =   0   'False
  44.          FontItalic      =   0   'False
  45.          FontName        =   "MS Sans Serif"
  46.          FontSize        =   8.25
  47.          FontStrikethru  =   0   'False
  48.          FontUnderline   =   0   'False
  49.          Height          =   375
  50.          Left            =   2040
  51.          TabIndex        =   20
  52.          Top             =   2520
  53.          Width           =   855
  54.       End
  55.       Begin CommandButton Command4 
  56.          Caption         =   "&Update"
  57.          FontBold        =   0   'False
  58.          FontItalic      =   0   'False
  59.          FontName        =   "MS Sans Serif"
  60.          FontSize        =   8.25
  61.          FontStrikethru  =   0   'False
  62.          FontUnderline   =   0   'False
  63.          Height          =   375
  64.          Left            =   1080
  65.          TabIndex        =   18
  66.          Top             =   2520
  67.          Width           =   855
  68.       End
  69.       Begin CommandButton Command3 
  70.          Caption         =   "&Add"
  71.          FontBold        =   0   'False
  72.          FontItalic      =   0   'False
  73.          FontName        =   "MS Sans Serif"
  74.          FontSize        =   8.25
  75.          FontStrikethru  =   0   'False
  76.          FontUnderline   =   0   'False
  77.          Height          =   375
  78.          Left            =   120
  79.          TabIndex        =   17
  80.          Top             =   2520
  81.          Width           =   855
  82.       End
  83.       Begin TextBox ctrDec 
  84.          Alignment       =   1  'Right Justify
  85.          Height          =   375
  86.          Left            =   5280
  87.          MaxLength       =   3
  88.          MultiLine       =   -1  'True
  89.          TabIndex        =   13
  90.          Text            =   "0"
  91.          Top             =   2400
  92.          Width           =   615
  93.       End
  94.       Begin TextBox ctrLength 
  95.          Alignment       =   1  'Right Justify
  96.          Height          =   375
  97.          Left            =   3840
  98.          MaxLength       =   3
  99.          MultiLine       =   -1  'True
  100.          TabIndex        =   12
  101.          Text            =   "10"
  102.          Top             =   2400
  103.          Width           =   735
  104.       End
  105.       Begin Frame Frame2 
  106.          BackColor       =   &H00C0C0C0&
  107.          Caption         =   "&Type"
  108.          Height          =   1455
  109.          Left            =   3840
  110.          TabIndex        =   6
  111.          Top             =   720
  112.          Width           =   2055
  113.          Begin OptionButton rdbType 
  114.             BackColor       =   &H00C0C0C0&
  115.             Caption         =   "Memo"
  116.             Height          =   255
  117.             Index           =   4
  118.             Left            =   480
  119.             TabIndex        =   19
  120.             Top             =   1080
  121.             Width           =   975
  122.          End
  123.          Begin OptionButton rdbType 
  124.             BackColor       =   &H00C0C0C0&
  125.             Caption         =   "Logical"
  126.             Height          =   255
  127.             Index           =   3
  128.             Left            =   960
  129.             TabIndex        =   10
  130.             Top             =   720
  131.             Width           =   975
  132.          End
  133.          Begin OptionButton rdbType 
  134.             BackColor       =   &H00C0C0C0&
  135.             Caption         =   "Number"
  136.             Height          =   255
  137.             Index           =   2
  138.             Left            =   960
  139.             TabIndex        =   9
  140.             Top             =   360
  141.             Width           =   975
  142.          End
  143.          Begin OptionButton rdbType 
  144.             BackColor       =   &H00C0C0C0&
  145.             Caption         =   "Date"
  146.             Height          =   255
  147.             Index           =   1
  148.             Left            =   120
  149.             TabIndex        =   8
  150.             Top             =   720
  151.             Width           =   735
  152.          End
  153.          Begin OptionButton rdbType 
  154.             BackColor       =   &H00C0C0C0&
  155.             Caption         =   "Char"
  156.             Height          =   255
  157.             Index           =   0
  158.             Left            =   120
  159.             TabIndex        =   7
  160.             Top             =   360
  161.             Value           =   -1  'True
  162.             Width           =   735
  163.          End
  164.       End
  165.       Begin TextBox ctrFieldName 
  166.          Height          =   375
  167.          Left            =   3840
  168.          MaxLength       =   10
  169.          TabIndex        =   5
  170.          Top             =   240
  171.          Width           =   2055
  172.       End
  173.       Begin ListBox lstFields 
  174.          Height          =   2175
  175.          Left            =   120
  176.          TabIndex        =   3
  177.          TabStop         =   0   'False
  178.          Top             =   360
  179.          Width           =   2775
  180.       End
  181.       Begin Label Label4 
  182.          Alignment       =   1  'Right Justify
  183.          AutoSize        =   -1  'True
  184.          BackColor       =   &H00C0C0C0&
  185.          Caption         =   "Dec"
  186.          Height          =   195
  187.          Left            =   4800
  188.          TabIndex        =   14
  189.          Top             =   2400
  190.          Width           =   360
  191.       End
  192.       Begin Label Label3 
  193.          Alignment       =   1  'Right Justify
  194.          AutoSize        =   -1  'True
  195.          BackColor       =   &H00C0C0C0&
  196.          Caption         =   "Length"
  197.          Height          =   195
  198.          Left            =   3120
  199.          TabIndex        =   11
  200.          Top             =   2400
  201.          Width           =   600
  202.       End
  203.       Begin Label Label2 
  204.          Alignment       =   1  'Right Justify
  205.          BackColor       =   &H00C0C0C0&
  206.          Caption         =   "&Name"
  207.          Height          =   255
  208.          Left            =   3000
  209.          TabIndex        =   4
  210.          Top             =   240
  211.          Width           =   735
  212.       End
  213.    End
  214.    Begin TextBox ctrFileName 
  215.       Height          =   375
  216.       Left            =   1200
  217.       TabIndex        =   1
  218.       Top             =   240
  219.       Width           =   5055
  220.    End
  221.    Begin Label Label1 
  222.       Alignment       =   1  'Right Justify
  223.       BackColor       =   &H00C0C0C0&
  224.       Caption         =   "&Filename"
  225.       Height          =   255
  226.       Left            =   240
  227.       TabIndex        =   0
  228.       Top             =   240
  229.       Width           =   855
  230.    End
  231. End
  232. Option Explicit
  233.  
  234. ' declarations of DLL routines
  235. Declare Function z1Init_Dbf Lib "z1_Dbf.dll" () As Integer
  236. Declare Function z1Add_Dbf_Field Lib "z1_Dbf.dll" (ByVal hDbf As Integer, ByVal cFieldname As String, ByVal cType As String, ByVal length As Integer, ByVal dec As Integer) As Integer
  237. Declare Function z1Create_Dbf Lib "z1_Dbf.dll" (ByVal hDbf As Integer, ByVal cFilename As String) As Integer
  238.  
  239. Sub Command1_Click ()
  240.     Dim i As Integer
  241.     Dim hDbf As Integer
  242.     Dim cName As String
  243.     Dim cType As String
  244.     Dim nLength As Integer
  245.     Dim nDec As Integer
  246.     Dim x As Integer
  247.  
  248.     ' create the dbf now
  249.     If ctrFilename = "" Then
  250.         MsgBox "Invalid filename!", 16, "Error"
  251.         Exit Sub
  252.     End If
  253.  
  254.     hDbf = z1Init_Dbf()
  255.     If hDbf = 0 Then
  256.         MsgBox "Unable to initialise Z1_DBF.DLL", 16, "Error"
  257.         Exit Sub
  258.     End If
  259.     
  260.     ' go to the end of the list so we can then go back to the top
  261.     lstFields.ListIndex = lstFields.ListCount - 1
  262.     For i = 0 To lstFields.ListCount - 1
  263.         ' set position is the same as click
  264.         lstFields.ListIndex = i
  265.         
  266.         ' we should now have the fields setup correctly
  267.         cName = ctrFieldName
  268.         If rdbType(0) Then
  269.             cType = "C"
  270.         ElseIf rdbType(1) Then
  271.             cType = "D"
  272.         ElseIf rdbType(2) Then
  273.             cType = "N"
  274.         ElseIf rdbType(3) Then
  275.             cType = "L"
  276.         ElseIf rdbType(4) Then
  277.             cType = "M"
  278.         End If
  279.         
  280.         nLength = Val(ctrLength)
  281.         nDec = Val(ctrDec)
  282.         If z1Add_Dbf_Field(hDbf, cName, cType, nLength, nDec) = 0 Then
  283.             MsgBox "Unable to add field " + Str(i)
  284.             Exit Sub
  285.         End If
  286.     Next
  287.  
  288.     cName = ctrFilename + ".dbf"
  289.     x = z1Create_Dbf(hDbf, cName)
  290.     If x = 0 Then
  291.         MsgBox "Unable to create DBF file: " & cName, 16, "Error"
  292.     Else
  293.         MsgBox "DBF file: " & cName & " created!", 0, "Make DBF"
  294.     End If
  295.  
  296. End Sub
  297.  
  298. Sub Command2_Click ()
  299.     Unload Me
  300. End Sub
  301.  
  302. Sub Command3_Click ()
  303.     Dim cField As String
  304.     ' add a new field
  305.     If ctrFieldName <> "" Then
  306.         cField = ctrFieldName
  307.         If rdbType(0) Then
  308.             cField = cField + ", Char"
  309.             cField = cField & ", " & ctrLength
  310.         ElseIf rdbType(1) Then
  311.             cField = cField + ", Date"
  312.         ElseIf rdbType(2) Then
  313.             cField = cField + ", Number"
  314.             cField = cField & ", " & ctrLength + "." & ctrDec
  315.         ElseIf rdbType(3) Then
  316.             cField = cField + ", Logical"
  317.         ElseIf rdbType(4) Then
  318.             cField = cField + ", Memo"
  319.         End If
  320.         
  321.         lstFields.AddItem cField
  322.     
  323.     End If
  324.     
  325. End Sub
  326.  
  327. Sub Command4_Click ()
  328.     Dim cField As String
  329.     
  330.     If lstFields.ListIndex >= 0 Then
  331.         ' update field
  332.         If ctrFieldName <> "" Then
  333.             cField = ctrFieldName
  334.             If rdbType(0) Then
  335.                 cField = cField + ", Char"
  336.                 cField = cField & ", " & ctrLength
  337.             ElseIf rdbType(1) Then
  338.                 cField = cField + ", Date"
  339.             ElseIf rdbType(2) Then
  340.                 cField = cField + ", Number"
  341.                 cField = cField & ", " & ctrLength + "." & ctrDec
  342.             ElseIf rdbType(3) Then
  343.                 cField = cField + ", Logical"
  344.             ElseIf rdbType(4) Then
  345.                 cField = cField + ", Memo"
  346.             End If
  347.             
  348.             lstFields.List(lstFields.ListIndex) = cField
  349.         
  350.         End If
  351.     End If
  352.     
  353. End Sub
  354.  
  355. Sub Command5_Click ()
  356.     If lstFields.ListCount > 0 And lstFields.ListIndex >= 0 Then
  357.         lstFields.RemoveItem lstFields.ListIndex
  358.     End If
  359. End Sub
  360.  
  361. Sub ctrFieldName_KeyPress (KeyAscii As Integer)
  362.     KeyAscii = Asc(UCase(Chr(KeyAscii)))
  363. End Sub
  364.  
  365. Sub lstFields_Click ()
  366.     Dim cText As String, cBit As String
  367.     Dim i As Integer
  368.     ' update fields based on current selection
  369.  
  370.     cText = lstFields.Text + ","
  371.     i = InStr(cText, ",")
  372.     If i > 0 Then
  373.         cBit = Trim(Left(cText, i - 1))
  374.         cText = Mid(cText, i + 1)
  375.         ctrFieldName = cBit
  376.         i = InStr(cText, ",")
  377.         If i > 0 Then
  378.             cBit = LTrim(Trim(Left(cText, i - 1)))
  379.             cText = Mid(cText, i + 1)
  380.             Select Case cBit
  381.                 Case "Char"
  382.                     rdbType(0) = True
  383.                 Case "Date"
  384.                     rdbType(1) = True
  385.                 Case "Number"
  386.                     rdbType(2) = True
  387.                 Case "Logical"
  388.                     rdbType(3) = True
  389.                 Case "Memo"
  390.                     rdbType(4) = True
  391.             End Select
  392.             i = InStr(cText, ",")
  393.             If i > 0 Then
  394.                 cBit = Trim(Left(cText, i - 1))
  395.                 cText = Mid(cText, i + 1)
  396.                 ctrLength = cBit
  397.                 If i > 0 Then
  398.                     cBit = Trim(Left(cText, i - 1))
  399.                     cText = Mid(cText, i + 1)
  400.                     ctrDec = cBit
  401.                 End If
  402.             End If
  403.         End If
  404.     End If
  405.  
  406. End Sub
  407.  
  408. Sub rdbType_Click (Index As Integer)
  409.  
  410.     Select Case Index
  411.         Case 0
  412.             ' length only
  413.             ctrLength.Enabled = True
  414.             ctrDec.Enabled = False
  415.         Case 1
  416.             ctrLength = 8
  417.             ctrDec = 0
  418.             ctrLength.Enabled = False
  419.             ctrDec.Enabled = False
  420.         Case 2
  421.             ctrLength.Enabled = True
  422.             ctrDec.Enabled = True
  423.         Case 3
  424.             ctrLength = 1
  425.             ctrDec = 0
  426.             ctrLength.Enabled = False
  427.             ctrDec.Enabled = False
  428.         Case 4
  429.             ctrLength = 10
  430.             ctrDec = 0
  431.             ctrLength.Enabled = False
  432.             ctrDec.Enabled = False
  433.     End Select
  434. End Sub
  435.  
  436.