Programming Tool Box/SIMS_2.iso/vb_code1/fox_adr/adr_form.frm

Text File | 1993-08-26 | 20KB | 880 lines

VERSION 2.00
Begin Form adr_form
   Caption         =   "Address Book"
   ClientHeight    =   6240
   ClientLeft      =   2145
   ClientTop       =   2250
   ClientWidth     =   8880
   Height          =   6645
   Icon            =   ADR_FORM.FRX:0000
   Left            =   2085
   LinkTopic       =   "Form1"
   ScaleHeight     =   6240
   ScaleWidth      =   8880
   Top             =   1905
   Width           =   9000
   Begin CommandButton last_but
      Caption         =   "Las&t"
      Height          =   495
      Left            =   2580
      TabIndex        =   33
      Top             =   5640
      Width           =   675
   End
   Begin CommandButton first_but
      Caption         =   "F&irst"
      Height          =   495
      Left            =   240
      TabIndex        =   32
      Top             =   5640
      Width           =   675
   End
   Begin CommandButton list_but
      Caption         =   "&List"
      Height          =   495
      Left            =   4140
      TabIndex        =   28
      Top             =   5640
      Width           =   675
   End
   Begin CheckBox Action_needed
      Caption         =   "&Action needed"
      Height          =   255
      Left            =   1500
      TabIndex        =   27
      Top             =   780
      Width           =   1635
   End
   Begin CheckBox action_check
      Caption         =   "S&how outstanding action only"
      Height          =   375
      Left            =   240
      TabIndex        =   26
      Top             =   5160
      Width           =   2835
   End
   Begin OptionButton order_option
      Caption         =   "Post &code"
      Height          =   375
      Index           =   0
      Left            =   180
      TabIndex        =   24
      Top             =   4620
      Width           =   1215
   End
   Begin OptionButton order_option
      Caption         =   "S&urname"
      Height          =   375
      Index           =   1
      Left            =   180
      TabIndex        =   23
      Top             =   4260
      Width           =   1215
   End
   Begin CommandButton pack_but
      Caption         =   "Pac&k"
      Height          =   495
      Left            =   6480
      TabIndex        =   21
      Top             =   5640
      Width           =   675
   End
   Begin CommandButton del_but
      Caption         =   "&Delete"
      Height          =   495
      Left            =   7260
      TabIndex        =   20
      Top             =   5640
      Width           =   675
   End
   Begin CommandButton new_but
      Caption         =   "Ne&w"
      Height          =   495
      Left            =   4920
      TabIndex        =   19
      Top             =   5640
      Width           =   675
   End
   Begin CommandButton save_but
      Caption         =   "&Save"
      Height          =   495
      Left            =   5700
      TabIndex        =   18
      Top             =   5640
      Width           =   675
   End
   Begin CommandButton quit_but
      Caption         =   "&Quit"
      Height          =   495
      Left            =   8040
      TabIndex        =   14
      Top             =   5640
      Width           =   675
   End
   Begin CommandButton prev_but
      Caption         =   "&Prev"
      Height          =   495
      Left            =   1800
      TabIndex        =   13
      Top             =   5640
      Width           =   675
   End
   Begin TextBox notes_box
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Arial"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   2715
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   10
      Text            =   "Text1"
      Top             =   1080
      Width           =   3015
   End
   Begin TextBox adr5_box
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Arial"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   420
      Left            =   4740
      TabIndex        =   7
      Text            =   "Text1"
      Top             =   3780
      Width           =   3975
   End
   Begin TextBox adr4_box
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Arial"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   420
      Left            =   4740
      TabIndex        =   6
      Text            =   "Text1"
      Top             =   3300
      Width           =   3975
   End
   Begin TextBox fax_box
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Arial"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   420
      Left            =   4740
      TabIndex        =   9
      Text            =   "Text1"
      Top             =   4740
      Width           =   4035
   End
   Begin TextBox tel_box
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Arial"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   420
      Left            =   4740
      TabIndex        =   8
      Text            =   "Text5"
      Top             =   4260
      Width           =   4035
   End
   Begin TextBox adr3_box
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Arial"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   420
      Left            =   4740
      TabIndex        =   5
      Text            =   "Text4"
      Top             =   2820
      Width           =   3975
   End
   Begin TextBox adr2_box
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Arial"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   420
      Left            =   4740
      TabIndex        =   4
      Text            =   "Text3"
      Top             =   2340
      Width           =   3975
   End
   Begin TextBox adr1_box
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Arial"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   420
      Left            =   4740
      TabIndex        =   3
      Text            =   "Text2"
      Top             =   1860
      Width           =   3975
   End
   Begin TextBox surname_box
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Arial"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   420
      Left            =   4740
      TabIndex        =   2
      Text            =   "Text1"
      Top             =   1380
      Width           =   3975
   End
   Begin CommandButton find_but
      Caption         =   "&Find"
      Height          =   495
      Left            =   3360
      TabIndex        =   12
      Top             =   5640
      Width           =   675
   End
   Begin CommandButton next_but
      Caption         =   "&Next"
      Height          =   495
      Left            =   1020
      TabIndex        =   11
      Top             =   5640
      Width           =   675
   End
   Begin TextBox forename_box
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Arial"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   420
      Left            =   4740
      TabIndex        =   1
      Text            =   "Text1"
      Top             =   900
      Width           =   3975
   End
   Begin Label Label9
      Caption         =   "Address:"
      FontBold        =   -1  'True
      FontItalic      =   -1  'True
      FontName        =   "Arial"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      Left            =   3300
      TabIndex        =   31
      Top             =   1920
      Width           =   1335
   End
   Begin Label Label8
      Caption         =   "Forename:"
      FontBold        =   -1  'True
      FontItalic      =   -1  'True
      FontName        =   "Arial"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      Left            =   3300
      TabIndex        =   30
      Top             =   960
      Width           =   1275
   End
   Begin Label Label7
      Caption         =   "Surname:"
      FontBold        =   -1  'True
      FontItalic      =   -1  'True
      FontName        =   "Arial"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      Left            =   3300
      TabIndex        =   29
      Top             =   1440
      Width           =   1335
   End
   Begin Label Label6
      Caption         =   "Sort by:"
      FontBold        =   -1  'True
      FontItalic      =   -1  'True
      FontName        =   "Arial"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      Left            =   120
      TabIndex        =   25
      Top             =   3960
      Width           =   1275
   End
   Begin Label Label5
      Caption         =   "Postcode:"
      FontBold        =   -1  'True
      FontItalic      =   -1  'True
      FontName        =   "Arial"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      Left            =   3300
      TabIndex        =   22
      Top             =   3780
      Width           =   1395
   End
   Begin Label Label4
      Caption         =   "Notes:"
      FontBold        =   -1  'True
      FontItalic      =   -1  'True
      FontName        =   "Arial"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      Left            =   120
      TabIndex        =   17
      Top             =   720
      Width           =   1215
   End
   Begin Label Label3
      Caption         =   "Fax:"
      FontBold        =   -1  'True
      FontItalic      =   -1  'True
      FontName        =   "Arial"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   255
      Left            =   3300
      TabIndex        =   16
      Top             =   4800
      Width           =   1335
   End
   Begin Label Label2
      Caption         =   "Telephone:"
      FontBold        =   -1  'True
      FontItalic      =   -1  'True
      FontName        =   "Arial"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   255
      Left            =   3300
      TabIndex        =   15
      Top             =   4320
      Width           =   1335
   End
   Begin Label Label1
      Alignment       =   2  'Center
      Caption         =   "Address Book"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Arial"
      FontSize        =   24
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   495
      Left            =   0
      TabIndex        =   0
      Top             =   120
      Width           =   8895
   End
End


Sub action_check_click ()
Rem this sets filter to only addresses
Rem with action outstanding

Rem check for changed details before moving
Rem to another record

' If you set a check box value in code, it triggers the click
' event. This is a good way to get infinite loops, and I don't
' like this effect! Therefore I've set a flag so that
' I can ignore unwanted click events.

If ignore_click = 1 Then
ignore_click = 0
Exit Sub
End If

curr_rec = adr_ds!recnum

If chk_change() = "Cancel" Then


' reset check box without triggering code

ignore_click = 1
If action_check.Value = 1 Then
action_check.Value = 0
Else
action_check.Value = 1
End If

Exit Sub
End If

If action_check.Value Then
Rem set filter

filt_adr

    If Not action_check.Value Then
    ' it was changed back by filt_adr because no records exist
    ' with the action field true
    ' so restore current record

    criteria = "recnum = " + Str(curr_rec)
    adr_ds.FindFirst criteria

    End If

Else

refresh_sql

criteria = "recnum = " + Str(curr_rec)
adr_ds.FindFirst criteria

End If

upd_fields

End Sub

Sub Action_needed_Click ()

If newflag Then
' if a new record is current, we cannot
' update the dynaset yet
Exit Sub
End If


adr_ds.Edit

    If action_needed.Value Then
    adr_ds("ACTION") = True
    Else
    adr_ds("ACTION") = False
    End If

adr_ds.Update

If action_check.Value = 1 Then
Rem if we are presenting only records which have the action flag set,
Rem then we need to update the SQL

filt_adr

End If

upd_fields

End Sub

Sub del_but_Click ()

Dim decis As Integer

decis = MsgBox("Really delete record?", 4)

If decis = 6 Then
adr_ds.Delete

    adr_ds.MovePrevious

    If adr_ds.BOF Then
    adr_ds.MoveFirst
    End If

    upd_fields

End If

End Sub

Sub edit_but_Click ()
adr_ds.Edit
End Sub

Sub find_but_Click ()

If chk_change() = "Cancel" Then
Exit Sub
End If

Dim rec_to_find As String, curr_rec As String, quotetest As Integer
curr_rec = adr_ds.Bookmark

If curr_ind = "address5" Then
rec_to_find = InputBox$("Enter a post code", "Find a record")
criteria = "ucase$(address5) >= " + "'" + UCase$(rec_to_find) + "'"

Else
rec_to_find = InputBox$("Enter a surname", "Find a record")

criteria = "ucase$(Surname) >= " + "'" + UCase$(rec_to_find) + "'"

End If

' test for empty string
    If rec_to_find = "" Then
    Exit Sub
    End If

' If user typed in a single quote, this causes a crash!
' Therefore, check first


    quotetest = InStr(rec_to_find, "'")

    If quotetest Then
    MsgBox ("Can't search for value including single quote")
    Exit Sub
    End If

adr_ds.FindFirst criteria

If adr_ds.NoMatch Then
MsgBox ("Not found")
adr_ds.Bookmark = curr_rec
End If



upd_fields

End Sub

Sub first_but_Click ()

If chk_change() = "Cancel" Then
Exit Sub
End If

adr_ds.MoveFirst

upd_fields

End Sub

Sub last_but_Click ()

If chk_change() = "Cancel" Then
Exit Sub
End If

adr_ds.MoveLast

upd_fields

End Sub

Sub list_but_Click ()

curr_rec = adr_ds!recnum

If chk_change() = "Cancel" Then
Exit Sub
End If

If first_list = 1 Then
first_list = 0
Rem refresh list if first time

'It would be nice to refresh list automatically each
'time, but it takes sooooo long it seems better not
'to do it...

upd_list
End If

list_form.Show

End Sub

Sub new_but_Click ()
adr_ds.AddNew
newflag = -1
Dim countsnap As snapshot
Dim newnum As Long

' Now find unique number for recnum field

sql_stmnt = "Select max ([recnum]) as maxrec from address"

Set countsnap = adr_db.CreateSnapshot(sql_stmnt)

countsnap.MoveFirst
newnum = countsnap!maxrec
newnum = newnum + 1

' assign new number to recnum
adr_ds!recnum = newnum

upd_fields
End Sub

Sub next_but_Click ()

If chk_change() = "Cancel" Then
Exit Sub
End If

adr_ds.MoveNext

If Not adr_ds.EOF Then
upd_fields
Else
MsgBox ("No more addresses")
adr_ds.MoveLast
upd_fields
End If


End Sub

Sub notes_box_LostFocus ()

If newflag Then
' can't update dynaset if new record
Exit Sub
End If

adr_ds.Edit
adr_ds("NOTES") = notes_box.Text
adr_ds.Update

End Sub

Sub order_option_Click (Index As Integer)

Dim decis As Integer

curr_rec = adr_ds!recnum

If chk_change() = "Cancel" Then
Exit Sub
End If

Select Case Index

Case 0

curr_ind = "address5"
' address5 is the name of the postcode field

Case 1

curr_ind = "surname"

End Select

refresh_sql

criteria = "recnum = " + Str(curr_rec)

adr_ds.FindFirst criteria

upd_fields

End Sub

Sub pack_but_Click ()

If chk_change() = "Cancel" Then
Exit Sub
End If

screen.MousePointer = 11

Dim adr_tb As table
Dim oldtd As tabledef
Dim newtb As table
Dim newtd As New tabledef
Dim newix As New Index


Dim fieldcount As Integer

curr_rec = adr_ds!recnum

Rem close the dynaset
adr_ds.Close

Set adr_tb = adr_db.OpenTable("ADDRESS")
Rem open the address table

Set oldtd = adr_db.TableDefs("ADDRESS")

Rem define fields
fieldcount = oldtd.Fields.Count - 1

ReDim newfields(fieldcount) As New field

Dim countvar As Integer

For countvar = 0 To fieldcount

newfields(countvar).Name = oldtd.Fields(countvar).Name
newfields(countvar).Type = oldtd.Fields(countvar).Type
newfields(countvar).Size = oldtd.Fields(countvar).Size


Next

Rem now build new tabledef

newtd.Name = "NEWTABLE"

Rem add fields

For countvar = 0 To fieldcount

newtd.Fields.Append newfields(countvar)

Next

Rem append new table to database

adr_db.TableDefs.Append newtd

Rem open new table

Set newtb = adr_db.OpenTable("NEWTABLE")


Rem copy records from old to new

Rem set order to

adr_tb.Index = ""

adr_tb.MoveFirst

sql_stmnt = "insert into newtable select * from address"

adr_db.Execute sql_stmnt

Rem now duplicate indexes

indexcount = oldtd.Indexes.Count - 1

ReDim newindexes(indexcount) As New Index

For countvar = 0 To indexcount
newindexes(countvar).Fields = oldtd.Indexes(countvar).Fields
newindexes(countvar).Name = oldtd.Indexes(countvar).Name
newindexes(countvar).Unique = oldtd.Indexes(countvar).Unique
newindexes(countvar).Primary = oldtd.Indexes(countvar).Primary
Next

Rem add indexes

newtb.Close
Rem must close table before indexing

For countvar = 0 To indexcount
newtd.Indexes.Append newindexes(countvar)
Next

Rem delete and rename

adr_tb.Close
adr_db.Close

Kill "C:\ADR\ADDRESS.DBF"
Kill "C:\ADR\ADDRESS.FPT"
Kill "C:\ADR\ADDRESS.CDX"

Name "C:\ADR\NEWTABLE.DBF" As "C:\ADR\ADDRESS.DBF"
Name "C:\ADR\NEWTABLE.FPT" As "C:\ADR\ADDRESS.FPT"
Name "C:\ADR\NEWTABLE.CDX" As "C:\ADR\ADDRESS.CDX"


Rem reopen database and table

Set adr_db = OpenDatabase("C:\ADR", False, False, "FoxPro 2.5;")

' Restore dynaset

refresh_sql

' restore current record

criteria = "recnum = " + Str(curr_rec)

adr_ds.FindFirst criteria

upd_fields

screen.MousePointer = 0

MsgBox ("Pack completed")

End Sub

Sub prev_but_Click ()

If chk_change() = "Cancel" Then
Exit Sub
End If

adr_ds.MovePrevious

If Not adr_ds.BOF Then
upd_fields
Else
MsgBox ("No previous addresses")
adr_ds.MoveFirst
upd_fields
End If


End Sub

Sub quit_but_Click ()

If chk_change() = "Cancel" Then
Exit Sub
End If

End

End Sub

Sub save_but_Click ()

save_rec

End Sub