PC World Komputer 1996 February/PCWK0296.iso/po7_win/object10/quote.frm

Text File | 1994-11-30 | 17KB | 508 lines

VERSION 2.00
Begin Form frmQuote
   BorderStyle     =   3  'Fixed Double
   Caption         =   "Quotes"
   ClientHeight    =   6450
   ClientLeft      =   1815
   ClientTop       =   1800
   ClientWidth     =   5715
   Height          =   7140
   Left            =   1755
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   ScaleHeight     =   6450
   ScaleWidth      =   5715
   Top             =   1170
   Width           =   5835
   Begin CommandButton cmdExit
      Caption         =   "Exit"
      Height          =   495
      Left            =   4200
      TabIndex        =   12
      Top             =   5520
      Width           =   1215
   End
   Begin TextBox txtNewPerson
      Height          =   375
      Left            =   3600
      TabIndex        =   11
      Top             =   4560
      Width           =   1815
   End
   Begin CommandButton cmdAddPerson
      Caption         =   "Add:"
      Height          =   375
      Left            =   2880
      TabIndex        =   10
      Top             =   4560
      Width           =   615
   End
   Begin CommandButton cmdAddCategory
      Caption         =   "Add:"
      Height          =   375
      Left            =   240
      TabIndex        =   7
      Top             =   4560
      Width           =   615
   End
   Begin TextBox txtNewCat
      Height          =   375
      Left            =   960
      TabIndex        =   8
      Top             =   4560
      Width           =   1695
   End
   Begin CommandButton cmdAddQuote
      Caption         =   "Add Quote"
      Enabled         =   0   'False
      Height          =   375
      Left            =   3360
      TabIndex        =   3
      Top             =   960
      Width           =   1215
   End
   Begin CommandButton cmdDeleteQuote
      Caption         =   "Delete"
      Height          =   375
      Left            =   3360
      TabIndex        =   4
      Top             =   1440
      Width           =   1215
   End
   Begin Frame Frame2
      Caption         =   "Quote"
      Height          =   2055
      Left            =   240
      TabIndex        =   16
      Top             =   120
      Width           =   4455
      Begin TextBox TheQuote
         DataField       =   "quote"
         DataSource      =   "quotedata"
         Height          =   1095
         Left            =   120
         MultiLine       =   -1  'True
         TabIndex        =   2
         Top             =   840
         Width           =   2775
      End
      Begin OraData quotedata
         AllowMoveLast   =   -1  'True
         AutoBinding     =   -1  'True
         Caption         =   "Reading"
         Connect         =   ""
         DatabaseName    =   ""
         Height          =   270
         HiddenName      =   "quotedata"
         Left            =   120
         Options         =   0
         ReadOnly        =   0   'False
         RecordSource    =   ""
         TabIndex        =   5
         Top             =   360
         TrailingBlanks  =   0   'False
         Width           =   2775
      End
   End
   Begin ListBox perlist
      Height          =   1395
      Left            =   2880
      TabIndex        =   9
      Top             =   3000
      Width           =   2535
   End
   Begin ListBox catlist
      Height          =   1395
      Left            =   240
      TabIndex        =   6
      Top             =   3000
      Width           =   2415
   End
   Begin CommandButton cmdDropTables
      Caption         =   "Drop Tables"
      Height          =   495
      Left            =   2160
      TabIndex        =   1
      Top             =   5520
      Width           =   1455
   End
   Begin CommandButton cmdCreateTables
      Caption         =   "Create Tables"
      Enabled         =   0   'False
      Height          =   495
      Left            =   480
      TabIndex        =   0
      Top             =   5520
      Width           =   1455
   End
   Begin Frame Frame1
      Caption         =   "Table Management"
      Height          =   1095
      Left            =   240
      TabIndex        =   13
      Top             =   5160
      Width           =   3615
   End
   Begin Label Label3
      Caption         =   "Quote Filter:"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   -1  'True
      Height          =   255
      Left            =   2040
      TabIndex        =   17
      Top             =   2400
      Width           =   1455
   End
   Begin Label label1
      Caption         =   "Category:"
      Height          =   255
      Left            =   960
      TabIndex        =   14
      Top             =   2640
      Width           =   1215
   End
   Begin Label Label2
      Caption         =   "Person:"
      Height          =   255
      Left            =   3600
      TabIndex        =   15
      Top             =   2640
      Width           =   1215
   End
   Begin Menu mFile
      Caption         =   "&File"
      Begin Menu mFileExit
         Caption         =   "E&xit"
      End
   End
   Begin Menu mAbout
      Caption         =   "&About"
      Begin Menu mAboutQuote
         Caption         =   "About Quote"
      End
   End
End

Sub catlist_Click ()
    Call QueryQuotes

    ' if we've got a real value, we can enable addnew
    If catlist <> "any" And perlist <> "any" Then
        cmdAddQuote.Enabled = True
    Else
        cmdAddQuote.Enabled = False
    End If

End Sub

Sub cmdAddCategory_Click ()

    If Len(newcat) <= 0 Then
        Exit Sub
    End If

    ' we're adding a new category

    ' construct the sql statement and add to the database
    ' note that the primary key (catnum) is generated by the trigger
    ' we created when we created the table
    sql$ = "insert into qcats (category) values ('"
    sql$ = sql$ + newcat
    sql$ = sql$ + "')"
    OraDatabase.DbExecuteSQL (sql$)

    ' add to the list
    catlist.AddItem newcat
    newcat = ""

End Sub

Sub cmdAddPerson_Click ()
    If Len(newperson) <= 0 Then
        Exit Sub
    End If

    ' we're adding a new category

    ' construct the sql statement and add to the database
    ' note that the primary key (catnum) is generated by the trigger
    ' we created when we created the table
    sql$ = "insert into qpersons (pname) values ('"
    sql$ = sql$ + newperson
    sql$ = sql$ + "')"
    OraDatabase.DbExecuteSQL (sql$)

    ' add to the list
    perlist.AddItem newperson
    newcat = ""

End Sub

Sub cmdAddQuote_Click ()
    Dim mydyn As object

    thequote.Visible = True ' make sure quote can be typed

    ' add a new record to the quote dynaset
    quotedata.Recordset.DbAddNew

    ' we want to fill in the catnum and pnum fields
    ' this requires a quick query to the database
    ' we can get both numbers at once

    sql$ = "select catnum, pnum from qcats,qpersons where category = '"
    sql$ = sql$ + catlist
    sql$ = sql$ + "' and pname = '"
    sql$ = sql$ + perlist
    sql$ = sql$ + "'"
    Set mydyn = OraDatabase.DbCreateDynaset(sql$) ' get the data
    mydyn.DbMoveFirst                            ' move to first record
    quotedata.Recordset.Fields("catnum").Value = mydyn.Fields("catnum")
    quotedata.Recordset.Fields("pnum").Value = mydyn.Fields("pnum")

    ' set the focus to the quote text
    thequote.SetFocus
End Sub

Sub cmdCreateTables_Click ()

    ' The schema we're creating here is a little more complex than is really
    ' needed for this application.  We've "normalized" the quotes data so that
    ' the repeated person and category information is placed in separate tables.
    ' Here, the extra tables don't have much in them - just a string.  In a real
    ' application there would be more data per row of the extra tables, with a
    ' corresponding increase in the efficiency of storage and access.
    ' The tables are broken out here as an example of one way to write a
    ' multiple-table application.

    ' create the quotes table
    sql$ = "create table quotes "
    sql$ = sql$ + "(qnum number not null primary key, "
    sql$ = sql$ + "catnum number not null, "                ' foreign key to category table
    sql$ = sql$ + "pnum number not null, "                  ' foreign key to person table
    sql$ = sql$ + "quote varchar2(200) not null)"           ' the quote
    OraDatabase.DbExecuteSQL (sql$)

    ' create a sequence to be used to give the quotes (& persons & categories) unique values
    OraDatabase.DbExecuteSQL ("create sequence quoteseq")

    ' create the category table
    sql$ = "create table qcats "
    sql$ = sql$ + "(catnum number not null primary key, "  ' category key
    sql$ = sql$ + "category varchar2(20) not null)"        ' the category
    OraDatabase.DbExecuteSQL (sql$)

    ' create the person table
    sql$ = "create table qpersons "
    sql$ = sql$ + "(pnum number not null primary key, "    ' person key
    sql$ = sql$ + "pname varchar2(20) not null)"           ' person's name
    OraDatabase.DbExecuteSQL (sql$)

    ' now create triggers on the tables so that the table indices always get unique values on insert
    sql$ = "create trigger quotesinsert "                       ' create a trigger
    sql$ = sql$ + "before insert on quotes for each row "       ' to be fired on each row insert
    sql$ = sql$ + "declare ii number; begin "
    sql$ = sql$ + "select quoteseq.nextval into ii from dual; "  ' get the next value from the sequence
    sql$ = sql$ + ":new.qnum := ii; "                            ' and set our key to it
    sql$ = sql$ + "end;"
    OraDatabase.DbExecuteSQL (sql$)

    ' do the same for the other tables
    sql$ = "create trigger qcatsinsert "                       ' create a trigger
    sql$ = sql$ + "before insert on qcats for each row "       ' to be fired on each row insert
    sql$ = sql$ + "declare ii number; begin "
    sql$ = sql$ + "select quoteseq.nextval into ii from dual; "  ' get the next value from the sequence
    sql$ = sql$ + ":new.catnum := ii; "                            ' and set our key to it
    sql$ = sql$ + "end;"
    OraDatabase.DbExecuteSQL (sql$)
    sql$ = "create trigger qpersonsinsert "                       ' create a trigger
    sql$ = sql$ + "before insert on qpersons for each row "       ' to be fired on each row insert
    sql$ = sql$ + "declare ii number; begin "
    sql$ = sql$ + "select quoteseq.nextval into ii from dual; "  ' get the next value from the sequence
    sql$ = sql$ + ":new.pnum := ii; "                            ' and set our key to it
    sql$ = sql$ + "end;"
    OraDatabase.DbExecuteSQL (sql$)

    ' fill the category table
    sqla$ = "insert into qcats (category) values "
    sql$ = sqla$ + "('romance')"  ' this will be 1
    OraDatabase.DbExecuteSQL (sql$)
    sql$ = sqla$ + "('animals')"
    OraDatabase.DbExecuteSQL (sql$)
    sql$ = sqla$ + "('politics')"
    OraDatabase.DbExecuteSQL (sql$)
    ' if any are added the quotes table inserts need to be changed (see below)!

    ' fill the person table
    sqla$ = "insert into qpersons (pname) values "
    sql$ = sqla$ + "('shakespeare')"  ' this will be sequence number 4
    OraDatabase.DbExecuteSQL (sql$)
    sql$ = sqla$ + "('blake')"
    OraDatabase.DbExecuteSQL (sql$)
    sql$ = sqla$ + "('poe')"
    OraDatabase.DbExecuteSQL (sql$)
    sql$ = sqla$ + "('lincoln')"
    OraDatabase.DbExecuteSQL (sql$)
    sql$ = sqla$ + "('burns')"
    OraDatabase.DbExecuteSQL (sql$)
    sql$ = sqla$ + "('dickinson')"
    OraDatabase.DbExecuteSQL (sql$)

    ' fill the quotes table
    ' note that we are using explicit values for the foreign keys (catnum & pnum)
    ' it would be better if we looked up the number for the persons and the categories
    ' so that if another category was added the person numbers would still be valid
    sqla$ = "insert into quotes (catnum, pnum, quote) values "
    sql$ = sqla$ + "(1, 4, 'shall I compare thee to a summer''s day?')"
    OraDatabase.DbExecuteSQL (sql$)
    sql$ = sqla$ + "(2, 5, 'tyger, tyger, burning bright, in the forests of the night')"
    OraDatabase.DbExecuteSQL (sql$)
    sql$ = sqla$ + "(2, 6, 'quoth the raven, ''nevermore''')"
    OraDatabase.DbExecuteSQL (sql$)
    sql$ = sqla$ + "(1, 4, 'let me not to the marriage of true minds admit impediment')"
    OraDatabase.DbExecuteSQL (sql$)
    sql$ = sqla$ + "(1, 8, 'my love is like a red, red rose')"
    OraDatabase.DbExecuteSQL (sql$)
    sql$ = sqla$ + "(2, 4, 'eye of newt and toe of frog, wool of bat and tongue of dog')"
    OraDatabase.DbExecuteSQL (sql$)
    sql$ = sqla$ + "(3, 7, 'public opinion in this country is everything')"
    OraDatabase.DbExecuteSQL (sql$)
    sql$ = sqla$ + "(3, 7, 'the ballot is stronger than the bullet')"
    OraDatabase.DbExecuteSQL (sql$)
    sql$ = sqla$ + "(1, 9, 'i cannot live with you, it would be life, and life is over there, behind the shelf')"
    OraDatabase.DbExecuteSQL (sql$)
    sql$ = sqla$ + "(2, 9, 'bees are black with gilt surcingles, buccaneers of buzz')"
    OraDatabase.DbExecuteSQL (sql$)

    ' fix up enabled state
    cmdCreateTables.Enabled = False
    cmdDroptables.Enabled = True
    perlist.Enabled = True
    catlist.Enabled = True
    cmdDeleteQuote.Enabled = True

    ' fill the list boxes
    Call FillLists
End Sub

Sub cmdDeleteQuote_Click ()
    nrecs% = quotedata.Recordset.RecordCount
    quotedata.Recordset.DbDelete

    If nrecs% = 1 Then
        ' we've deleted the only one
        thequote.Visible = False
    Else
        ' let's navigate to another record
        ' the combination of these two always get us
        '   to the next record (or previous if there is no next)
        quotedata.Recordset.DbMovePrevious
        quotedata.Recordset.DbMoveNext
    End If

End Sub

Sub cmdDropTables_Click ()

    ' any errors will probably be that we're dropping something that doesn't exist
    ' just keep going.
    On Error Resume Next

    ' drop the quotes tables
    OraDatabase.DbExecuteSQL ("drop table quotes")
    OraDatabase.DbExecuteSQL ("drop table qcats")
    OraDatabase.DbExecuteSQL ("drop table qpersons")

    ' drop the triggers and sequence
    OraDatabase.DbExecuteSQL ("drop trigger quotesinsert")
    OraDatabase.DbExecuteSQL ("drop trigger qcatsinsert")
    OraDatabase.DbExecuteSQL ("drop trigger qpersonsinsert")
    OraDatabase.DbExecuteSQL ("drop sequence quoteseq")

    ' clear the lists
    catlist.Clear
    perlist.Clear

    ' fix up interface
    cmdCreateTables.Enabled = True
    cmdDroptables.Enabled = False
    perlist.Enabled = False
    catlist.Enabled = False
    cmdDeleteQuote.Enabled = False
    thequote = ""

End Sub

Sub cmdExit_Click ()
 Call mFileExit_Click
End Sub

Sub Form_Load ()
    ' set up the data control
    quotedata.Connect = Connect$
    quotedata.DatabaseName = DatabaseName$

    On Error GoTo handleerr

    ' fill list boxes
    Call FillLists

    ' start the quotes
    Call QueryQuotes

    Exit Sub


handleerr:
    ii% = Err
    If Err = 440 Then ' couldn't open dynasets - tables don't exist?
        cmdDroptables.Enabled = False
        cmdCreateTables.Enabled = True
        catlist.Enabled = False
        perlist.Enabled = False
        cmdDeleteQuote.Enabled = False
    Else
        ' don't know what to do with this error
        MsgBox Error$
    End If
    Exit Sub

End Sub

Sub mAboutQuote_Click ()

 frmAbout.Show MODAL

End Sub

Sub mFileExit_Click ()
 End
End Sub

Sub perlist_Click ()
    Call QueryQuotes

    ' if we've got a real value, we can enable addnew
    If catlist <> "any" And perlist <> "any" Then
        cmdAddQuote.Enabled = True
    Else
        cmdAddQuote.Enabled = False
    End If

End Sub

Sub quotedata_Validate (action As Integer, save As Integer)
    If action = 5 Then
        ' starting to add a record
        quotedata.Caption = "Adding"
    ElseIf action = 3 Then
        ' Moving (could be done with adding record)
        quotedata.Caption = "Reading"
    End If
End Sub