QBasic & Borland Pascal & C/Delphi5.iso/Basic/Samples/VB_SMPL/VB_SMPL.ZIP/SEEKLST.EXE/SEEK_PUB.FRM

Visual Basic Form | 1994-04-26 | 10.5 KB | 333 lines

VERSION 2.00
Begin Form Form1
   Caption         =   "Table Object of Publishers Name from List box to Seek"
   ClientHeight    =   5865
   ClientLeft      =   1110
   ClientTop       =   1020
   ClientWidth     =   6375
   Height          =   6270
   Left            =   1050
   LinkTopic       =   "Form1"
   ScaleHeight     =   5865
   ScaleWidth      =   6375
   Top             =   675
   Width           =   6495
   Begin CommandButton Command4
      Caption         =   "Push to Not Save Changes"
      Height          =   615
      Left            =   120
      TabIndex        =   21
      Top             =   5040
      Visible         =   0   'False
      Width           =   2415
   End
   Begin CommandButton Command3
      Caption         =   "Push to Save Changes"
      Height          =   615
      Left            =   3840
      TabIndex        =   11
      Top             =   5040
      Visible         =   0   'False
      Width           =   2415
   End
   Begin TextBox Text8
      Height          =   375
      Left            =   3840
      TabIndex        =   2
      Top             =   1320
      Width           =   2295
   End
   Begin TextBox Text7
      Height          =   375
      Left            =   4080
      TabIndex        =   7
      Top             =   2760
      Width           =   2055
   End
   Begin TextBox Text6
      Height          =   375
      Left            =   4920
      TabIndex        =   5
      Top             =   2040
      Width           =   1215
   End
   Begin TextBox Text5
      Height          =   375
      Left            =   3240
      TabIndex        =   4
      Top             =   2040
      Width           =   975
   End
   Begin TextBox Text4
      Height          =   375
      Left            =   720
      TabIndex        =   3
      Top             =   2040
      Width           =   1575
   End
   Begin TextBox Text3
      Height          =   375
      Left            =   1200
      TabIndex        =   6
      Top             =   2760
      Width           =   1815
   End
   Begin TextBox Text2
      Height          =   375
      Left            =   1920
      TabIndex        =   8
      Top             =   3480
      Width           =   2295
   End
   Begin ListBox List1
      Height          =   615
      Left            =   1800
      Sorted          =   -1  'True
      TabIndex        =   0
      Top             =   480
      Width           =   2775
   End
   Begin TextBox Text1
      Height          =   375
      Left            =   2160
      TabIndex        =   1
      Top             =   1320
      Width           =   735
   End
   Begin CommandButton Command2
      Caption         =   "Push to make Read/Write"
      Height          =   495
      Left            =   3840
      TabIndex        =   10
      Top             =   4200
      Width           =   2415
   End
   Begin CommandButton Command1
      Caption         =   "Push to make ReadOnly"
      Height          =   495
      Left            =   120
      TabIndex        =   9
      Top             =   4200
      Width           =   2415
   End
   Begin Label Label10
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      Caption         =   "Default is Read/Write"
      FontBold        =   -1  'True
      FontItalic      =   -1  'True
      FontName        =   "MS Sans Serif"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   240
      Left            =   1800
      TabIndex        =   22
      Top             =   0
      Width           =   2355
   End
   Begin Label Label9
      Caption         =   "Address:"
      Height          =   255
      Left            =   3000
      TabIndex        =   20
      Top             =   1320
      Width           =   735
   End
   Begin Label Label8
      Caption         =   "Fax:"
      Height          =   255
      Left            =   3480
      TabIndex        =   19
      Top             =   2760
      Width           =   495
   End
   Begin Label Label7
      Caption         =   "Zip:"
      Height          =   255
      Left            =   4440
      TabIndex        =   18
      Top             =   2040
      Width           =   375
   End
   Begin Label Label6
      Caption         =   "State:"
      Height          =   255
      Left            =   2520
      TabIndex        =   17
      Top             =   2040
      Width           =   615
   End
   Begin Label Label5
      Caption         =   "City:"
      Height          =   255
      Left            =   120
      TabIndex        =   16
      Top             =   2040
      Width           =   495
   End
   Begin Label Label4
      Caption         =   "Company Name:"
      Height          =   255
      Left            =   120
      TabIndex        =   15
      Top             =   3600
      Width           =   1455
   End
   Begin Label Label3
      Caption         =   "Telephone:"
      Height          =   255
      Left            =   120
      TabIndex        =   14
      Top             =   2760
      Width           =   975
   End
   Begin Label Label2
      Caption         =   "Select a Publisher's Name from the List ---->"
      Height          =   735
      Left            =   120
      TabIndex        =   13
      Top             =   360
      Width           =   1575
   End
   Begin Label Label1
      Caption         =   "Publisher Identification:"
      Height          =   255
      Left            =   120
      TabIndex        =   12
      Top             =   1320
      Width           =   2055
   End
Option Explicit
Dim readonly_flag%              '** readonly flag var
Dim idx%                        '** index var for combo boxes
Dim a%                          '** holds the Pubid num selected from list box
Dim db1 As database             '** database var
Dim ds1 As dynaset              '** dynaset var
Dim tbl1 As table               '** table var for seeking
Sub check_if_readonly (keyascii As Integer)
 If keyascii > 0 And readonly_flag% = 1 Then     '** if they press any key and readonly_flag% = 1 then
  keyascii = 0                                   '** turn keystroke off
 Else
  command3.Visible = True
  command4.Visible = True
 End If
End Sub
Sub Command1_Click ()
 readonly_flag% = 1          '*** set readonly_flag% to 1 to makde text boxes readonly
 label10.Caption = "ReadOnly record"
End Sub
Sub Command2_Click ()
 readonly_flag% = 0          '*** set readonly_flag% to 0 to make text boxes read/write
 label10.Caption = "Read/Write record"
End Sub
Sub Command3_Click ()
 label10.Caption = "Changes made to the record, select another record"
 Call update_record
End Sub
Sub Command4_Click ()
 list1.SetFocus
 label10.Caption = "No Changes made to the record, re-select same record"
 command3.Visible = False
 command4.Visible = False
 label2.Caption = "Select another Publisher's Name from the List ---->"
End Sub
Sub Form_Load ()
 readonly_flag% = 0        '** set default to read/write
 Set db1 = OpenDatabase("c:\vb\biblio.mdb", False, True)      '** may need to change path, opened for readonly for readonly list box(faster)
 Set ds1 = db1.CreateDynaset("select name from publishers")   '** bring in all(*) record in the authors table
 Do While ds1.EOF = False
  list1.AddItem " " & ds1("name")   '** add publisher names, if null add a space
  ds1.MoveNext
 Loop
 ds1.Close
 db1.Close
End Sub
Sub List1_Click ()
If readonly_flag% = 1 Then
 label10.Caption = "ReadOnly record"
 Set db1 = OpenDatabase("c:\vb\biblio.mdb", False, True)      '** may need to change path, opened for readonly for readonly list box(faster)
 label10.Caption = "Read/Write record"
 Set db1 = OpenDatabase("c:\vb\biblio.mdb")      '** may need to change path, opened for read/write
End If
 a% = list1.ListIndex
 Set tbl1 = db1.OpenTable("publishers")
 tbl1.Index = "primarykey"
 tbl1.Seek "=", a% + 1
If tbl1.NoMatch Then
 text1.Text = " "
 text2.Text = " "
 text3.Text = " "
 text4.Text = " "
 text5.Text = " "
 text6.Text = " "
 text7.Text = " "
 text8.Text = " "
 text1.Text = Trim$(Str$(tbl1("PubID")))
 text2.Text = Trim$(" " & tbl1("Company Name"))
 text3.Text = Trim$(" " & tbl1("telephone"))
 text4.Text = Trim$(" " & tbl1("city"))
 text5.Text = Trim$(" " & tbl1("state"))
 text6.Text = Trim$(" " & tbl1("zip"))
 text7.Text = Trim$(" " & tbl1("fax"))
 text8.Text = Trim$(" " & tbl1("Address"))
End If
 tbl1.Close
 db1.Close
 text1.SetFocus
End Sub
Sub Text1_KeyPress (keyascii As Integer)
 Call check_if_readonly(keyascii)    '** call procedure for readonly or not
End Sub
Sub Text2_KeyPress (keyascii As Integer)
 Call check_if_readonly(keyascii)    '** call procedure for readonly or not
End Sub
Sub Text3_KeyPress (keyascii As Integer)
 Call check_if_readonly(keyascii)    '** call procedure for readonly or not
End Sub
Sub Text4_KeyPress (keyascii As Integer)
 Call check_if_readonly(keyascii)    '** call procedure for readonly or not
End Sub
Sub Text5_KeyPress (keyascii As Integer)
 Call check_if_readonly(keyascii)    '** call procedure for readonly or not
End Sub
Sub Text6_KeyPress (keyascii As Integer)
 Call check_if_readonly(keyascii)    '** call procedure for readonly or not
End Sub
Sub Text7_KeyPress (keyascii As Integer)
 Call check_if_readonly(keyascii)    '** call procedure for readonly or not
End Sub
Sub Text8_KeyPress (keyascii As Integer)
 Call check_if_readonly(keyascii)    '** call procedure for readonly or not
End Sub
Sub update_record ()
 Set db1 = OpenDatabase("c:\vb\biblio.mdb")   '** may need to change path
 Set tbl1 = db1.OpenTable("publishers")
 tbl1.Index = "primarykey"
 tbl1.Seek "=", a% + 1                                 '** retain old record to update
If tbl1.NoMatch Then
 text1.Text = " "
 text2.Text = " "
 text3.Text = " "
 text4.Text = " "
 text5.Text = " "
 text6.Text = " "
 text7.Text = " "
 text8.Text = " "
 tbl1.Edit
 tbl1("PubID") = Val(text1.Text)
 tbl1("Company Name") = text2.Text
 tbl1("telephone") = text3.Text
 tbl1("city") = text4.Text
 tbl1("state") = text5.Text
 tbl1("zip") = text6.Text
 tbl1("fax") = text7.Text
 tbl1("Address") = text8.Text
 tbl1.Update
End If
 tbl1.Close
 db1.Close
 command3.Visible = False
 command4.Visible = False
End Sub