Programming Tool Box/SIMS_2.iso/bp_6_93/vbwin/phoenix/demo.txt

Text File | 1995-02-26 | 11KB | 427 lines

Sub ButFirst_Click ()
    JUMP_FIRST_Click
End Sub

Sub ButLast_Click ()
    JUMP_LAST_Click
End Sub

Sub ButNext_Click ()
    JUMP_NEXT_Click
End Sub

Sub ButPrev_Click ()
    JUMP_PREV_Click
End Sub

Sub EDIT_DELETE_Click ()
    Dim Res As Integer, Status As Integer

    Record.Vorname = VName.Text
    Record.name = NName.Text
    Record.Stra▀e = Stra▀e.Text
    Record.Plz = Plz.Text
    Record.Ort = Ort.Text
    Record.Telefon = Telefon.Text

    If (Record.address <> 0) Then
        Res = db_reclock(Db, Record.address)
        Res = db_delete(Db, TBL_LEUTE, Record.address, Status)
        Res = TestBase(Db)
    End If

    VName.Text = ""
    NName.Text = ""
    Stra▀e.Text = ""
    Plz.Text = ""
    Ort.Text = ""
    Telefon.Text = ""
End Sub

Sub EDIT_FIND_Click ()
    Dim Res As Integer

    Record.name = NName.Text
    Record.Plz = Plz.Text
    Record.Ort = Ort.Text

    If SearchIndex <> 0 Then
        If db_search(Db, TBL_LEUTE, SearchIndex, ASCENDING, DbCursor, Record, 0) = 0 Then
          MsgBox "Datensatz '" & SearchString & "' nicht gefunden!", 48, Title
        End If

        Res = ReadAndGetLeute(Record)
    End If

    Res = TestBase(Db)
End Sub

Sub EDIT_INSERT_Click ()
    Dim Res As Integer, Status As Integer

    Res = SetAndInsertLeute(Record, Status)

    VName.Text = ""
    NName.Text = ""
    Stra▀e.Text = ""
    Plz.Text = ""
    Ort.Text = ""
    Telefon.Text = ""
End Sub

Sub EDIT_NEW_Click ()
    VName.Text = ""
    NName.Text = ""
    Stra▀e.Text = ""
    Plz.Text = ""
    Ort.Text = ""
    Telefon.Text = ""
    Record.address = 0
End Sub

Sub EDIT_UPDATE_Click ()
    Dim Res As Integer, Status As Integer

    Res = SetAndUpdateLeute(Record, Status)
End Sub

Sub FILE_CLOSE_Click ()
    Dim Res As Integer

    If Db <> 0 Then
        db_freecursor Db, DbCursor
        Res = db_close(Db)
        FILE_CLOSE.Caption = "&╓ffnen"
        Db = 0
        ED.Enabled = False
        JUMP.Enabled = False
        INFO_TABLE.Enabled = False
        ButFirst.Enabled = False
        ButPrev.Enabled = False
        ButLast.Enabled = False
        ButNext.Enabled = False

        VName.Text = ""
        NName.Text = ""
        Stra▀e.Text = ""
        Plz.Text = ""
        Ort.Text = ""
        Telefon.Text = ""
        Record.address = 0
    Else
        Db = db_open(basename, basepath, OpenFlags, OpenCache, OpenDbCursors, username, password)
        Res = TestBase(Db)

        If Db = 0 Then
            MsgBox "Das Programm wird beendet.", 16, Title
            End
        Else
            DbCursor = db_newcursor(Db)
            FILE_CLOSE.Caption = "&Schlie▀en"
            ED.Enabled = True
            JUMP.Enabled = True
            JUMP_FIRST_Click
        End If
    End If
End Sub

Sub FILE_QUIT_Click ()
    Dim Res As Integer

    If Db <> 0 Then
        Beep
        Res = MsgBox("Soll die Datenbank geschlossen und das Programm verlassen werden?", 36, Title)
        If Res = 6 Then
            Res = db_close(Db)
            End
        End If
    Else
        End
    End If
End Sub

Sub FILE_REORG_Click ()
    Dim I As Integer, Ret As Integer
    Dim reorgresult As REORG_RESULT

    Screen.MousePointer = 11            ' Busy
    ED.Enabled = False
    JUMP.Enabled = False
    INFO_TABLE.Enabled = False
    ButFirst.Enabled = False
    ButPrev.Enabled = False
    ButLast.Enabled = False
    ButNext.Enabled = False

    If Db <> 0 Then
        Ret = db_close(Db)
        Db = 0
    End If

    Ret = db_reorg(basename, basepath, OpenCache, False, 0&, reorgresult)

    If Ret = False Then
        Ret = TestBase(Db)
    Else
        Db = db_open(basename, basepath, OpenFlags, OpenCache, OpenDbCursors, username, password)
        Ret = TestBase(Db)

        If Db = 0 Then
            MsgBox "Das Programm wird beendet.", 16, Title
            End
        Else
            DbCursor = db_newcursor(Db)

            Screen.MousePointer = 0    ' Default
            FILE_CLOSE.Caption = "&Schlie▀en"
            ED.Enabled = True
            JUMP.Enabled = True
            JUMP_FIRST_Click

            MsgBox "Datenbank erfolgreich reorganisiert und wieder ge÷ffnet.", 64, Title
        End If
    End If
End Sub

Sub Form_Load ()
    Dim Res As Integer

    Record.address = 0
    basepath = App.Path
    basename = "LEUTE"

    If Right$(basepath, 1) <> "\" Then      ' if not the root path
        basepath = basepath + "\"
    End If

    Db = db_open(basename, basepath, OpenFlags, OpenCache, OpenDbCursors, username, password)
    Res = TestBase(Db)

    If Db = 0 Then
        MsgBox "Das Programm wird beendet.", 16, Title
        End
    Else
        DbCursor = db_newcursor(Db)
        JUMP_FIRST_Click
    End If
End Sub

Sub Form_Unload (Cancel As Integer)
    Dim Ret As Integer

    If Db <> 0 Then
        Ret = db_close(Db)
    End If
    End
End Sub

Sub INFO_INFO_Click ()
    InfoForm.Show 1
End Sub

Sub INFO_TABLE_Click ()
    TableInfoForm.Show 1
End Sub

Sub JUMP_FIRST_Click ()
    Dim Res As Integer

    If db_initcursor(Db, TBL_LEUTE, 1, ASCENDING, DbCursor) Then
        If db_movecursor(Db, DbCursor, 1) Then
            Res = ReadAndGetLeute(Record)
        End If
    End If

    Res = TestBase(Db)
End Sub

Sub JUMP_LAST_Click ()
    Dim Res As Integer

    If db_initcursor(Db, TBL_LEUTE, 1, DESCENDING, DbCursor) Then
        If db_movecursor(Db, DbCursor, -1) Then
            Res = ReadAndGetLeute(Record)
        End If
    End If

    Res = TestBase(Db)
End Sub

Sub JUMP_NEXT_Click ()
    Dim Res As Integer

    If db_movecursor(Db, DbCursor, 1) Then
        Res = ReadAndGetLeute(Record)
    End If

    Res = TestBase(Db)
End Sub

Sub JUMP_PREV_Click ()
    Dim Res As Integer

    If db_movecursor(Db, DbCursor, -1) Then
        Res = ReadAndGetLeute(Record)
    End If

    Res = TestBase(Db)
End Sub

Sub NName_Change ()
    If SearchIndex = 1 Then
        SearchString = NName.Text
    End If
End Sub

Sub NName_GotFocus ()
    SearchIndex = 1
    SearchString = NName.Text

    SelLine NName
End Sub

Sub Ort_Change ()
    If SearchIndex = 3 Then
        SearchString = Ort.Text
    End If
End Sub

Sub Ort_GotFocus ()
    SearchIndex = 3
    SearchString = Ort.Text

    SelLine Ort
End Sub

Sub Plz_Change ()
    If SearchIndex = 2 Then
        SearchString = Plz.Text
    End If
End Sub

Sub Plz_GotFocus ()
    SearchIndex = 2
    SearchString = Plz.Text

    SelLine Plz
End Sub

Function ReadAndGetLeute (Record As LEUTE) As Integer
    Dim Ret As Integer, Res As Integer

    Ret = db_read(Db, TBL_LEUTE, DbBuffer(0), DbCursor, 0, False)

    If Ret <> False Then
        Record.address = DbBuffer(0)                        'set DbAddress
        Res = db_getstr(Db, TBL_LEUTE, COL_LEUTE_VORNAME, DbBuffer(0), Record.Vorname)
        Res = db_getstr(Db, TBL_LEUTE, COL_LEUTE_NAME, DbBuffer(0), Record.name)
        Res = db_getstr(Db, TBL_LEUTE, COL_LEUTE_STRASSE, DbBuffer(0), Record.Stra▀e)
        Res = db_getstr(Db, TBL_LEUTE, COL_LEUTE_PLZ, DbBuffer(0), Record.Plz)
        Res = db_getstr(Db, TBL_LEUTE, COL_LEUTE_ORT, DbBuffer(0), Record.Ort)
        Res = db_getstr(Db, TBL_LEUTE, COL_LEUTE_TELEFON, DbBuffer(0), Record.Telefon)
        VName.Text = Record.Vorname
        NName.Text = Record.name
        Stra▀e.Text = Record.Stra▀e
        Plz.Text = Record.Plz
        Ort.Text = Record.Ort
        Telefon.Text = Record.Telefon
        TestFirstLast Db, DbCursor
    End If

    Res = TestBase(Db)

    ReadAndGetLeute = Ret
End Function

Function SetAndInsertLeute (Record As LEUTE, Status As Integer) As Integer
    Dim Ret As Integer, Res As Integer

    Record.Vorname = VName.Text
    Record.name = NName.Text
    Record.Stra▀e = Stra▀e.Text
    Record.Plz = Plz.Text
    Record.Ort = Ort.Text
    Record.Telefon = Telefon.Text

    Res = db_setstr(Db, TBL_LEUTE, COL_LEUTE_VORNAME, DbBuffer(0), Record.Vorname)
    Res = db_setstr(Db, TBL_LEUTE, COL_LEUTE_NAME, DbBuffer(0), Record.name)
    Res = db_setstr(Db, TBL_LEUTE, COL_LEUTE_STRASSE, DbBuffer(0), Record.Stra▀e)
    Res = db_setstr(Db, TBL_LEUTE, COL_LEUTE_PLZ, DbBuffer(0), Record.Plz)
    Res = db_setstr(Db, TBL_LEUTE, COL_LEUTE_ORT, DbBuffer(0), Record.Ort)
    Res = db_setstr(Db, TBL_LEUTE, COL_LEUTE_TELEFON, DbBuffer(0), Record.Telefon)

    Ret = db_insert(Db, TBL_LEUTE, DbBuffer(0), Status)
    Res = TestBase(Db)
    Record.address = DbBuffer(0)                        'set DbAddress

    SetAndInsertLeute = Ret
End Function

Function SetAndUpdateLeute (Record As LEUTE, Status As Integer) As Integer
    Dim Ret As Integer, Res As Integer

    Record.Vorname = VName.Text
    Record.name = NName.Text
    Record.Stra▀e = Stra▀e.Text
    Record.Plz = Plz.Text
    Record.Ort = Ort.Text
    Record.Telefon = Telefon.Text

    Res = db_setstr(Db, TBL_LEUTE, COL_LEUTE_VORNAME, DbBuffer(0), Record.Vorname)
    Res = db_setstr(Db, TBL_LEUTE, COL_LEUTE_NAME, DbBuffer(0), Record.name)
    Res = db_setstr(Db, TBL_LEUTE, COL_LEUTE_STRASSE, DbBuffer(0), Record.Stra▀e)
    Res = db_setstr(Db, TBL_LEUTE, COL_LEUTE_PLZ, DbBuffer(0), Record.Plz)
    Res = db_setstr(Db, TBL_LEUTE, COL_LEUTE_ORT, DbBuffer(0), Record.Ort)
    Res = db_setstr(Db, TBL_LEUTE, COL_LEUTE_TELEFON, DbBuffer(0), Record.Telefon)

    If (Record.address <> 0) Then
        Res = db_reclock(Db, Record.address)
        Ret = db_update(Db, TBL_LEUTE, DbBuffer(0), Status)
        Res = TestBase(Db)
    End If

    SetAndUpdateLeute = Ret
End Function

Sub Stra▀e_GotFocus ()
    SelLine Stra▀e
End Sub

Sub Telefon_GotFocus ()
    SelLine Telefon
End Sub

Sub TestFirstLast (Db As Long, DbCursor As Long)
    Dim FirstLast As Integer

    If (db_isfirst(Db, DbCursor) = 0) Then
        FirstLast = True
    Else
        FirstLast = False
    End If

    ButFirst.Enabled = FirstLast
    JUMP_FIRST.Enabled = FirstLast
    ButPrev.Enabled = FirstLast
    JUMP_PREV.Enabled = FirstLast

    If (db_islast(Db, DbCursor) = 0) Then
        FirstLast = True
    Else
        FirstLast = False
    End If

    ButLast.Enabled = FirstLast
    JUMP_LAST.Enabled = FirstLast
    ButNext.Enabled = FirstLast
    JUMP_NEXT.Enabled = FirstLast
End Sub

Sub VName_GotFocus ()
    SelLine VName
End Sub