Programmer 7500/MAX_PROGRAMMERS.iso/VISUAL_B/CODIGO_1/FOX_ADR/ADR.BAS

BASIC Source File | 1993-08-26 | 8.2 KB | 435 lines

Global adr_db As database
Global adr_ds As dynaset
Global newflag As Integer
Global curr_ind As String
Global first_list As Integer
Global curr_rec As Integer
Global ignore_click As Integer



Function chk_change ()

' This is a routine to check if the current record has been edited
' and is therefore different from what is stored on disk.

' Empty fields in the database are returned as nulls. This
' means we cannot compare them directly with entries on the
' form. Therefore, we use the isnull() function to convert null
' fields to empty strings.

Dim changed As Integer
Dim notevar As String
Dim adr1var As String
Dim adr2var As String
Dim adr3var As String
Dim adr4var As String
Dim adr5var As String
Dim telvar As String
Dim faxvar As String
Dim actvar As Integer
Dim forenamevar As String
Dim surnamevar As String


changed = 0
chk_change = ""

If adr_ds("ACTION") = True Then
actvar = 1
Else
actvar = 0
End If

If IsNull(adr_ds("NOTES")) Then
notevar = ""
Else
notevar = adr_ds("NOTES")
End If

If IsNull(adr_ds("FORENAME")) Then
forenamevar = ""
Else
fornamevar = adr_ds("FORENAME")
End If

If IsNull(adr_ds("SURNAME")) Then
surnamevar = ""
Else
surnamevar = adr_ds("SURNAME")
End If

If IsNull(adr_ds("ADDRESS1")) Then
adr1var = ""
Else
adr1var = adr_ds("ADDRESS1")
End If

If IsNull(adr_ds("ADDRESS2")) Then
adr2var = ""
Else
adr2var = adr_ds("ADDRESS2")
End If

If IsNull(adr_ds("ADDRESS3")) Then
adr3var = ""
Else
adr3var = adr_ds("ADDRESS3")
End If

If IsNull(adr_ds("ADDRESS4")) Then
adr4var = ""
Else
adr4var = adr_ds("ADDRESS4")
End If

If IsNull(adr_ds("ADDRESS5")) Then
adr5var = ""
Else
adr5var = adr_ds("ADDRESS5")
End If

If IsNull(adr_ds("TELEPHONE")) Then
telvar = ""
Else
telvar = adr_ds("TELEPHONE")
End If

If IsNull(adr_ds("FAX")) Then
faxvar = ""
Else
faxvar = adr_ds("FAX")
End If

If adr_form.notes_box.Text <> notevar Then
changed = 1
End If

If adr_form.forename_box.Text <> fornamevar Then
changed = 1
End If

If adr_form.surname_box.Text <> surnamevar Then
changed = 1
End If

If adr_form.adr1_box.Text <> adr1var Then
changed = 1
End If

If adr_form.adr2_box.Text <> adr2var Then
changed = 1
End If

If adr_form.adr3_box.Text <> adr3var Then
changed = 1
End If

If adr_form.adr4_box.Text <> adr4var Then
changed = 1
End If

If adr_form.adr5_box.Text <> adr5var Then
changed = 1
End If

If adr_form.tel_box.Text <> telvar Then
changed = 1
End If

If adr_form.fax_box.Text <> faxvar Then
changed = 1
End If

If adr_form.Action_needed.Value <> actvar Then
changed = 1
End If

If changed = 1 Then

Dim decis As Integer

decis = MsgBox("Details have changed. Save changes?", 19)

    Select Case decis

    Case 6

    save_rec

    Case 7

    newflag = 0

    Case 2

    Rem cancel - do nothing

    chk_change = "Cancel"

    End Select

End If


End Function

Sub filt_adr ()
Rem this routine filters the records to show only
Rem those where the "action" field is true

sql_stmnt = "SELECT * from address WHERE address.action=-1 order by ucase$(" + curr_ind + ")"
Set adr_ds = adr_db.CreateDynaset(sql_stmnt)

If adr_ds.RecordCount = 0 Then
Rem test for no records returned

MsgBox ("No outstanding action")
sql_stmnt = "SELECT * from address ORDER BY ucase$(" + curr_ind + ")"
Set adr_ds = adr_db.CreateDynaset(sql_stmnt)

' reset check box without triggering code

ignore_click = 1
adr_form.action_check.Value = 0
End If

adr_ds.MoveFirst

End Sub

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

curr_ind = "surname"
sql_stmnt = "SELECT * from address"
Set adr_ds = adr_db.CreateDynaset(sql_stmnt)

adr_form.Show
upd_fields
Rem update the form now to avoid triggering the
Rem "record has changed" alert in the index routine
adr_form.order_option(1).Value = True
Rem setting this to true also runs the SQL that sets the
Rem order to surname
adr_ds.MoveFirst
upd_fields

first_list = 1

End Sub


Sub refresh_sql ()
' The snag with viewing a dynaset
' rather than the underlying table is that if you add a record
' to the dynaset, or edit an indexed field, the dynaset
' will go out of order.
' Therefore, you need continually to refresh the dynaset
' which is what this routine does.

If adr_form.action_check.Value = 1 Then
' the database is restricted to those with action outstanding

filt_adr

Else
' show all records

sql_stmnt = "SELECT * from address ORDER BY ucase$(" + curr_ind + ")"
Set adr_ds = adr_db.CreateDynaset(sql_stmnt)

End If

End Sub

Sub save_rec ()

curr_rec = adr_ds!recnum

If Not newflag Then
adr_ds.Edit
End If

upd_adr
adr_ds.Update

newflag = 0

refresh_sql

criteria = "recnum = " + Str(curr_rec)

adr_ds.FindFirst criteria

upd_fields

End Sub

Sub upd_adr ()
adr_ds("FORENAME") = adr_form.forename_box.Text
adr_ds("SURNAME") = adr_form.surname_box.Text
adr_ds("ADDRESS1") = adr_form.adr1_box.Text
adr_ds("ADDRESS2") = adr_form.adr2_box.Text
adr_ds("ADDRESS3") = adr_form.adr3_box.Text
adr_ds("ADDRESS4") = adr_form.adr4_box.Text
adr_ds("ADDRESS5") = adr_form.adr5_box.Text
adr_ds("TELEPHONE") = adr_form.tel_box.Text
adr_ds("FAX") = adr_form.fax_box.Text
adr_ds("NOTES") = adr_form.notes_box.Text
End Sub

Sub upd_fields ()

If adr_ds("FORENAME") <> "" Then
adr_form.forename_box.Text = adr_ds("FORENAME")
Else
adr_form.forename_box.Text = ""
End If

If adr_ds("SURNAME") <> "" Then
adr_form.surname_box.Text = adr_ds("SURNAME")
Else
adr_form.surname_box.Text = ""
End If

If adr_ds("ADDRESS1") <> "" Then
adr_form.adr1_box.Text = adr_ds("ADDRESS1")
Else
adr_form.adr1_box.Text = ""
End If

If adr_ds("ADDRESS2") <> "" Then
adr_form.adr2_box.Text = adr_ds("ADDRESS2")
Else
adr_form.adr2_box.Text = ""
End If

If adr_ds("ADDRESS3") <> "" Then
adr_form.adr3_box.Text = adr_ds("ADDRESS3")
Else
adr_form.adr3_box.Text = ""
End If

If adr_ds("ADDRESS4") <> "" Then
adr_form.adr4_box.Text = adr_ds("ADDRESS4")
Else
adr_form.adr4_box.Text = ""
End If

If adr_ds("ADDRESS5") <> "" Then
adr_form.adr5_box.Text = adr_ds("ADDRESS5")
Else
adr_form.adr5_box.Text = ""
End If

If adr_ds("TELEPHONE") <> "" Then
adr_form.tel_box.Text = adr_ds("TELEPHONE")
Else
adr_form.tel_box.Text = ""
End If

If adr_ds("FAX") <> "" Then
adr_form.fax_box.Text = adr_ds("FAX")
Else
adr_form.fax_box.Text = ""
End If

If adr_ds("NOTES") <> "" Then
adr_form.notes_box.Text = adr_ds("NOTES")
Else
adr_form.notes_box.Text = ""
End If

If adr_ds("ACTION") = True Then
adr_form.Action_needed.Value = 1

Else
adr_form.Action_needed.Value = 0

End If


End Sub

Sub upd_list ()

screen.MousePointer = 11
list_form.list_grid.Visible = False

Rem busy

' now update grid
' note that you cannot see the 3rd column,
' which is used to store the record number

Dim gridname As String
Dim forevar As String
Dim survar As String
Dim recstr As String

list_form.list_grid.FixedRows = 0
list_form.list_grid.FixedCols = 0
list_form.list_grid.Rows = 1
list_form.list_grid.Cols = 3

list_form.list_grid.ColWidth(0) = (list_form.list_grid.Width - 301) / 2
list_form.list_grid.ColWidth(1) = (list_form.list_grid.Width - 301) / 2
Rem column width allows for scroll bar

rowcount = 0

adr_ds.MoveFirst

Do While adr_ds.EOF = False
list_form.list_grid.Rows = rowcount + 1
list_form.list_grid.Row = rowcount
list_form.list_grid.Col = 0

If IsNull(adr_ds!forename) Then
forevar = ""
Else
forevar = adr_ds!forename
End If

If IsNull(adr_ds!surname) Then
survar = ""
Else
survar = adr_ds!surname
End If

recstr = Str(adr_ds!recnum)

list_form.list_grid.Text = forevar
list_form.list_grid.Col = 1
list_form.list_grid.Text = survar
list_form.list_grid.Col = 2
list_form.list_grid.Text = recstr

rowcount = rowcount + 1
adr_ds.MoveNext
Loop

adr_ds.MoveFirst

Do While rowcount < 20
Rem fills the grid with spaces when there are very few rows
Rem for a cosmetic improvement

list_form.list_grid.Rows = rowcount + 1
list_form.list_grid.Row = rowcount
list_form.list_grid.Col = 0
list_form.list_grid.Text = ""

rowcount = rowcount + 1

Loop

list_form.list_grid.Visible = True

screen.MousePointer = 0
Rem done

End Sub